# Commands covered: http::config, http::geturl, http::wait, http::reset # # This file contains a collection of tests for the http script library. # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2 namespace import -force ::tcltest::* if {[catch {package require http 2} version]} { if {[info exists http2]} { catch {puts "Cannot load http 2.* package"} return } else { catch {puts "Running http 2.* tests in child interp"} set interp [interp create http2] $interp eval [list set http2 "running"] $interp eval [list set argv $argv] $interp eval [list source [info script]] interp delete $interp return } } proc bgerror {args} { global errorInfo puts stderr "http.test bgerror" puts stderr [join $args] puts stderr $errorInfo } if {$::tcl_platform(os) eq "Darwin"} { # Name resolution often a problem on OSX; not focus of HTTP package anyway set HOST localhost } else { set HOST [info hostname] } set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null" catch {unset data} # Ensure httpd file exists set origFile [file join [pwd] [file dirname [info script]] httpd] set httpdFile [file join [temporaryDirectory] httpd_[pid]] if {![file exists $httpdFile]} { makeFile "" $httpdFile file delete $httpdFile file copy $origFile $httpdFile set removeHttpd 1 } catch {package require Thread 2.7-} if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} { set httpthread [thread::create -preserved] thread::send $httpthread [list source $httpdFile] thread::send $httpthread [list set bindata $bindata] thread::send $httpthread {httpd_init 0; set port} port puts "Running httpd in thread $httpthread" } else { if {![file exists $httpdFile]} { puts "Cannot read $httpdFile script, http test skipped" unset port return } source $httpdFile # Let the OS pick the port; that's much more flexible if {[catch {httpd_init 0} listen]} { puts "Cannot start http server, http test skipped" catch {unset port} return } } test http-1.1 {http::config} { http::config -useragent UserAgent http::config } [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1] test http-1.2 {http::config} { http::config -proxyfilter } http::ProxyRequired test http-1.3 {http::config} { catch {http::config -junk} } 1 test http-1.4 {http::config} { set savedconf [http::config] http::config -proxyhost nowhere.come -proxyport 8080 \ -proxyfilter myFilter -useragent "Tcl Test Suite" \ -urlencoding iso8859-1 set x [http::config] http::config {*}$savedconf set x } {-accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1} test http-1.5 {http::config} -returnCodes error -body { http::config -proxyhost {} -junk 8080 } -result {Unknown option -junk, must be: -accept, -cookiejar, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip} test http-1.6 {http::config} -setup { set oldenc [http::config -urlencoding] } -body { set enc [list [http::config -urlencoding]] http::config -urlencoding iso8859-1 lappend enc [http::config -urlencoding] } -cleanup { http::config -urlencoding $oldenc } -result {utf-8 iso8859-1} test http-2.1 {http::reset} { catch {http::reset http#1} } 0 test http-3.1 {http::geturl} -returnCodes error -body { http::geturl -bogus flag } -result {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate} test http-3.2 {http::geturl} -returnCodes error -body { http::geturl http:junk } -result {Unsupported URL: http:junk} set url //${::HOST}:$port set badurl //${::HOST}:[expr $port+1] test http-3.3 {http::geturl} -body { set token [http::geturl $url] http::data $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET /

" set tail /a/b/c set url //${::HOST}:$port/a/b/c set fullurl HTTP://user:pass@${::HOST}:$port/a/b/c set binurl //${::HOST}:$port/binary set xmlurl //${::HOST}:$port/xml set posturl //${::HOST}:$port/post set badposturl //${::HOST}:$port/droppost set authorityurl //${::HOST}:$port set ipv6url http://\[::1\]:$port/ test http-3.4 {http::geturl} -body { set token [http::geturl $url] http::data $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET $tail

" proc selfproxy {host} { global port return [list ${::HOST} $port] } test http-3.5 {http::geturl} -body { http::config -proxyfilter selfproxy set token [http::geturl $url] http::data $token } -cleanup { http::config -proxyfilter http::ProxyRequired http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET http:$url

" test http-3.6 {http::geturl} -body { http::config -proxyfilter bogus set token [http::geturl $url] http::data $token } -cleanup { http::config -proxyfilter http::ProxyRequired http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET $tail

" test http-3.7 {http::geturl} -body { set token [http::geturl $url -headers {Pragma no-cache}] http::data $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET $tail

" test http-3.8 {http::geturl} -body { set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 3000] http::data $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

POST $tail

Query

Name
Value
Foo
Bar
" test http-3.9 {http::geturl} -body { set token [http::geturl $url -validate 1] http::code $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 200 OK" test http-3.10 {http::geturl queryprogress} -setup { set query foo=bar set sep "" set i 0 # Create about 120K of query data while {$i < 14} { incr i append query $sep$query set sep & } } -body { proc postProgress {token x y} { global postProgress lappend postProgress $y } set postProgress {} set t [http::geturl $posturl -keepalive 0 -query $query \ -queryprogress postProgress -queryblocksize 16384] http::wait $t list [http::status $t] [string length $query] $postProgress [http::data $t] } -cleanup { http::cleanup $t } -result {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}} test http-3.11 {http::geturl querychannel with -command} -setup { set query foo=bar set sep "" set i 0 # Create about 120K of query data while {$i < 14} { incr i append query $sep$query set sep & } set file [makeFile $query outdata] } -body { set fp [open $file] proc asyncCB {token} { global postResult lappend postResult [http::data $token] } set postResult [list ] set t [http::geturl $posturl -querychannel $fp] http::wait $t set testRes [list [http::status $t] [string length $query] [http::data $t]] # Now do async http::cleanup $t close $fp set fp [open $file] set t [http::geturl $posturl -querychannel $fp -command asyncCB] set postResult [list PostStart] http::wait $t close $fp lappend testRes [http::status $t] $postResult } -cleanup { removeFile outdata http::cleanup $t } -result {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}} # On Linux platforms when the client and server are on the same host, the # client is unable to read the server's response one it hits the write error. # The status is "eof". # On Windows, the http::wait procedure gets a "connection reset by peer" error # while reading the reply. test http-3.12 {http::geturl querychannel with aborted request} -setup { set query foo=bar set sep "" set i 0 # Create about 120K of query data while {$i < 14} { incr i append query $sep$query set sep & } set file [makeFile $query outdata] } -constraints {nonPortable} -body { set fp [open $file] proc asyncCB {token} { global postResult lappend postResult [http::data $token] } proc postProgress {token x y} { global postProgress lappend postProgress $y } set postProgress {} # Now do async set postResult [list PostStart] if {[catch { set t [http::geturl $badposturl -querychannel $fp -command asyncCB \ -queryprogress postProgress] http::wait $t upvar #0 $t state } err]} { puts $::errorInfo error $err } list [http::status $t] [http::code $t] } -cleanup { removeFile outdata http::cleanup $t } -result {ok {HTTP/1.0 200 Data follows}} test http-3.13 {http::geturl socket leak test} { set chanCount [llength [file channels]] for {set i 0} {$i < 3} {incr i} { catch {http::geturl $badurl -timeout 5000} } # No extra channels should be taken expr {[llength [file channels]] == $chanCount} } 1 test http-3.14 "http::geturl $fullurl" -body { set token [http::geturl $fullurl -validate 1] http::code $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 200 OK" test http-3.15 {http::geturl parse failures} -body { http::geturl "{invalid}:url" } -returnCodes error -result {Unsupported URL: {invalid}:url} test http-3.16 {http::geturl parse failures} -body { http::geturl http:relative/url } -returnCodes error -result {Unsupported URL: http:relative/url} test http-3.17 {http::geturl parse failures} -body { http::geturl /absolute/url } -returnCodes error -result {Missing host part: /absolute/url} test http-3.18 {http::geturl parse failures} -body { http::geturl http://somewhere:123456789/ } -returnCodes error -result {Invalid port number: 123456789} test http-3.19 {http::geturl parse failures} -body { http::geturl http://{user}@somewhere } -returnCodes error -result {Illegal characters in URL user} test http-3.20 {http::geturl parse failures} -body { http::geturl http://%user@somewhere } -returnCodes error -result {Illegal encoding character usage "%us" in URL user} test http-3.21 {http::geturl parse failures} -body { http::geturl http://somewhere/{path} } -returnCodes error -result {Illegal characters in URL path} test http-3.22 {http::geturl parse failures} -body { http::geturl http://somewhere/%path } -returnCodes error -result {Illegal encoding character usage "%pa" in URL path} test http-3.23 {http::geturl parse failures} -body { http::geturl http://somewhere/path?{query}? } -returnCodes error -result {Illegal characters in URL path} test http-3.24 {http::geturl parse failures} -body { http::geturl http://somewhere/path?%query } -returnCodes error -result {Illegal encoding character usage "%qu" in URL path} test http-3.25 {http::meta} -setup { unset -nocomplain m token } -body { set token [http::geturl $url -timeout 3000] array set m [http::meta $token] lsort [array names m] } -cleanup { http::cleanup $token unset -nocomplain m token } -result {Content-Length Content-Type Date} test http-3.26 {http::meta} -setup { unset -nocomplain m token } -body { set token [http::geturl $url -headers {X-Check 1} -timeout 3000] array set m [http::meta $token] lsort [array names m] } -cleanup { http::cleanup $token unset -nocomplain m token } -result {Content-Length Content-Type Date X-Check} test http-3.27 {http::geturl: -headers override -type} -body { set token [http::geturl $url/headers -type "text/plain" -query dummy \ -headers [list "Content-Type" "text/plain;charset=utf-8"]] http::data $token } -cleanup { http::cleanup $token } -match regexp -result {(?n)Host .* User-Agent .* Connection close Content-Type {text/plain;charset=utf-8} Accept \*/\* Accept-Encoding .* Content-Length 5} test http-3.28 {http::geturl: -headers override -type default} -body { set token [http::geturl $url/headers -query dummy \ -headers [list "Content-Type" "text/plain;charset=utf-8"]] http::data $token } -cleanup { http::cleanup $token } -match regexp -result {(?n)Host .* User-Agent .* Connection close Content-Type {text/plain;charset=utf-8} Accept \*/\* Accept-Encoding .* Content-Length 5} test http-3.29 {http::geturl IPv6 address} -body { # We only want to see if the URL gets parsed correctly. This is # the case if http::geturl succeeds or returns a socket related # error. If the parsing is wrong, we'll get a parse error. # It'd be better to separate the URL parser from http::geturl, so # that it can be tested without also trying to make a connection. set error [catch {http::geturl $ipv6url -validate 1} token] if {$error && [string match "couldn't open socket: *" $token]} { set error 0 } set error } -cleanup { catch { http::cleanup $token } } -result 0 test http-3.30 {http::geturl query without path} -body { set token [http::geturl $authorityurl?var=val] http::ncode $token } -cleanup { catch { http::cleanup $token } } -result 200 test http-3.31 {http::geturl fragment without path} -body { set token [http::geturl "$authorityurl#fragment42"] http::ncode $token } -cleanup { catch { http::cleanup $token } } -result 200 # Bug c11a51c482 test http-3.32 {http::geturl: -headers override -accept default} -body { set token [http::geturl $url/headers -query dummy \ -headers [list "Accept" "text/plain,application/tcl-test-value"]] http::data $token } -cleanup { http::cleanup $token } -match regexp -result {(?n)Host .* User-Agent .* Connection close Accept text/plain,application/tcl-test-value Accept-Encoding .* Content-Type application/x-www-form-urlencoded Content-Length 5} # Bug 838e99a76d test http-3.33 {http::geturl application/xml is text} -body { set token [http::geturl "$xmlurl"] scan [http::data $token] "<%\[^>]>%c<%\[^>]>" } -cleanup { catch { http::cleanup $token } } -result {test 4660 /test} test http-4.1 {http::Event} -body { set token [http::geturl $url -keepalive 0] upvar #0 $token data array set meta $data(meta) expr {($data(totalsize) == $meta(Content-Length))} } -cleanup { http::cleanup $token } -result 1 test http-4.2 {http::Event} -body { set token [http::geturl $url] upvar #0 $token data array set meta $data(meta) string compare $data(type) [string trim $meta(Content-Type)] } -cleanup { http::cleanup $token } -result 0 test http-4.3 {http::Event} -body { set token [http::geturl $url] http::code $token } -cleanup { http::cleanup $token } -result {HTTP/1.0 200 Data follows} test http-4.4 {http::Event} -setup { set testfile [makeFile "" testfile] } -body { set out [open $testfile w] set token [http::geturl $url -channel $out] close $out set in [open $testfile] set x [read $in] } -cleanup { catch {close $in} catch {close $out} removeFile $testfile http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET $tail

" test http-4.5 {http::Event} -setup { set testfile [makeFile "" testfile] } -body { set out [open $testfile w] fconfigure $out -translation lf set token [http::geturl $url -channel $out] close $out upvar #0 $token data expr {$data(currentsize) == $data(totalsize)} } -cleanup { removeFile $testfile http::cleanup $token } -result 1 test http-4.6 {http::Event} -setup { set testfile [makeFile "" testfile] } -body { set out [open $testfile w] set token [http::geturl $binurl -channel $out] close $out set in [open $testfile] fconfigure $in -translation binary read $in } -cleanup { catch {close $in} catch {close $out} removeFile $testfile http::cleanup $token } -result "$bindata[string trimleft $binurl /]" proc myProgress {token total current} { global progress httpLog if {[info exists httpLog] && $httpLog} { puts "progress $total $current" } set progress [list $total $current] } test http-4.6.1 {http::Event} knownBug { set token [http::geturl $url -blocksize 50 -progress myProgress] return $progress } {111 111} test http-4.7 {http::Event} -body { set token [http::geturl $url -keepalive 0 -progress myProgress] return $progress } -cleanup { http::cleanup $token } -result {111 111} test http-4.8 {http::Event} -body { set token [http::geturl $url] http::status $token } -cleanup { http::cleanup $token } -result {ok} test http-4.9 {http::Event} -body { set token [http::geturl $url -progress myProgress] http::code $token } -cleanup { http::cleanup $token } -result {HTTP/1.0 200 Data follows} test http-4.10 {http::Event} -body { set token [http::geturl $url -progress myProgress] http::size $token } -cleanup { http::cleanup $token } -result {111} # Timeout cases # Short timeout to working server (the test server). This lets us try a # reset during the connection. test http-4.11 {http::Event} -body { set token [http::geturl $url -timeout 1 -keepalive 0 -command \#] http::reset $token http::status $token } -cleanup { http::cleanup $token } -result {reset} # Longer timeout with reset. test http-4.12 {http::Event} -body { set token [http::geturl $url/?timeout=10 -keepalive 0 -command \#] http::reset $token http::status $token } -cleanup { http::cleanup $token } -result {reset} # Medium timeout to working server that waits even longer. The timeout # hits while waiting for a reply. test http-4.13 {http::Event} -body { set token [http::geturl $url?timeout=30 -keepalive 0 -timeout 10 -command \#] http::wait $token http::status $token } -cleanup { http::cleanup $token } -result {timeout} # Longer timeout to good host, bad port, gets an error after the # connection "completes" but the socket is bad. test http-4.14 {http::Event} -body { set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command \#] if {$token eq ""} { error "bogus return from http::geturl" } http::wait $token lindex [http::error $token] 0 } -cleanup { catch {http::cleanup $token} } -result {connect failed connection refused} # Bogus host test http-4.15 {http::Event} -body { # This test may fail if you use a proxy server. That is to be # expected and is not a problem with Tcl. set token [http::geturl //not_a_host.tcl.tk -timeout 3000 -command \#] http::wait $token http::status $token # error codes vary among platforms. } -cleanup { catch {http::cleanup $token} } -returnCodes 1 -match glob -result "couldn't open socket*" test http-4.16 {Leak with Close vs Keepalive (bug [6ca52aec14]} -setup { proc list-difference {l1 l2} { lmap item $l2 {if {$item in $l1} continue; set item} } } -body { set before [chan names] set token [http::geturl $url -headers {X-Connection keep-alive}] http::cleanup $token update # Compute what channels have been unexpectedly leaked past cleanup list-difference $before [chan names] } -cleanup { rename list-difference {} } -result {} test http-5.1 {http::formatQuery} { http::formatQuery name1 value1 name2 "value two" } {name1=value1&name2=value%20two} # test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5 test http-5.3 {http::formatQuery} { http::formatQuery lines "line1\nline2\nline3" } {lines=line1%0D%0Aline2%0D%0Aline3} test http-5.4 {http::formatQuery} { http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2 } {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2} test http-5.5 {http::formatQuery} { set enc [http::config -urlencoding] http::config -urlencoding iso8859-1 set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2] http::config -urlencoding $enc set res } {name1=~bwelch&name2=%A1%A2%A2} test http-6.1 {http::ProxyRequired} -body { http::config -proxyhost ${::HOST} -proxyport $port set token [http::geturl $url] http::wait $token upvar #0 $token data set data(body) } -cleanup { http::config -proxyhost {} -proxyport {} http::cleanup $token } -result "HTTP/1.0 TEST

Hello, World!

GET http:$url

" test http-7.1 {http::mapReply} { http::mapReply "abc\$\[\]\"\\()\}\{" } {abc%24%5B%5D%22%5C%28%29%7D%7B} test http-7.2 {http::mapReply} { # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default, # so make sure this gets converted to utf-8 then urlencoded. http::mapReply "\u2208" } {%E2%88%88} test http-7.3 {http::formatQuery} -setup { set enc [http::config -urlencoding] } -returnCodes error -body { # this would be reverting to http <=2.4 behavior http::config -urlencoding "" http::mapReply "\u2208" } -cleanup { http::config -urlencoding $enc } -result "can't read \"formMap(\u2208)\": no such element in array" test http-7.4 {http::formatQuery} -setup { set enc [http::config -urlencoding] } -body { # this would be reverting to http <=2.4 behavior w/o errors # (unknown chars become '?') http::config -urlencoding "iso8859-1" http::mapReply "\u2208" } -cleanup { http::config -urlencoding $enc } -result {%3F} package require tcl::idna 1.0 test http-idna-1.1 {IDNA package: basics} -returnCodes error -body { ::tcl::idna } -result {wrong # args: should be "::tcl::idna subcommand ?arg ...?"} test http-idna-1.2 {IDNA package: basics} -returnCodes error -body { ::tcl::idna ? } -result {unknown or ambiguous subcommand "?": must be decode, encode, puny, or version} test http-idna-1.3 {IDNA package: basics} -body { ::tcl::idna version } -result 1.0.1 test http-idna-1.4 {IDNA package: basics} -returnCodes error -body { ::tcl::idna version what } -result {wrong # args: should be "::tcl::idna version"} test http-idna-1.5 {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny } -result {wrong # args: should be "::tcl::idna puny subcommand ?arg ...?"} test http-idna-1.6 {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny ? } -result {unknown or ambiguous subcommand "?": must be decode, or encode} test http-idna-1.7 {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny encode } -result {wrong # args: should be "::tcl::idna puny encode string ?case?"} test http-idna-1.8 {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny encode a b c } -result {wrong # args: should be "::tcl::idna puny encode string ?case?"} test http-idna-1.9 {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny decode } -result {wrong # args: should be "::tcl::idna puny decode string ?case?"} test http-idna-1.10 {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny decode a b c } -result {wrong # args: should be "::tcl::idna puny decode string ?case?"} test http-idna-1.11 {IDNA package: basics} -returnCodes error -body { ::tcl::idna decode } -result {wrong # args: should be "::tcl::idna decode hostname"} test http-idna-1.12 {IDNA package: basics} -returnCodes error -body { ::tcl::idna encode } -result {wrong # args: should be "::tcl::idna encode hostname"} test http-idna-2.1 {puny encode: functional test} { ::tcl::idna puny encode abc } abc- test http-idna-2.2 {puny encode: functional test} { ::tcl::idna puny encode a\u20acb\u20acc } abc-k50ab test http-idna-2.3 {puny encode: functional test} { ::tcl::idna puny encode ABC } ABC- test http-idna-2.4 {puny encode: functional test} { ::tcl::idna puny encode A\u20ACB\u20ACC } ABC-k50ab test http-idna-2.5 {puny encode: functional test} { ::tcl::idna puny encode ABC 0 } abc- test http-idna-2.6 {puny encode: functional test} { ::tcl::idna puny encode A\u20ACB\u20ACC 0 } abc-k50ab test http-idna-2.7 {puny encode: functional test} { ::tcl::idna puny encode ABC 1 } ABC- test http-idna-2.8 {puny encode: functional test} { ::tcl::idna puny encode A\u20ACB\u20ACC 1 } ABC-k50ab test http-idna-2.9 {puny encode: functional test} { ::tcl::idna puny encode abc 0 } abc- test http-idna-2.10 {puny encode: functional test} { ::tcl::idna puny encode a\u20ACb\u20ACc 0 } abc-k50ab test http-idna-2.11 {puny encode: functional test} { ::tcl::idna puny encode abc 1 } ABC- test http-idna-2.12 {puny encode: functional test} { ::tcl::idna puny encode a\u20ACb\u20ACc 1 } ABC-k50ab test http-idna-2.13 {puny encode: edge cases} { ::tcl::idna puny encode "" } "" test http-idna-2.14-A {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644 u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F }]] ""] } egbpdaj6bu4bxfgehfvwxn test http-idna-2.14-B {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587 }]] ""] } ihqwcrb4cv8a8dqg056pqjye test http-idna-2.14-C {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587 }]] ""] } ihqwctvzc91f659drss3x8bo0yb test http-idna-2.14-D {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074 u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D u+0065 u+0073 u+006B u+0079 }]] ""] } Proprostnemluvesky-uyb24dma41a test http-idna-2.14-E {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8 u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2 u+05D1 u+05E8 u+05D9 u+05EA }]] ""] } 4dbcagdahymbxekheh6e0a7fei0b test http-idna-2.14-F {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939 u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947 u+0939 u+0948 u+0902 }]] ""] } i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd test http-idna-2.14-G {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092 u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B }]] ""] } n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa test http-idna-2.14-H {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774 u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74 u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C }]] ""] } 989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c test http-idna-2.14-I {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440 u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A u+0438 }]] ""] } b1abfaaepdrnnbgefbadotcwatmq2g4l test http-idna-2.14-J {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070 u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070 u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061 u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070 u+0061 u+00F1 u+006F u+006C }]] ""] } PorqunopuedensimplementehablarenEspaol-fmd56a test http-idna-2.14-K {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068 u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067 u+0056 u+0069 u+1EC7 u+0074 }]] ""] } TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g test http-idna-2.14-L {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F }]] ""] } 3B-ww4c5e180e575a65lsy2b test http-idna-2.14-M {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074 u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D u+004F u+004E u+004B u+0045 u+0059 u+0053 }]] ""] } -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n test http-idna-2.14-N {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D u+305D u+308C u+305E u+308C u+306E u+5834 u+6240 }]] ""] } Hello-Another-Way--fc4qua05auwb3674vfr0b test http-idna-2.14-O {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032 }]] ""] } 2-u9tlzr9756bt3uc0v test http-idna-2.14-P {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059 u+308B u+0035 u+79D2 u+524D }]] ""] } MajiKoi5-783gue6qz075azm5e test http-idna-2.14-Q {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0 }]] ""] } de-jg4avhby1noc0d test http-idna-2.14-R {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067 }]] ""] } d9juau41awczczp test http-idna-2.14-S {puny encode: examples from RFC 3492} { ::tcl::idna puny encode {-> $1.00 <-} } {-> $1.00 <--} test http-idna-3.1 {puny decode: functional test} { ::tcl::idna puny decode abc- } abc test http-idna-3.2 {puny decode: functional test} { ::tcl::idna puny decode abc-k50ab } a\u20acb\u20acc test http-idna-3.3 {puny decode: functional test} { ::tcl::idna puny decode ABC- } ABC test http-idna-3.4 {puny decode: functional test} { ::tcl::idna puny decode ABC-k50ab } A\u20ACB\u20ACC test http-idna-3.5 {puny decode: functional test} { ::tcl::idna puny decode ABC-K50AB } A\u20ACB\u20ACC test http-idna-3.6 {puny decode: functional test} { ::tcl::idna puny decode abc-K50AB } a\u20ACb\u20ACc test http-idna-3.7 {puny decode: functional test} { ::tcl::idna puny decode ABC- 0 } abc test http-idna-3.8 {puny decode: functional test} { ::tcl::idna puny decode ABC-K50AB 0 } a\u20ACb\u20ACc test http-idna-3.9 {puny decode: functional test} { ::tcl::idna puny decode ABC- 1 } ABC test http-idna-3.10 {puny decode: functional test} { ::tcl::idna puny decode ABC-K50AB 1 } A\u20ACB\u20ACC test http-idna-3.11 {puny decode: functional test} { ::tcl::idna puny decode abc- 0 } abc test http-idna-3.12 {puny decode: functional test} { ::tcl::idna puny decode abc-k50ab 0 } a\u20ACb\u20ACc test http-idna-3.13 {puny decode: functional test} { ::tcl::idna puny decode abc- 1 } ABC test http-idna-3.14 {puny decode: functional test} { ::tcl::idna puny decode abc-k50ab 1 } A\u20ACB\u20ACC test http-idna-3.15 {puny decode: edge cases and errors} { # Is this case actually correct? binary encode hex [encoding convertto utf-8 [::tcl::idna puny decode abc]] } c282c281c280 test http-idna-3.16 {puny decode: edge cases and errors} -returnCodes error -body { ::tcl::idna puny decode abc! } -result {bad decode character "!"} test http-idna-3.17 {puny decode: edge cases and errors} { catch {::tcl::idna puny decode abc!} -> opt dict get $opt -errorcode } {PUNYCODE BAD_INPUT CHAR} test http-idna-3.18 {puny decode: edge cases and errors} { ::tcl::idna puny decode "" } {} # A helper so we don't get lots of crap in failures proc hexify s {lmap c [split $s ""] {format u+%04X [scan $c %c]}} test http-idna-3.19-A {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode egbpdaj6bu4bxfgehfvwxn] } [list {*}{ u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644 u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F }] test http-idna-3.19-B {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode ihqwcrb4cv8a8dqg056pqjye] } {u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587} test http-idna-3.19-C {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode ihqwctvzc91f659drss3x8bo0yb] } {u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587} test http-idna-3.19-D {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode Proprostnemluvesky-uyb24dma41a] } [list {*}{ u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074 u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D u+0065 u+0073 u+006B u+0079 }] test http-idna-3.19-E {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode 4dbcagdahymbxekheh6e0a7fei0b] } [list {*}{ u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8 u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2 u+05D1 u+05E8 u+05D9 u+05EA }] test http-idna-3.19-F {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode \ i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd] } [list {*}{ u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939 u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947 u+0939 u+0948 u+0902 }] test http-idna-3.19-G {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa] } [list {*}{ u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092 u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B }] test http-idna-3.19-H {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode \ 989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c] } [list {*}{ u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774 u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74 u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C }] test http-idna-3.19-I {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode b1abfaaepdrnnbgefbadotcwatmq2g4l] } [list {*}{ u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440 u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A u+0438 }] test http-idna-3.19-J {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode \ PorqunopuedensimplementehablarenEspaol-fmd56a] } [list {*}{ u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070 u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070 u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061 u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070 u+0061 u+00F1 u+006F u+006C }] test http-idna-3.19-K {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode \ TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g] } [list {*}{ u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068 u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067 u+0056 u+0069 u+1EC7 u+0074 }] test http-idna-3.19-L {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode 3B-ww4c5e180e575a65lsy2b] } {u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F} test http-idna-3.19-M {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n] } [list {*}{ u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074 u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D u+004F u+004E u+004B u+0045 u+0059 u+0053 }] test http-idna-3.19-N {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode Hello-Another-Way--fc4qua05auwb3674vfr0b] } [list {*}{ u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D u+305D u+308C u+305E u+308C u+306E u+5834 u+6240 }] test http-idna-3.19-O {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode 2-u9tlzr9756bt3uc0v] } {u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032} test http-idna-3.19-P {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode MajiKoi5-783gue6qz075azm5e] } [list {*}{ u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059 u+308B u+0035 u+79D2 u+524D }] test http-idna-3.19-Q {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode de-jg4avhby1noc0d] } {u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0} test http-idna-3.19-R {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode d9juau41awczczp] } {u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067} test http-idna-3.19-S {puny decode: examples from RFC 3492} { ::tcl::idna puny decode {-> $1.00 <--} } {-> $1.00 <-} rename hexify "" test http-idna-4.1 {IDNA encoding} { ::tcl::idna encode abc.def } abc.def test http-idna-4.2 {IDNA encoding} { ::tcl::idna encode a\u20acb\u20acc.def } xn--abc-k50ab.def test http-idna-4.3 {IDNA encoding} { ::tcl::idna encode def.a\u20acb\u20acc } def.xn--abc-k50ab test http-idna-4.4 {IDNA encoding} { ::tcl::idna encode ABC.DEF } ABC.DEF test http-idna-4.5 {IDNA encoding} { ::tcl::idna encode A\u20acB\u20acC.def } xn--ABC-k50ab.def test http-idna-4.6 {IDNA encoding: invalid edge case} { # Should this be an error? ::tcl::idna encode abc..def } abc..def test http-idna-4.7 {IDNA encoding: invalid char} -returnCodes error -body { ::tcl::idna encode abc.$.def } -result {bad character "$" in DNS name} test http-idna-4.7.1 {IDNA encoding: invalid char} { catch {::tcl::idna encode abc.$.def} -> opt dict get $opt -errorcode } {IDNA INVALID_NAME_CHARACTER {$}} test http-idna-4.8 {IDNA encoding: empty} { ::tcl::idna encode "" } {} set overlong www.[join [subst [string map {u+ \\u} { u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774 u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74 u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C }]] ""].com test http-idna-4.9 {IDNA encoding: max lengths from RFC 5890} -body { ::tcl::idna encode $overlong } -returnCodes error -result "hostname part too long" test http-idna-4.9.1 {IDNA encoding: max lengths from RFC 5890} { catch {::tcl::idna encode $overlong} -> opt dict get $opt -errorcode } {IDNA OVERLONG_PART xn--989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c} unset overlong test http-idna-4.10 {IDNA encoding: edge cases} { ::tcl::idna encode pass\u00e9.example.com } xn--pass-epa.example.com test http-idna-5.1 {IDNA decoding} { ::tcl::idna decode abc.def } abc.def test http-idna-5.2 {IDNA decoding} { # Invalid entry that's just a wrapper ::tcl::idna decode xn--abc-.def } abc.def test http-idna-5.3 {IDNA decoding} { # Invalid entry that's just a wrapper ::tcl::idna decode xn--abc-.xn--def- } abc.def test http-idna-5.4 {IDNA decoding} { # Invalid entry that's just a wrapper ::tcl::idna decode XN--abc-.XN--def- } abc.def test http-idna-5.5 {IDNA decoding: error cases} -returnCodes error -body { ::tcl::idna decode xn--$$$.example.com } -result {bad decode character "$"} test http-idna-5.5.1 {IDNA decoding: error cases} { catch {::tcl::idna decode xn--$$$.example.com} -> opt dict get $opt -errorcode } {PUNYCODE BAD_INPUT CHAR} test http-idna-5.6 {IDNA decoding: error cases} -returnCodes error -body { ::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def } -result {exceeded input data} test http-idna-5.6.1 {IDNA decoding: error cases} { catch {::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def} -> opt dict get $opt -errorcode } {PUNYCODE BAD_INPUT LENGTH} # cleanup catch {unset url} catch {unset badurl} catch {unset port} catch {unset data} if {[info exists httpthread]} { thread::release $httpthread } else { close $listen } if {[info exists removeHttpd]} { removeFile $httpdFile } rename bgerror {} ::tcltest::cleanupTests # Local variables: # mode: tcl # End: