sl@0: # Commands covered: http_config, http_get, http_wait, http_reset
sl@0: #
sl@0: # This file contains a collection of tests for the http script library.
sl@0: # Sourcing this file into Tcl runs the tests and
sl@0: # generates output for errors. No output means no errors were found.
sl@0: #
sl@0: # Copyright (c) 1991-1993 The Regents of the University of California.
sl@0: # Copyright (c) 1994-1996 Sun Microsystems, Inc.
sl@0: # Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0: #
sl@0: # See the file "license.terms" for information on usage and redistribution
sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0: #
sl@0: # RCS: @(#) $Id: httpold.test,v 1.11 2002/10/03 13:34:32 dkf Exp $
sl@0:
sl@0: if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0: package require tcltest
sl@0: namespace import -force ::tcltest::*
sl@0: }
sl@0:
sl@0: if {[catch {package require http 1.0}]} {
sl@0: if {[info exists httpold]} {
sl@0: catch {puts "Cannot load http 1.0 package"}
sl@0: ::tcltest::cleanupTests
sl@0: return
sl@0: } else {
sl@0: catch {puts "Running http 1.0 tests in slave interp"}
sl@0: set interp [interp create httpold]
sl@0: $interp eval [list set httpold "running"]
sl@0: $interp eval [list set argv $argv]
sl@0: $interp eval [list source [info script]]
sl@0: interp delete $interp
sl@0: ::tcltest::cleanupTests
sl@0: return
sl@0: }
sl@0: }
sl@0:
sl@0: set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
sl@0: catch {unset data}
sl@0:
sl@0: ##
sl@0: ## The httpd script implement a stub http server
sl@0: ##
sl@0: source [file join [file dirname [info script]] httpd]
sl@0:
sl@0: set port 8010
sl@0: if [catch {httpd_init $port} listen] {
sl@0: puts "Cannot start http server, http test skipped"
sl@0: unset port
sl@0: ::tcltest::cleanupTests
sl@0: return
sl@0: }
sl@0:
sl@0: test httpold-1.1 {http_config} {
sl@0: http_config
sl@0: } {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}
sl@0:
sl@0: test httpold-1.2 {http_config} {
sl@0: http_config -proxyfilter
sl@0: } httpProxyRequired
sl@0:
sl@0: test httpold-1.3 {http_config} {
sl@0: catch {http_config -junk}
sl@0: } 1
sl@0:
sl@0: test httpold-1.4 {http_config} {
sl@0: http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
sl@0: set x [http_config]
sl@0: http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \
sl@0: -useragent "Tcl http client package 1.0"
sl@0: set x
sl@0: } {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}
sl@0:
sl@0: test httpold-1.5 {http_config} {
sl@0: catch {http_config -proxyhost {} -junk 8080}
sl@0: } 1
sl@0:
sl@0: test httpold-2.1 {http_reset} {
sl@0: catch {http_reset http#1}
sl@0: } 0
sl@0:
sl@0: test httpold-3.1 {http_get} {
sl@0: catch {http_get -bogus flag}
sl@0: } 1
sl@0: test httpold-3.2 {http_get} {
sl@0: catch {http_get http:junk} err
sl@0: set err
sl@0: } {Unsupported URL: http:junk}
sl@0:
sl@0: set url [info hostname]:$port
sl@0: test httpold-3.3 {http_get} {
sl@0: set token [http_get $url]
sl@0: http_data $token
sl@0: } "HTTP/1.0 TEST
sl@0: Hello, World!
sl@0: GET /
sl@0: "
sl@0:
sl@0: set tail /a/b/c
sl@0: set url [info hostname]:$port/a/b/c
sl@0: set binurl [info hostname]:$port/binary
sl@0:
sl@0: test httpold-3.4 {http_get} {
sl@0: set token [http_get $url]
sl@0: http_data $token
sl@0: } "HTTP/1.0 TEST
sl@0: Hello, World!
sl@0: GET $tail
sl@0: "
sl@0:
sl@0: proc selfproxy {host} {
sl@0: global port
sl@0: return [list [info hostname] $port]
sl@0: }
sl@0: test httpold-3.5 {http_get} {
sl@0: http_config -proxyfilter selfproxy
sl@0: set token [http_get $url]
sl@0: http_config -proxyfilter httpProxyRequired
sl@0: http_data $token
sl@0: } "HTTP/1.0 TEST
sl@0: Hello, World!
sl@0: GET http://$url
sl@0: "
sl@0:
sl@0: test httpold-3.6 {http_get} {
sl@0: http_config -proxyfilter bogus
sl@0: set token [http_get $url]
sl@0: http_config -proxyfilter httpProxyRequired
sl@0: http_data $token
sl@0: } "HTTP/1.0 TEST
sl@0: Hello, World!
sl@0: GET $tail
sl@0: "
sl@0:
sl@0: test httpold-3.7 {http_get} {
sl@0: set token [http_get $url -headers {Pragma no-cache}]
sl@0: http_data $token
sl@0: } "HTTP/1.0 TEST
sl@0: Hello, World!
sl@0: GET $tail
sl@0: "
sl@0:
sl@0: test httpold-3.8 {http_get} {
sl@0: set token [http_get $url -query Name=Value&Foo=Bar]
sl@0: http_data $token
sl@0: } "HTTP/1.0 TEST
sl@0: Hello, World!
sl@0: POST $tail
sl@0: Query
sl@0:
sl@0: - Name
- Value
sl@0:
- Foo
- Bar
sl@0:
sl@0: "
sl@0:
sl@0: test httpold-3.9 {http_get} {
sl@0: set token [http_get $url -validate 1]
sl@0: http_code $token
sl@0: } "HTTP/1.0 200 OK"
sl@0:
sl@0:
sl@0: test httpold-4.1 {httpEvent} {
sl@0: set token [http_get $url]
sl@0: upvar #0 $token data
sl@0: array set meta $data(meta)
sl@0: expr ($data(totalsize) == $meta(Content-Length))
sl@0: } 1
sl@0:
sl@0: test httpold-4.2 {httpEvent} {
sl@0: set token [http_get $url]
sl@0: upvar #0 $token data
sl@0: array set meta $data(meta)
sl@0: string compare $data(type) [string trim $meta(Content-Type)]
sl@0: } 0
sl@0:
sl@0: test httpold-4.3 {httpEvent} {
sl@0: set token [http_get $url]
sl@0: http_code $token
sl@0: } {HTTP/1.0 200 Data follows}
sl@0:
sl@0: test httpold-4.4 {httpEvent} {
sl@0: set testfile [makeFile "" testfile]
sl@0: set out [open $testfile w]
sl@0: set token [http_get $url -channel $out]
sl@0: close $out
sl@0: set in [open $testfile]
sl@0: set x [read $in]
sl@0: close $in
sl@0: removeFile $testfile
sl@0: set x
sl@0: } "HTTP/1.0 TEST
sl@0: Hello, World!
sl@0: GET $tail
sl@0: "
sl@0:
sl@0: test httpold-4.5 {httpEvent} {
sl@0: set testfile [makeFile "" testfile]
sl@0: set out [open $testfile w]
sl@0: set token [http_get $url -channel $out]
sl@0: close $out
sl@0: upvar #0 $token data
sl@0: removeFile $testfile
sl@0: expr $data(currentsize) == $data(totalsize)
sl@0: } 1
sl@0:
sl@0: test httpold-4.6 {httpEvent} {
sl@0: set testfile [makeFile "" testfile]
sl@0: set out [open $testfile w]
sl@0: set token [http_get $binurl -channel $out]
sl@0: close $out
sl@0: set in [open $testfile]
sl@0: fconfigure $in -translation binary
sl@0: set x [read $in]
sl@0: close $in
sl@0: removeFile $testfile
sl@0: set x
sl@0: } "$bindata$binurl"
sl@0:
sl@0: proc myProgress {token total current} {
sl@0: global progress httpLog
sl@0: if {[info exists httpLog] && $httpLog} {
sl@0: puts "progress $total $current"
sl@0: }
sl@0: set progress [list $total $current]
sl@0: }
sl@0: if 0 {
sl@0: # This test hangs on Windows95 because the client never gets EOF
sl@0: set httpLog 1
sl@0: test httpold-4.6 {httpEvent} {
sl@0: set token [http_get $url -blocksize 50 -progress myProgress]
sl@0: set progress
sl@0: } {111 111}
sl@0: }
sl@0: test httpold-4.7 {httpEvent} {
sl@0: set token [http_get $url -progress myProgress]
sl@0: set progress
sl@0: } {111 111}
sl@0: test httpold-4.8 {httpEvent} {
sl@0: set token [http_get $url]
sl@0: http_status $token
sl@0: } {ok}
sl@0: test httpold-4.9 {httpEvent} {
sl@0: set token [http_get $url -progress myProgress]
sl@0: http_code $token
sl@0: } {HTTP/1.0 200 Data follows}
sl@0: test httpold-4.10 {httpEvent} {
sl@0: set token [http_get $url -progress myProgress]
sl@0: http_size $token
sl@0: } {111}
sl@0: test httpold-4.11 {httpEvent} {
sl@0: set token [http_get $url -timeout 1 -command {#}]
sl@0: http_reset $token
sl@0: http_status $token
sl@0: } {reset}
sl@0: test httpold-4.12 {httpEvent} {
sl@0: update
sl@0: set x {}
sl@0: after 500 {lappend x ok}
sl@0: set token [http_get $url -timeout 1 -command {lappend x fail}]
sl@0: vwait x
sl@0: list [http_status $token] $x
sl@0: } {timeout ok}
sl@0:
sl@0: test httpold-5.1 {http_formatQuery} {
sl@0: http_formatQuery name1 value1 name2 "value two"
sl@0: } {name1=value1&name2=value+two}
sl@0:
sl@0: test httpold-5.2 {http_formatQuery} {
sl@0: http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
sl@0: } {name1=%7ebwelch&name2=%a1%a2%a2}
sl@0:
sl@0: test httpold-5.3 {http_formatQuery} {
sl@0: http_formatQuery lines "line1\nline2\nline3"
sl@0: } {lines=line1%0d%0aline2%0d%0aline3}
sl@0:
sl@0: test httpold-6.1 {httpProxyRequired} {
sl@0: update
sl@0: http_config -proxyhost [info hostname] -proxyport $port
sl@0: set token [http_get $url]
sl@0: http_wait $token
sl@0: http_config -proxyhost {} -proxyport {}
sl@0: upvar #0 $token data
sl@0: set data(body)
sl@0: } "HTTP/1.0 TEST
sl@0: Hello, World!
sl@0: GET http://$url
sl@0: "
sl@0:
sl@0: # cleanup
sl@0: catch {unset url}
sl@0: catch {unset port}
sl@0: catch {unset data}
sl@0: close $listen
sl@0: ::tcltest::cleanupTests
sl@0: return
sl@0:
sl@0:
sl@0:
sl@0:
sl@0:
sl@0:
sl@0:
sl@0:
sl@0:
sl@0:
sl@0:
sl@0: