1# Commands covered: http::config, http::geturl, http::wait, http::reset 2# 3# This file contains a collection of tests for the http script library. 4# Sourcing this file into Tcl runs the tests and generates output for errors. 5# No output means no errors were found. 6# 7# Copyright © 1991-1993 The Regents of the University of California. 8# Copyright © 1994-1996 Sun Microsystems, Inc. 9# Copyright © 1998-2000 Ajuba Solutions. 10# 11# See the file "license.terms" for information on usage and redistribution of 12# this file, and for a DISCLAIMER OF ALL WARRANTIES. 13 14if {"::tcltest" ni [namespace children]} { 15 package require tcltest 2.5 16 namespace import -force ::tcltest::* 17} 18 19if {[catch {package require http 2} version]} { 20 if {[info exists http2]} { 21 catch {puts "Cannot load http 2.* package"} 22 return 23 } else { 24 catch {puts "Running http 2.* tests in child interp"} 25 set interp [interp create http2] 26 $interp eval [list set http2 "running"] 27 $interp eval [list set argv $argv] 28 $interp eval [list source [info script]] 29 interp delete $interp 30 return 31 } 32} 33 34proc bgerror {args} { 35 global errorInfo 36 puts stderr "http.test bgerror" 37 puts stderr [join $args] 38 puts stderr $errorInfo 39} 40 41# Do not use [info hostname]. 42# Name resolution is often a problem on OSX; not focus of HTTP package anyway. 43# Also a problem on other platforms for http-4.14 (test with bad port number). 44set HOST localhost 45set bindata "This is binary data\x0D\x0Amore\x0Dmore\x0Amore\x00null" 46catch {unset data} 47 48# Ensure httpd file exists 49 50set origFile [file join [pwd] [file dirname [info script]] httpd] 51set httpdFile [file join [temporaryDirectory] httpd_[pid]] 52if {![file exists $httpdFile]} { 53 makeFile "" $httpdFile 54 file delete $httpdFile 55 file copy $origFile $httpdFile 56 set removeHttpd 1 57} 58 59catch {package require Thread 2.7-} 60if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} { 61 set httpthread [thread::create -preserved] 62 thread::send $httpthread [list source $httpdFile] 63 thread::send $httpthread [list set bindata $bindata] 64 thread::send $httpthread {httpd_init 0; set port} port 65 puts "Running httpd in thread $httpthread" 66} else { 67 if {![file exists $httpdFile]} { 68 puts "Cannot read $httpdFile script, http test skipped" 69 unset port 70 return 71 } 72 source $httpdFile 73 # Let the OS pick the port; that's much more flexible 74 if {[catch {httpd_init 0} listen]} { 75 puts "Cannot start http server, http test skipped" 76 catch {unset port} 77 return 78 } 79} 80 81test http-1.1 {http::config} { 82 http::config -useragent UserAgent 83 http::config 84} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1] 85test http-1.2 {http::config} { 86 http::config -proxyfilter 87} http::ProxyRequired 88test http-1.3 {http::config} { 89 catch {http::config -junk} 90} 1 91test http-1.4 {http::config} { 92 set savedconf [http::config] 93 http::config -proxyhost nowhere.come -proxyport 8080 \ 94 -proxyfilter myFilter -useragent "Tcl Test Suite" \ 95 -urlencoding iso8859-1 96 set x [http::config] 97 http::config {*}$savedconf 98 set x 99} {-accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1} 100test http-1.5 {http::config} -returnCodes error -body { 101 http::config -proxyhost {} -junk 8080 102} -result {Unknown option -junk, must be: -accept, -cookiejar, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip} 103test http-1.6 {http::config} -setup { 104 set oldenc [http::config -urlencoding] 105} -body { 106 set enc [list [http::config -urlencoding]] 107 http::config -urlencoding iso8859-1 108 lappend enc [http::config -urlencoding] 109} -cleanup { 110 http::config -urlencoding $oldenc 111} -result {utf-8 iso8859-1} 112 113test http-2.1 {http::reset} { 114 catch {http::reset http#1} 115} 0 116 117test http-3.1 {http::geturl} -returnCodes error -body { 118 http::geturl -bogus flag 119} -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} 120test http-3.2 {http::geturl} -returnCodes error -body { 121 http::geturl http:junk 122} -result {Unsupported URL: http:junk} 123set url //${::HOST}:$port 124set badurl //${::HOST}:[expr {$port+1}] 125test http-3.3 {http::geturl} -body { 126 set token [http::geturl $url] 127 http::data $token 128} -cleanup { 129 http::cleanup $token 130} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> 131<h1>Hello, World!</h1> 132<h2>GET /</h2> 133</body></html>" 134set tail /a/b/c 135set url //${::HOST}:$port/a/b/c 136set fullurl HTTP://user:pass@${::HOST}:$port/a/b/c 137set binurl //${::HOST}:$port/binary 138set xmlurl //${::HOST}:$port/xml 139set posturl //${::HOST}:$port/post 140set badposturl //${::HOST}:$port/droppost 141set authorityurl //${::HOST}:$port 142set ipv6url http://\[::1\]:$port/ 143test http-3.4 {http::geturl} -body { 144 set token [http::geturl $url] 145 http::data $token 146} -cleanup { 147 http::cleanup $token 148} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> 149<h1>Hello, World!</h1> 150<h2>GET $tail</h2> 151</body></html>" 152proc selfproxy {host} { 153 global port 154 return [list ${::HOST} $port] 155} 156test http-3.5 {http::geturl} -body { 157 http::config -proxyfilter selfproxy 158 set token [http::geturl $url] 159 http::data $token 160} -cleanup { 161 http::config -proxyfilter http::ProxyRequired 162 http::cleanup $token 163} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> 164<h1>Hello, World!</h1> 165<h2>GET http:$url</h2> 166</body></html>" 167test http-3.6 {http::geturl} -body { 168 http::config -proxyfilter bogus 169 set token [http::geturl $url] 170 http::data $token 171} -cleanup { 172 http::config -proxyfilter http::ProxyRequired 173 http::cleanup $token 174} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> 175<h1>Hello, World!</h1> 176<h2>GET $tail</h2> 177</body></html>" 178test http-3.7 {http::geturl} -body { 179 set token [http::geturl $url -headers {Pragma no-cache}] 180 http::data $token 181} -cleanup { 182 http::cleanup $token 183} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> 184<h1>Hello, World!</h1> 185<h2>GET $tail</h2> 186</body></html>" 187test http-3.8 {http::geturl} -body { 188 set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 3000] 189 http::data $token 190} -cleanup { 191 http::cleanup $token 192} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> 193<h1>Hello, World!</h1> 194<h2>POST $tail</h2> 195<h2>Query</h2> 196<dl> 197<dt>Name<dd>Value 198<dt>Foo<dd>Bar 199</dl> 200</body></html>" 201test http-3.9 {http::geturl} -body { 202 set token [http::geturl $url -validate 1] 203 http::code $token 204} -cleanup { 205 http::cleanup $token 206} -result "HTTP/1.0 200 OK" 207test http-3.10 {http::geturl queryprogress} -setup { 208 set query foo=bar 209 set sep "" 210 set i 0 211 # Create about 120K of query data 212 while {$i < 14} { 213 incr i 214 append query $sep$query 215 set sep & 216 } 217} -body { 218 proc postProgress {token x y} { 219 global postProgress 220 lappend postProgress $y 221 } 222 set postProgress {} 223 set t [http::geturl $posturl -keepalive 0 -query $query \ 224 -queryprogress postProgress -queryblocksize 16384] 225 http::wait $t 226 list [http::status $t] [string length $query] $postProgress [http::data $t] 227} -cleanup { 228 http::cleanup $t 229} -result {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}} 230test http-3.11 {http::geturl querychannel with -command} -setup { 231 set query foo=bar 232 set sep "" 233 set i 0 234 # Create about 120K of query data 235 while {$i < 14} { 236 incr i 237 append query $sep$query 238 set sep & 239 } 240 set file [makeFile $query outdata] 241} -body { 242 set fp [open $file] 243 proc asyncCB {token} { 244 global postResult 245 lappend postResult [http::data $token] 246 } 247 set postResult [list ] 248 set t [http::geturl $posturl -querychannel $fp] 249 http::wait $t 250 set testRes [list [http::status $t] [string length $query] [http::data $t]] 251 # Now do async 252 http::cleanup $t 253 close $fp 254 set fp [open $file] 255 set t [http::geturl $posturl -querychannel $fp -command asyncCB] 256 set postResult [list PostStart] 257 http::wait $t 258 close $fp 259 lappend testRes [http::status $t] $postResult 260} -cleanup { 261 removeFile outdata 262 http::cleanup $t 263} -result {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}} 264# On Linux platforms when the client and server are on the same host, the 265# client is unable to read the server's response one it hits the write error. 266# The status is "eof". 267# On Windows, the http::wait procedure gets a "connection reset by peer" error 268# while reading the reply. 269test http-3.12 {http::geturl querychannel with aborted request} -setup { 270 set query foo=bar 271 set sep "" 272 set i 0 273 # Create about 120K of query data 274 while {$i < 14} { 275 incr i 276 append query $sep$query 277 set sep & 278 } 279 set file [makeFile $query outdata] 280} -constraints {nonPortable} -body { 281 set fp [open $file] 282 proc asyncCB {token} { 283 global postResult 284 lappend postResult [http::data $token] 285 } 286 proc postProgress {token x y} { 287 global postProgress 288 lappend postProgress $y 289 } 290 set postProgress {} 291 # Now do async 292 set postResult [list PostStart] 293 if {[catch { 294 set t [http::geturl $badposturl -querychannel $fp -command asyncCB \ 295 -queryprogress postProgress] 296 http::wait $t 297 upvar #0 $t state 298 } err]} { 299 puts $::errorInfo 300 error $err 301 } 302 list [http::status $t] [http::code $t] 303} -cleanup { 304 removeFile outdata 305 http::cleanup $t 306} -result {ok {HTTP/1.0 200 Data follows}} 307test http-3.13 {http::geturl socket leak test} { 308 set chanCount [llength [file channels]] 309 for {set i 0} {$i < 3} {incr i} { 310 catch {http::geturl $badurl -timeout 5000} 311 } 312 # No extra channels should be taken 313 expr {[llength [file channels]] == $chanCount} 314} 1 315test http-3.14 "http::geturl $fullurl" -body { 316 set token [http::geturl $fullurl -validate 1] 317 http::code $token 318} -cleanup { 319 http::cleanup $token 320} -result "HTTP/1.0 200 OK" 321test http-3.15 {http::geturl parse failures} -body { 322 http::geturl "{invalid}:url" 323} -returnCodes error -result {Unsupported URL: {invalid}:url} 324test http-3.16 {http::geturl parse failures} -body { 325 http::geturl http:relative/url 326} -returnCodes error -result {Unsupported URL: http:relative/url} 327test http-3.17 {http::geturl parse failures} -body { 328 http::geturl /absolute/url 329} -returnCodes error -result {Missing host part: /absolute/url} 330test http-3.18 {http::geturl parse failures} -body { 331 http::geturl http://somewhere:123456789/ 332} -returnCodes error -result {Invalid port number: 123456789} 333test http-3.19 {http::geturl parse failures} -body { 334 http::geturl http://{user}@somewhere 335} -returnCodes error -result {Illegal characters in URL user} 336test http-3.20 {http::geturl parse failures} -body { 337 http::geturl http://%user@somewhere 338} -returnCodes error -result {Illegal encoding character usage "%us" in URL user} 339test http-3.21 {http::geturl parse failures} -body { 340 http::geturl http://somewhere/{path} 341} -returnCodes error -result {Illegal characters in URL path} 342test http-3.22 {http::geturl parse failures} -body { 343 http::geturl http://somewhere/%path 344} -returnCodes error -result {Illegal encoding character usage "%pa" in URL path} 345test http-3.23 {http::geturl parse failures} -body { 346 http::geturl http://somewhere/path?{query}? 347} -returnCodes error -result {Illegal characters in URL path} 348test http-3.24 {http::geturl parse failures} -body { 349 http::geturl http://somewhere/path?%query 350} -returnCodes error -result {Illegal encoding character usage "%qu" in URL path} 351test http-3.25 {http::meta} -setup { 352 unset -nocomplain m token 353} -body { 354 set token [http::geturl $url -timeout 3000] 355 array set m [http::meta $token] 356 lsort [array names m] 357} -cleanup { 358 http::cleanup $token 359 unset -nocomplain m token 360} -result {Content-Length Content-Type Date} 361test http-3.26 {http::meta} -setup { 362 unset -nocomplain m token 363} -body { 364 set token [http::geturl $url -headers {X-Check 1} -timeout 3000] 365 array set m [http::meta $token] 366 lsort [array names m] 367} -cleanup { 368 http::cleanup $token 369 unset -nocomplain m token 370} -result {Content-Length Content-Type Date X-Check} 371test http-3.27 {http::geturl: -headers override -type} -body { 372 set token [http::geturl $url/headers -type "text/plain" -query dummy \ 373 -headers [list "Content-Type" "text/plain;charset=utf-8"]] 374 http::data $token 375} -cleanup { 376 http::cleanup $token 377} -match regexp -result {(?n)Host .* 378User-Agent .* 379Connection close 380Content-Type {text/plain;charset=utf-8} 381Accept \*/\* 382Accept-Encoding .* 383Content-Length 5} 384test http-3.28 {http::geturl: -headers override -type default} -body { 385 set token [http::geturl $url/headers -query dummy \ 386 -headers [list "Content-Type" "text/plain;charset=utf-8"]] 387 http::data $token 388} -cleanup { 389 http::cleanup $token 390} -match regexp -result {(?n)Host .* 391User-Agent .* 392Connection close 393Content-Type {text/plain;charset=utf-8} 394Accept \*/\* 395Accept-Encoding .* 396Content-Length 5} 397test http-3.29 {http::geturl IPv6 address} -body { 398 # We only want to see if the URL gets parsed correctly. This is 399 # the case if http::geturl succeeds or returns a socket related 400 # error. If the parsing is wrong, we'll get a parse error. 401 # It'd be better to separate the URL parser from http::geturl, so 402 # that it can be tested without also trying to make a connection. 403 set error [catch {http::geturl $ipv6url -validate 1} token] 404 if {$error && [string match "couldn't open socket: *" $token]} { 405 set error 0 406 } 407 set error 408} -cleanup { 409 catch { http::cleanup $token } 410} -result 0 411test http-3.30 {http::geturl query without path} -body { 412 set token [http::geturl $authorityurl?var=val] 413 http::ncode $token 414} -cleanup { 415 catch { http::cleanup $token } 416} -result 200 417test http-3.31 {http::geturl fragment without path} -body { 418 set token [http::geturl "$authorityurl#fragment42"] 419 http::ncode $token 420} -cleanup { 421 catch { http::cleanup $token } 422} -result 200 423# Bug c11a51c482 424test http-3.32 {http::geturl: -headers override -accept default} -body { 425 set token [http::geturl $url/headers -query dummy \ 426 -headers [list "Accept" "text/plain,application/tcl-test-value"]] 427 http::data $token 428} -cleanup { 429 http::cleanup $token 430} -match regexp -result {(?n)Host .* 431User-Agent .* 432Connection close 433Accept text/plain,application/tcl-test-value 434Accept-Encoding .* 435Content-Type application/x-www-form-urlencoded 436Content-Length 5} 437# Bug 838e99a76d 438test http-3.33 {http::geturl application/xml is text} -body { 439 set token [http::geturl "$xmlurl"] 440 scan [http::data $token] "<%\[^>]>%c<%\[^>]>" 441} -cleanup { 442 catch { http::cleanup $token } 443} -result {test 4660 /test} 444test http-3.34 {http::geturl -headers not a dict} -returnCodes error -body { 445 http::geturl http://test/t -headers NoDict 446} -result {Bad value for -headers (NoDict), must be dict} 447 448test http-4.1 {http::Event} -body { 449 set token [http::geturl $url -keepalive 0] 450 upvar #0 $token data 451 array set meta $data(meta) 452 expr {($data(totalsize) == $meta(Content-Length))} 453} -cleanup { 454 http::cleanup $token 455} -result 1 456test http-4.2 {http::Event} -body { 457 set token [http::geturl $url] 458 upvar #0 $token data 459 array set meta $data(meta) 460 string compare $data(type) [string trim $meta(Content-Type)] 461} -cleanup { 462 http::cleanup $token 463} -result 0 464test http-4.3 {http::Event} -body { 465 set token [http::geturl $url] 466 http::code $token 467} -cleanup { 468 http::cleanup $token 469} -result {HTTP/1.0 200 Data follows} 470test http-4.4 {http::Event} -setup { 471 set testfile [makeFile "" testfile] 472} -body { 473 set out [open $testfile w] 474 set token [http::geturl $url -channel $out] 475 close $out 476 set in [open $testfile] 477 set x [read $in] 478} -cleanup { 479 catch {close $in} 480 catch {close $out} 481 removeFile $testfile 482 http::cleanup $token 483} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> 484<h1>Hello, World!</h1> 485<h2>GET $tail</h2> 486</body></html>" 487test http-4.5 {http::Event} -setup { 488 set testfile [makeFile "" testfile] 489} -body { 490 set out [open $testfile w] 491 fconfigure $out -translation lf 492 set token [http::geturl $url -channel $out] 493 close $out 494 upvar #0 $token data 495 expr {$data(currentsize) == $data(totalsize)} 496} -cleanup { 497 removeFile $testfile 498 http::cleanup $token 499} -result 1 500test http-4.6 {http::Event} -setup { 501 set testfile [makeFile "" testfile] 502} -body { 503 set out [open $testfile w] 504 set token [http::geturl $binurl -channel $out] 505 close $out 506 set in [open $testfile] 507 fconfigure $in -translation binary 508 read $in 509} -cleanup { 510 catch {close $in} 511 catch {close $out} 512 removeFile $testfile 513 http::cleanup $token 514} -result "$bindata[string trimleft $binurl /]" 515proc myProgress {token total current} { 516 global progress httpLog 517 if {[info exists httpLog] && $httpLog} { 518 puts "progress $total $current" 519 } 520 set progress [list $total $current] 521} 522test http-4.6.1 {http::Event} knownBug { 523 set token [http::geturl $url -blocksize 50 -progress myProgress] 524 return $progress 525} {111 111} 526test http-4.7 {http::Event} -body { 527 set token [http::geturl $url -keepalive 0 -progress myProgress] 528 return $progress 529} -cleanup { 530 http::cleanup $token 531} -result {111 111} 532test http-4.8 {http::Event} -body { 533 set token [http::geturl $url] 534 http::status $token 535} -cleanup { 536 http::cleanup $token 537} -result {ok} 538test http-4.9 {http::Event} -body { 539 set token [http::geturl $url -progress myProgress] 540 http::code $token 541} -cleanup { 542 http::cleanup $token 543} -result {HTTP/1.0 200 Data follows} 544test http-4.10 {http::Event} -body { 545 set token [http::geturl $url -progress myProgress] 546 http::size $token 547} -cleanup { 548 http::cleanup $token 549} -result {111} 550# Timeout cases 551# Short timeout to working server (the test server). This lets us try a 552# reset during the connection. 553test http-4.11 {http::Event} -body { 554 set token [http::geturl $url -timeout 1 -keepalive 0 -command \#] 555 http::reset $token 556 http::status $token 557} -cleanup { 558 http::cleanup $token 559} -result {reset} 560# Longer timeout with reset. 561test http-4.12 {http::Event} -body { 562 set token [http::geturl $url/?timeout=10 -keepalive 0 -command \#] 563 http::reset $token 564 http::status $token 565} -cleanup { 566 http::cleanup $token 567} -result {reset} 568# Medium timeout to working server that waits even longer. The timeout 569# hits while waiting for a reply. 570test http-4.13 {http::Event} -body { 571 set token [http::geturl $url?timeout=30 -keepalive 0 -timeout 10 -command \#] 572 http::wait $token 573 http::status $token 574} -cleanup { 575 http::cleanup $token 576} -result {timeout} 577# Longer timeout to good host, bad port, gets an error after the 578# connection "completes" but the socket is bad. 579test http-4.14 {http::Event} -body { 580 set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command \#] 581 if {$token eq ""} { 582 error "bogus return from http::geturl" 583 } 584 http::wait $token 585 lindex [http::error $token] 0 586} -cleanup { 587 catch {http::cleanup $token} 588} -result {connect failed connection refused} 589# Bogus host 590test http-4.15 {http::Event} -body { 591 # This test may fail if you use a proxy server. That is to be 592 # expected and is not a problem with Tcl. 593 set token [http::geturl //not_a_host.tcl.tk -timeout 3000 -command \#] 594 http::wait $token 595 http::status $token 596 # error codes vary among platforms. 597} -cleanup { 598 catch {http::cleanup $token} 599} -returnCodes 1 -match glob -result "couldn't open socket*" 600test http-4.16 {Leak with Close vs Keepalive (bug [6ca52aec14]} -setup { 601 proc list-difference {l1 l2} { 602 lmap item $l2 {if {$item in $l1} continue; set item} 603 } 604} -body { 605 set before [chan names] 606 set token [http::geturl $url -headers {X-Connection keep-alive}] 607 http::cleanup $token 608 update 609 # Compute what channels have been unexpectedly leaked past cleanup 610 list-difference $before [chan names] 611} -cleanup { 612 rename list-difference {} 613} -result {} 614 615test http-5.1 {http::formatQuery} { 616 http::formatQuery name1 value1 name2 "value two" 617} {name1=value1&name2=value%20two} 618# test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5 619test http-5.3 {http::formatQuery} { 620 http::formatQuery lines "line1\nline2\nline3" 621} {lines=line1%0D%0Aline2%0D%0Aline3} 622test http-5.4 {http::formatQuery} { 623 http::formatQuery name1 ~bwelch name2 ¡¢¢ 624} {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2} 625test http-5.5 {http::formatQuery} { 626 set enc [http::config -urlencoding] 627 http::config -urlencoding iso8859-1 628 set res [http::formatQuery name1 ~bwelch name2 ¡¢¢] 629 http::config -urlencoding $enc 630 set res 631} {name1=~bwelch&name2=%A1%A2%A2} 632 633test http-6.1 {http::ProxyRequired} -body { 634 http::config -proxyhost ${::HOST} -proxyport $port 635 set token [http::geturl $url] 636 http::wait $token 637 upvar #0 $token data 638 set data(body) 639} -cleanup { 640 http::config -proxyhost {} -proxyport {} 641 http::cleanup $token 642} -result "<html><head><title>HTTP/1.0 TEST</title></head><body> 643<h1>Hello, World!</h1> 644<h2>GET http:$url</h2> 645</body></html>" 646 647test http-7.1 {http::mapReply} { 648 http::mapReply "abc\$\[\]\"\\()\}\{" 649} {abc%24%5B%5D%22%5C%28%29%7D%7B} 650test http-7.2 {http::mapReply} { 651 # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default, 652 # so make sure this gets converted to utf-8 then urlencoded. 653 http::mapReply "∈" 654} {%E2%88%88} 655test http-7.3 {http::formatQuery} -setup { 656 set enc [http::config -urlencoding] 657} -returnCodes error -body { 658 # this would be reverting to http <=2.4 behavior 659 http::config -urlencoding "" 660 http::mapReply "∈" 661} -cleanup { 662 http::config -urlencoding $enc 663} -result "can't read \"formMap(∈)\": no such element in array" 664test http-7.4 {http::formatQuery} -setup { 665 set enc [http::config -urlencoding] 666} -body { 667 # this would be reverting to http <=2.4 behavior w/o errors 668 # (unknown chars become '?') 669 http::config -urlencoding "iso8859-1" 670 http::mapReply "∈" 671} -cleanup { 672 http::config -urlencoding $enc 673} -result {%3F} 674 675package require tcl::idna 1.0 676 677test http-idna-1.1 {IDNA package: basics} -returnCodes error -body { 678 ::tcl::idna 679} -result {wrong # args: should be "::tcl::idna subcommand ?arg ...?"} 680test http-idna-1.2 {IDNA package: basics} -returnCodes error -body { 681 ::tcl::idna ? 682} -result {unknown or ambiguous subcommand "?": must be decode, encode, puny, or version} 683test http-idna-1.3 {IDNA package: basics} -body { 684 ::tcl::idna version 685} -result 1.0.1 686test http-idna-1.4 {IDNA package: basics} -returnCodes error -body { 687 ::tcl::idna version what 688} -result {wrong # args: should be "::tcl::idna version"} 689test http-idna-1.5 {IDNA package: basics} -returnCodes error -body { 690 ::tcl::idna puny 691} -result {wrong # args: should be "::tcl::idna puny subcommand ?arg ...?"} 692test http-idna-1.6 {IDNA package: basics} -returnCodes error -body { 693 ::tcl::idna puny ? 694} -result {unknown or ambiguous subcommand "?": must be decode, or encode} 695test http-idna-1.7 {IDNA package: basics} -returnCodes error -body { 696 ::tcl::idna puny encode 697} -result {wrong # args: should be "::tcl::idna puny encode string ?case?"} 698test http-idna-1.8 {IDNA package: basics} -returnCodes error -body { 699 ::tcl::idna puny encode a b c 700} -result {wrong # args: should be "::tcl::idna puny encode string ?case?"} 701test http-idna-1.9 {IDNA package: basics} -returnCodes error -body { 702 ::tcl::idna puny decode 703} -result {wrong # args: should be "::tcl::idna puny decode string ?case?"} 704test http-idna-1.10 {IDNA package: basics} -returnCodes error -body { 705 ::tcl::idna puny decode a b c 706} -result {wrong # args: should be "::tcl::idna puny decode string ?case?"} 707test http-idna-1.11 {IDNA package: basics} -returnCodes error -body { 708 ::tcl::idna decode 709} -result {wrong # args: should be "::tcl::idna decode hostname"} 710test http-idna-1.12 {IDNA package: basics} -returnCodes error -body { 711 ::tcl::idna encode 712} -result {wrong # args: should be "::tcl::idna encode hostname"} 713 714test http-idna-2.1 {puny encode: functional test} { 715 ::tcl::idna puny encode abc 716} abc- 717test http-idna-2.2 {puny encode: functional test} { 718 ::tcl::idna puny encode a€b€c 719} abc-k50ab 720test http-idna-2.3 {puny encode: functional test} { 721 ::tcl::idna puny encode ABC 722} ABC- 723test http-idna-2.4 {puny encode: functional test} { 724 ::tcl::idna puny encode A€B€C 725} ABC-k50ab 726test http-idna-2.5 {puny encode: functional test} { 727 ::tcl::idna puny encode ABC 0 728} abc- 729test http-idna-2.6 {puny encode: functional test} { 730 ::tcl::idna puny encode A€B€C 0 731} abc-k50ab 732test http-idna-2.7 {puny encode: functional test} { 733 ::tcl::idna puny encode ABC 1 734} ABC- 735test http-idna-2.8 {puny encode: functional test} { 736 ::tcl::idna puny encode A€B€C 1 737} ABC-k50ab 738test http-idna-2.9 {puny encode: functional test} { 739 ::tcl::idna puny encode abc 0 740} abc- 741test http-idna-2.10 {puny encode: functional test} { 742 ::tcl::idna puny encode a€b€c 0 743} abc-k50ab 744test http-idna-2.11 {puny encode: functional test} { 745 ::tcl::idna puny encode abc 1 746} ABC- 747test http-idna-2.12 {puny encode: functional test} { 748 ::tcl::idna puny encode a€b€c 1 749} ABC-k50ab 750test http-idna-2.13 {puny encode: edge cases} { 751 ::tcl::idna puny encode "" 752} "" 753test http-idna-2.14-A {puny encode: examples from RFC 3492} { 754 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 755 u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644 756 u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F 757 }]] ""] 758} egbpdaj6bu4bxfgehfvwxn 759test http-idna-2.14-B {puny encode: examples from RFC 3492} { 760 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 761 u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587 762 }]] ""] 763} ihqwcrb4cv8a8dqg056pqjye 764test http-idna-2.14-C {puny encode: examples from RFC 3492} { 765 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 766 u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587 767 }]] ""] 768} ihqwctvzc91f659drss3x8bo0yb 769test http-idna-2.14-D {puny encode: examples from RFC 3492} { 770 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 771 u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074 772 u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D 773 u+0065 u+0073 u+006B u+0079 774 }]] ""] 775} Proprostnemluvesky-uyb24dma41a 776test http-idna-2.14-E {puny encode: examples from RFC 3492} { 777 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 778 u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8 779 u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2 780 u+05D1 u+05E8 u+05D9 u+05EA 781 }]] ""] 782} 4dbcagdahymbxekheh6e0a7fei0b 783test http-idna-2.14-F {puny encode: examples from RFC 3492} { 784 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 785 u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D 786 u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939 787 u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947 788 u+0939 u+0948 u+0902 789 }]] ""] 790} i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd 791test http-idna-2.14-G {puny encode: examples from RFC 3492} { 792 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 793 u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092 794 u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B 795 }]] ""] 796} n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa 797test http-idna-2.14-H {puny encode: examples from RFC 3492} { 798 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 799 u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774 800 u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74 801 u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C 802 }]] ""] 803} 989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c 804test http-idna-2.14-I {puny encode: examples from RFC 3492} { 805 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 806 u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E 807 u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440 808 u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A 809 u+0438 810 }]] ""] 811} b1abfaaepdrnnbgefbadotcwatmq2g4l 812test http-idna-2.14-J {puny encode: examples from RFC 3492} { 813 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 814 u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070 815 u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070 816 u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061 817 u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070 818 u+0061 u+00F1 u+006F u+006C 819 }]] ""] 820} PorqunopuedensimplementehablarenEspaol-fmd56a 821test http-idna-2.14-K {puny encode: examples from RFC 3492} { 822 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 823 u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B 824 u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068 825 u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067 826 u+0056 u+0069 u+1EC7 u+0074 827 }]] ""] 828} TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g 829test http-idna-2.14-L {puny encode: examples from RFC 3492} { 830 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 831 u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F 832 }]] ""] 833} 3B-ww4c5e180e575a65lsy2b 834test http-idna-2.14-M {puny encode: examples from RFC 3492} { 835 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 836 u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074 837 u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D 838 u+004F u+004E u+004B u+0045 u+0059 u+0053 839 }]] ""] 840} -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n 841test http-idna-2.14-N {puny encode: examples from RFC 3492} { 842 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 843 u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F 844 u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D 845 u+305D u+308C u+305E u+308C u+306E u+5834 u+6240 846 }]] ""] 847} Hello-Another-Way--fc4qua05auwb3674vfr0b 848test http-idna-2.14-O {puny encode: examples from RFC 3492} { 849 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 850 u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032 851 }]] ""] 852} 2-u9tlzr9756bt3uc0v 853test http-idna-2.14-P {puny encode: examples from RFC 3492} { 854 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 855 u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059 856 u+308B u+0035 u+79D2 u+524D 857 }]] ""] 858} MajiKoi5-783gue6qz075azm5e 859test http-idna-2.14-Q {puny encode: examples from RFC 3492} { 860 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 861 u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0 862 }]] ""] 863} de-jg4avhby1noc0d 864test http-idna-2.14-R {puny encode: examples from RFC 3492} { 865 ::tcl::idna puny encode [join [subst [string map {u+ \\u} { 866 u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067 867 }]] ""] 868} d9juau41awczczp 869test http-idna-2.14-S {puny encode: examples from RFC 3492} { 870 ::tcl::idna puny encode {-> $1.00 <-} 871} {-> $1.00 <--} 872 873test http-idna-3.1 {puny decode: functional test} { 874 ::tcl::idna puny decode abc- 875} abc 876test http-idna-3.2 {puny decode: functional test} { 877 ::tcl::idna puny decode abc-k50ab 878} a€b€c 879test http-idna-3.3 {puny decode: functional test} { 880 ::tcl::idna puny decode ABC- 881} ABC 882test http-idna-3.4 {puny decode: functional test} { 883 ::tcl::idna puny decode ABC-k50ab 884} A€B€C 885test http-idna-3.5 {puny decode: functional test} { 886 ::tcl::idna puny decode ABC-K50AB 887} A€B€C 888test http-idna-3.6 {puny decode: functional test} { 889 ::tcl::idna puny decode abc-K50AB 890} a€b€c 891test http-idna-3.7 {puny decode: functional test} { 892 ::tcl::idna puny decode ABC- 0 893} abc 894test http-idna-3.8 {puny decode: functional test} { 895 ::tcl::idna puny decode ABC-K50AB 0 896} a€b€c 897test http-idna-3.9 {puny decode: functional test} { 898 ::tcl::idna puny decode ABC- 1 899} ABC 900test http-idna-3.10 {puny decode: functional test} { 901 ::tcl::idna puny decode ABC-K50AB 1 902} A€B€C 903test http-idna-3.11 {puny decode: functional test} { 904 ::tcl::idna puny decode abc- 0 905} abc 906test http-idna-3.12 {puny decode: functional test} { 907 ::tcl::idna puny decode abc-k50ab 0 908} a€b€c 909test http-idna-3.13 {puny decode: functional test} { 910 ::tcl::idna puny decode abc- 1 911} ABC 912test http-idna-3.14 {puny decode: functional test} { 913 ::tcl::idna puny decode abc-k50ab 1 914} A€B€C 915test http-idna-3.15 {puny decode: edge cases and errors} { 916 # Is this case actually correct? 917 binary encode hex [encoding convertto utf-8 [::tcl::idna puny decode abc]] 918} c282c281c280 919test http-idna-3.16 {puny decode: edge cases and errors} -returnCodes error -body { 920 ::tcl::idna puny decode abc! 921} -result {bad decode character "!"} 922test http-idna-3.17 {puny decode: edge cases and errors} { 923 catch {::tcl::idna puny decode abc!} -> opt 924 dict get $opt -errorcode 925} {PUNYCODE BAD_INPUT CHAR} 926test http-idna-3.18 {puny decode: edge cases and errors} { 927 ::tcl::idna puny decode "" 928} {} 929# A helper so we don't get lots of crap in failures 930proc hexify s {lmap c [split $s ""] {format u+%04X [scan $c %c]}} 931test http-idna-3.19-A {puny decode: examples from RFC 3492} { 932 hexify [::tcl::idna puny decode egbpdaj6bu4bxfgehfvwxn] 933} [list {*}{ 934 u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644 935 u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F 936}] 937test http-idna-3.19-B {puny decode: examples from RFC 3492} { 938 hexify [::tcl::idna puny decode ihqwcrb4cv8a8dqg056pqjye] 939} {u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587} 940test http-idna-3.19-C {puny decode: examples from RFC 3492} { 941 hexify [::tcl::idna puny decode ihqwctvzc91f659drss3x8bo0yb] 942} {u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587} 943test http-idna-3.19-D {puny decode: examples from RFC 3492} { 944 hexify [::tcl::idna puny decode Proprostnemluvesky-uyb24dma41a] 945} [list {*}{ 946 u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074 947 u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D 948 u+0065 u+0073 u+006B u+0079 949}] 950test http-idna-3.19-E {puny decode: examples from RFC 3492} { 951 hexify [::tcl::idna puny decode 4dbcagdahymbxekheh6e0a7fei0b] 952} [list {*}{ 953 u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8 954 u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2 955 u+05D1 u+05E8 u+05D9 u+05EA 956}] 957test http-idna-3.19-F {puny decode: examples from RFC 3492} { 958 hexify [::tcl::idna puny decode \ 959 i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd] 960} [list {*}{ 961 u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D 962 u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939 963 u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947 964 u+0939 u+0948 u+0902 965}] 966test http-idna-3.19-G {puny decode: examples from RFC 3492} { 967 hexify [::tcl::idna puny decode n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa] 968} [list {*}{ 969 u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092 970 u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B 971}] 972test http-idna-3.19-H {puny decode: examples from RFC 3492} { 973 hexify [::tcl::idna puny decode \ 974 989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c] 975} [list {*}{ 976 u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774 977 u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74 978 u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C 979}] 980test http-idna-3.19-I {puny decode: examples from RFC 3492} { 981 hexify [::tcl::idna puny decode b1abfaaepdrnnbgefbadotcwatmq2g4l] 982} [list {*}{ 983 u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E 984 u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440 985 u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A 986 u+0438 987}] 988test http-idna-3.19-J {puny decode: examples from RFC 3492} { 989 hexify [::tcl::idna puny decode \ 990 PorqunopuedensimplementehablarenEspaol-fmd56a] 991} [list {*}{ 992 u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070 993 u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070 994 u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061 995 u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070 996 u+0061 u+00F1 u+006F u+006C 997}] 998test http-idna-3.19-K {puny decode: examples from RFC 3492} { 999 hexify [::tcl::idna puny decode \ 1000 TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g] 1001} [list {*}{ 1002 u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B 1003 u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068 1004 u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067 1005 u+0056 u+0069 u+1EC7 u+0074 1006}] 1007test http-idna-3.19-L {puny decode: examples from RFC 3492} { 1008 hexify [::tcl::idna puny decode 3B-ww4c5e180e575a65lsy2b] 1009} {u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F} 1010test http-idna-3.19-M {puny decode: examples from RFC 3492} { 1011 hexify [::tcl::idna puny decode -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n] 1012} [list {*}{ 1013 u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074 1014 u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D 1015 u+004F u+004E u+004B u+0045 u+0059 u+0053 1016}] 1017test http-idna-3.19-N {puny decode: examples from RFC 3492} { 1018 hexify [::tcl::idna puny decode Hello-Another-Way--fc4qua05auwb3674vfr0b] 1019} [list {*}{ 1020 u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F 1021 u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D 1022 u+305D u+308C u+305E u+308C u+306E u+5834 u+6240 1023}] 1024test http-idna-3.19-O {puny decode: examples from RFC 3492} { 1025 hexify [::tcl::idna puny decode 2-u9tlzr9756bt3uc0v] 1026} {u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032} 1027test http-idna-3.19-P {puny decode: examples from RFC 3492} { 1028 hexify [::tcl::idna puny decode MajiKoi5-783gue6qz075azm5e] 1029} [list {*}{ 1030 u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059 1031 u+308B u+0035 u+79D2 u+524D 1032}] 1033test http-idna-3.19-Q {puny decode: examples from RFC 3492} { 1034 hexify [::tcl::idna puny decode de-jg4avhby1noc0d] 1035} {u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0} 1036test http-idna-3.19-R {puny decode: examples from RFC 3492} { 1037 hexify [::tcl::idna puny decode d9juau41awczczp] 1038} {u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067} 1039test http-idna-3.19-S {puny decode: examples from RFC 3492} { 1040 ::tcl::idna puny decode {-> $1.00 <--} 1041} {-> $1.00 <-} 1042rename hexify "" 1043 1044test http-idna-4.1 {IDNA encoding} { 1045 ::tcl::idna encode abc.def 1046} abc.def 1047test http-idna-4.2 {IDNA encoding} { 1048 ::tcl::idna encode a€b€c.def 1049} xn--abc-k50ab.def 1050test http-idna-4.3 {IDNA encoding} { 1051 ::tcl::idna encode def.a€b€c 1052} def.xn--abc-k50ab 1053test http-idna-4.4 {IDNA encoding} { 1054 ::tcl::idna encode ABC.DEF 1055} ABC.DEF 1056test http-idna-4.5 {IDNA encoding} { 1057 ::tcl::idna encode A€B€C.def 1058} xn--ABC-k50ab.def 1059test http-idna-4.6 {IDNA encoding: invalid edge case} { 1060 # Should this be an error? 1061 ::tcl::idna encode abc..def 1062} abc..def 1063test http-idna-4.7 {IDNA encoding: invalid char} -returnCodes error -body { 1064 ::tcl::idna encode abc.$.def 1065} -result {bad character "$" in DNS name} 1066test http-idna-4.7.1 {IDNA encoding: invalid char} { 1067 catch {::tcl::idna encode abc.$.def} -> opt 1068 dict get $opt -errorcode 1069} {IDNA INVALID_NAME_CHARACTER {$}} 1070test http-idna-4.8 {IDNA encoding: empty} { 1071 ::tcl::idna encode "" 1072} {} 1073set overlong www.[join [subst [string map {u+ \\u} { 1074 u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774 1075 u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74 1076 u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C 1077}]] ""].com 1078test http-idna-4.9 {IDNA encoding: max lengths from RFC 5890} -body { 1079 ::tcl::idna encode $overlong 1080} -returnCodes error -result "hostname part too long" 1081test http-idna-4.9.1 {IDNA encoding: max lengths from RFC 5890} { 1082 catch {::tcl::idna encode $overlong} -> opt 1083 dict get $opt -errorcode 1084} {IDNA OVERLONG_PART xn--989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c} 1085unset overlong 1086test http-idna-4.10 {IDNA encoding: edge cases} { 1087 ::tcl::idna encode passé.example.com 1088} xn--pass-epa.example.com 1089 1090test http-idna-5.1 {IDNA decoding} { 1091 ::tcl::idna decode abc.def 1092} abc.def 1093test http-idna-5.2 {IDNA decoding} { 1094 # Invalid entry that's just a wrapper 1095 ::tcl::idna decode xn--abc-.def 1096} abc.def 1097test http-idna-5.3 {IDNA decoding} { 1098 # Invalid entry that's just a wrapper 1099 ::tcl::idna decode xn--abc-.xn--def- 1100} abc.def 1101test http-idna-5.4 {IDNA decoding} { 1102 # Invalid entry that's just a wrapper 1103 ::tcl::idna decode XN--abc-.XN--def- 1104} abc.def 1105test http-idna-5.5 {IDNA decoding: error cases} -returnCodes error -body { 1106 ::tcl::idna decode xn--$$$.example.com 1107} -result {bad decode character "$"} 1108test http-idna-5.5.1 {IDNA decoding: error cases} { 1109 catch {::tcl::idna decode xn--$$$.example.com} -> opt 1110 dict get $opt -errorcode 1111} {PUNYCODE BAD_INPUT CHAR} 1112test http-idna-5.6 {IDNA decoding: error cases} -returnCodes error -body { 1113 ::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def 1114} -result {exceeded input data} 1115test http-idna-5.6.1 {IDNA decoding: error cases} { 1116 catch {::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def} -> opt 1117 dict get $opt -errorcode 1118} {PUNYCODE BAD_INPUT LENGTH} 1119 1120# cleanup 1121catch {unset url} 1122catch {unset badurl} 1123catch {unset port} 1124catch {unset data} 1125if {[info exists httpthread]} { 1126 thread::release $httpthread 1127} else { 1128 close $listen 1129} 1130 1131if {[info exists removeHttpd]} { 1132 removeFile $httpdFile 1133} 1134 1135rename bgerror {} 1136::tcltest::cleanupTests 1137 1138# Local variables: 1139# mode: tcl 1140# End: 1141