📄 http.test
字号:
# 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.## See the file "license.terms" for information on usage and redistribution# of this file, and for a DISCLAIMER OF ALL WARRANTIES.### SCCS: @(#) http2.test 1.8 97/08/13 11:16:50if {[string compare test [info procs test]] == 1} then {source defs}if {[catch {package require http 2.0}]} { if {[info exist http2]} { catch {puts stderr "Cannot load http 2.0 package"} return } else { catch {puts stderr "Running http 2.0 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 }}############### The httpd_ procedures implement a stub http server. ########proc httpd_init {{port 8015}} { socket -server httpdAccept $port}proc httpd_log {args} { global httpLog if {[info exists httpLog] && $httpLog} { puts stderr "httpd: [join $args { }]" }}array set httpdErrors { 204 {No Content} 400 {Bad Request} 404 {Not Found} 503 {Service Unavailable} 504 {Service Temporarily Unavailable} }proc httpdError {sock code args} { global httpdErrors puts $sock "$code $httpdErrors($code)" httpd_log "error: [join $args { }]"}proc httpdAccept {newsock ipaddr port} { global httpd upvar #0 httpd$newsock data fconfigure $newsock -blocking 0 -translation {auto crlf} httpd_log $newsock Connect $ipaddr $port set data(ipaddr) $ipaddr fileevent $newsock readable [list httpdRead $newsock]}# read data from a client requestproc httpdRead { sock } { upvar #0 httpd$sock data set readCount [gets $sock line] if {![info exists data(state)]} { if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/1.0} \ $line x data(proto) data(url) data(query)] { set data(state) mime httpd_log $sock Query $line } else { httpdError $sock 400 httpd_log $sock Error "bad first line:$line" httpdSockDone $sock } return } # string compare $readCount 0 maps -1 to -1, 0 to 0, and > 0 to 1 set state [string compare $readCount 0],$data(state),$data(proto) httpd_log $sock $state switch -- $state { -1,mime,HEAD - -1,mime,GET - -1,mime,POST { # gets would block return } 0,mime,HEAD - 0,mime,GET - 0,query,POST { httpdRespond $sock } 0,mime,POST { set data(state) query } 1,mime,HEAD - 1,mime,POST - 1,mime,GET { if [regexp {([^:]+):[ ]*(.*)} $line dummy key value] { set data(mime,[string tolower $key]) $value } } 1,query,POST { append data(query) $line httpdRespond $sock } default { if [eof $sock] { httpd_log $sock Error "unexpected eof on <$data(url)> request" } else { httpd_log $sock Error "unhandled state <$state> fetching <$data(url)>" } httpdError $sock 404 httpdSockDone $sock } }}proc httpdSockDone { sock } {upvar #0 httpd$sock data unset data close $sock}# Respond to the query.set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"proc httpdRespond { sock } { global httpd bindata port upvar #0 httpd$sock data if {[string match *binary* $data(url)]} { set html "$bindata[info hostname]:$port$data(url)" set type application/octet-stream } else { set type text/html set html "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>$data(proto) $data(url)</h2>" if {[info exists data(query)] && [string length $data(query)]} { append html "<h2>Query</h2>\n<dl>\n" foreach {key value} [split $data(query) &=] { append html "<dt>$key<dd>$value\n" } append html </dl>\n } append html </body></html> } if {$data(proto) == "HEAD"} { puts $sock "HTTP/1.0 200 OK" } else { puts $sock "HTTP/1.0 200 Data follows" } puts $sock "Date: [clock format [clock clicks]]" puts $sock "Content-Type: $type" puts $sock "Content-Length: [string length $html]" puts $sock "" if {$data(proto) != "HEAD"} { fconfigure $sock -translation binary puts -nonewline $sock $html } httpd_log $sock Done "" httpdSockDone $sock}##################### end server ###########################set port 8010if [catch {httpd_init $port} listen] { puts stderr "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.0}}test http-1.2 {http::config} { http::config -proxyfilter} http::ProxyRequiredtest http-1.3 {http::config} { catch {http::config -junk}} 1test 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}} 1test http-2.1 {http::reset} { catch {http::reset http#1}} 0test http-3.1 {http::geturl} { catch {http::geturl -bogus flag}} 1test http-3.2 {http::geturl} { catch {http::geturl http:junk} err set err} {Unsupported URL: http:junk}set url [info hostname]:$porttest http-3.3 {http::geturl} { set token [http::geturl $url] http::data $token} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET /</h2></body></html>"set tail /a/b/cset url [info hostname]:$port/a/b/cset binurl [info hostname]:$port/binarytest http-3.4 {http::geturl} { set token [http::geturl $url] http::data $token} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET $tail</h2></body></html>"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} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET http://$url</h2></body></html>"test http-3.6 {http::geturl} { http::config -proxyfilter bogus set token [http::geturl $url] http::config -proxyfilter http::ProxyRequired http::data $token} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET $tail</h2></body></html>"test http-3.7 {http::geturl} { set token [http::geturl $url -headers {Pragma no-cache}] http::data $token} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET $tail</h2></body></html>"test http-3.8 {http::geturl} { set token [http::geturl $url -query Name=Value&Foo=Bar] http::data $token} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>POST $tail</h2><h2>Query</h2><dl><dt>Name<dd>Value<dt>Foo<dd>Bar</dl></body></html>"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))} 1test 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)]} 0test 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} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET $tail</h2></body></html>"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)} 1test 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}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 1 -command {#}] http::wait $token http::status $token} {timeout}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)} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET http://$url</h2></body></html>"unset urlunset portclose $listen⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -