# 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-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # # RCS: @(#) $Id: http.test,v 1.14 1999/11/22 20:15:04 welch Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import ::tcltest::* } if {[catch {package require http 2}]} { if {[info exist http2]} { catch {puts "Cannot load http 2.2 package"} return } else { catch {puts "Running http 2.2 tests in slave interp"} set interp [interp create http2] $interp eval [list set http2 "running"] $interp eval [list source [info script]] interp delete $interp return } } set port 8010 set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null" catch {unset data} # Ensure httpd file exists set origFile [file join $::tcltest::testsDirectory httpd] set newFile [file join $::tcltest::workingDirectory httpd] if {![file exists $newFile]} { file copy $origFile $newFile set removeHttpd 1 } set httpdFile [file join $::tcltest::workingDirectory httpd] if {[info commands testthread] == "testthread" && [file exists $httpdFile]} { set httpthread [testthread create " source $httpdFile testthread wait "] testthread send $httpthread [list set port $port] testthread send $httpthread [list set bindata $bindata] testthread send $httpthread {httpd_init $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 if [catch {httpd_init $port} listen] { puts "Cannot start http server, http test skipped" unset port return } } test http-1.1 {http::config} { http::config } {-accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 2.2}} 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" set x [http::config] eval http::config $savedconf set x } {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}} test http-1.5 {http::config} { catch {http::config -proxyhost {} -junk 8080} } 1 test http-2.1 {http::reset} { catch {http::reset http#1} } 0 test http-3.1 {http::geturl} { catch {http::geturl -bogus flag} } 1 test http-3.2 {http::geturl} { catch {http::geturl http:junk} err set err } {Unsupported URL: http:junk} set url [info hostname]:$port set badurl www.scriptics.com:6666 test http-3.3 {http::geturl} { set token [http::geturl $url] http::data $token } "HTTP/1.0 TEST

Hello, World!

GET /

" set tail /a/b/c set url [info hostname]:$port/a/b/c set binurl [info hostname]:$port/binary test http-3.4 {http::geturl} { set token [http::geturl $url] http::data $token } "HTTP/1.0 TEST

Hello, World!

GET $tail

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

Hello, World!

GET http://$url

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

Hello, World!

GET $tail

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

Hello, World!

GET $tail

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

Hello, World!

POST $tail

Query

Name
Value
Foo
Bar
" test http-3.9 {http::geturl} { set token [http::geturl $url -validate 1] http::code $token } "HTTP/1.0 200 OK" test http-4.1 {http::Event} { set token [http::geturl $url] upvar #0 $token data array set meta $data(meta) expr ($data(totalsize) == $meta(Content-Length)) } 1 test http-4.2 {http::Event} { set token [http::geturl $url] upvar #0 $token data array set meta $data(meta) string compare $data(type) [string trim $meta(Content-Type)] } 0 test http-4.3 {http::Event} { set token [http::geturl $url] http::code $token } {HTTP/1.0 200 Data follows} test http-4.4 {http::Event} { set out [open testfile w] set token [http::geturl $url -channel $out] close $out set in [open testfile] set x [read $in] close $in file delete testfile set x } "HTTP/1.0 TEST

Hello, World!

GET $tail

" test http-4.5 {http::Event} { set out [open testfile w] set token [http::geturl $url -channel $out] close $out upvar #0 $token data file delete testfile expr $data(currentsize) == $data(totalsize) } 1 test http-4.6 {http::Event} { set out [open testfile w] set token [http::geturl $binurl -channel $out] close $out set in [open testfile] fconfigure $in -translation binary set x [read $in] close $in file delete testfile set x } "$bindata$binurl" proc myProgress {token total current} { global progress httpLog if {[info exists httpLog] && $httpLog} { puts "progress $total $current" } set progress [list $total $current] } if 0 { # This test hangs on Windows95 because the client never gets EOF set httpLog 1 test http-4.6 {http::Event} { set token [http::geturl $url -blocksize 50 -progress myProgress] set progress } {111 111} } test http-4.7 {http::Event} { set token [http::geturl $url -progress myProgress] set progress } {111 111} test http-4.8 {http::Event} { set token [http::geturl $url] http::status $token } {ok} test http-4.9 {http::Event} { set token [http::geturl $url -progress myProgress] http::code $token } {HTTP/1.0 200 Data follows} test http-4.10 {http::Event} { set token [http::geturl $url -progress myProgress] http::size $token } {111} # Timeout cases # Short timeout to working server (the test server) # Short timeout to working server that waits longer # Short timeout to good host, bad port, hits in connection phase # Longer timeout to good host, bad port, hits in I/O phase test http-4.11 {http::Event} { set token [http::geturl $url -timeout 1 -command {#}] http::reset $token http::status $token } {reset} test http-4.12 {http::Event} { set token [http::geturl $url?timeout=10 -timeout 1 -command {#}] http::wait $token http::status $token } {timeout} test http-4.13 {http::Event} { set token [http::geturl $badurl/?timeout=10 -timeout 1 -command {#}] if {[string length $token] == 0} { error "bogus return from http::geturl" } http::wait $token http::status $token } {timeout} # Longer timeout hits after connection (to a bad socket!) completes test http-4.14 {http::Event} { set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command {#}] if {[string length $token] == 0} { error "bogus return from http::geturl" } http::wait $token http::status $token } {ioerror} # Bogus host test http-4.15 {http::Event} { set code [catch { set token [http::geturl not_a_host.scriptics.com -timeout 1000 -command {#}] http::wait $token http::status $token } err] # error code varies among platforms. list $code [string match "couldn't open socket*" $err] } {1 1} test http-5.1 {http::formatQuery} { http::formatQuery name1 value1 name2 "value two" } {name1=value1&name2=value+two} test http-5.2 {http::formatQuery} { http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2 } {name1=%7ebwelch&name2=%a1%a2%a2} test http-5.3 {http::formatQuery} { http::formatQuery lines "line1\nline2\nline3" } {lines=line1%0d%0aline2%0d%0aline3} test http-6.1 {http::ProxyRequired} { http::config -proxyhost [info hostname] -proxyport $port set token [http::geturl $url] http::wait $token http::config -proxyhost {} -proxyport {} upvar #0 $token data set data(body) } "HTTP/1.0 TEST

Hello, World!

GET http://$url

" # cleanup catch {unset url} catch {unset badurl} catch {unset port} catch {unset data} if {[info exists httpthread]} { testthread send -async $httpthread { testthread exit } } else { close $listen } if {[info exist removeHttpd]} { removeFile $httpdFile } ::tcltest::cleanupTests return