1#!../../xotcl-0.9.4/xotclsh 2# $Id: xocomm.test,v 1.4 2005/09/09 21:09:01 neumann Exp $ 3package require XOTcl 1; namespace import -force xotcl::* 4lappend auto_path [file dirname [info script]]/.. 5package require xotcl::test 1 6 7@ @File { 8 description { 9 This is a webclient used as a regression test. 10 When it is started it launches an xotcl-Web server as partner process. 11 It tests currently the basic functionality of: 12 <ul> 13 <li>GET and PUT requests 14 <li>Basic Access Control 15 </ul> 16 } 17} 18array set opt {-startServer 1} 19array set opt $argv 20 21set xotclsh [info nameofexecutable] 22set dir [file dir [info script]] 23set serverScript $dir/../apps/comm/webserver.xotcl 24set startCmd "$xotclsh $serverScript -root $dir/../doc -pkgdir $dir/.." 25puts $startCmd 26if {$opt(-startServer)} { 27 set PIPE [open "| $startCmd"] 28} else { 29 puts $startCmd 30} 31 32package require xotcl::comm::httpAccess 33package require xotcl::comm::ftp 34package require xotcl::trace 35 36#::xotcl::package verbose 1 37#::xotcl::package require xotcl::comm::httpAccess 38#::xotcl::package require xotcl::comm::ftp 39#::xotcl::package require xotcl::trace 40 41set hostport localhost:8086 42set protectedhostport localhost:9096 43 44set slowURL "http://quote.yahoo.com/q?s=^DJI&d=1d" 45set ftpURL "ftp://mohegan.wi-inf.uni-essen.de/welcome.msg" 46 47 48proc printError msg {puts stderr !!!$msg!!!} 49 50Object userPwd 51userPwd proc user {u} { 52 my set user $u 53 if {[set ::tcl_platform(platform)] == "windows"} { 54 my set user unknown 55 } 56} 57userPwd proc show {realm userVar pwVar} { 58 upvar $userVar u $pwVar pw 59 set u [my set user] 60 set pw test 61 return 1 62} 63 64Test parameter {{errorReport { 65 puts "\tcontent-length: \[r0::sink set contentLength\]\n\ 66 \tstatus-code: \[\[r0 set token\] set responseCode\]" 67}}} 68 69Test new -msg "Trying to load image logo-100.jpg ... " -count 1 \ 70 -verbose 1 \ 71 -pre "puts starting..." \ 72 -setResult {expr {[r0::sink set contentLength] == 1706}} \ 73 -cmd [list SimpleRequest r0 -url http://$hostport/logo-100.jpg] \ 74 75Test new -msg "Trying to PUT a file on web-server ... " -count 1 \ 76 -setResult {expr [[r0 set token] set responseCode] == 201} \ 77 -pre [list file delete -force $dir/../doc/junk.junk] \ 78 -cmd [list SimpleRequest r0 \ 79 -url http://$hostport/junk.junk \ 80 -method PUT \ 81 -data "this is a test\n" \ 82 -contentType plain/text] 83 84Test new -msg "And download it again ... " -count 1 \ 85 -setResult {expr [r0 getContentLength] == 15} \ 86 -post {file delete -force ../doc/junk.junk} \ 87 -cmd [list SimpleRequest r0 -url http://$hostport/junk.junk] 88 89Test new -msg "Get protected resource ... " -count 1 \ 90 -setResult {expr [r0 getContentLength] > 500} \ 91 -cmd [list SimpleRequest r0 -url http://$protectedhostport/ ] 92 93#Test new -msg "Try an FTP request $ftpURL ... " -count 1 \ 94 -setResult {expr [r0 getContentLength] > 100} \ 95 -cmd [list SimpleRequest r0 -url $ftpURL] 96 97#Test new -msg "Try timeout with slow URL $slowURL ... " -count 1 \ 98 -setResult {expr {[[r0 set token] set errormsg] == {timeout exceeded}}} \ 99 -cmd [list SimpleRequest r0 -url $slowURL -timeout 100] 100 101Test new -msg terminate -count 1 \ 102 -setResult {set x 1} \ 103 -cmd [list SimpleRequest r0 -url http://$protectedhostport/exit] \ 104 -post exit 105 106after 1000 {Test run} 107catch {vwait forever} 108 109