# -*- tcl -*- # Tests for the cgi module. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1998-2000 by Ajuba Solutions # ------------------------------------------------------------------------- source [file join \ [file dirname [file dirname [file join [pwd] [info script]]]] \ devtools testutilities.tcl] testsNeedTcl 8.4 testsNeedTcltest 2 testing { useLocal ncgi.tcl ncgi } # ------------------------------------------------------------------------- set sub_ap $auto_path lappend sub_ap $::tcltest::testsDirectory set ncgiFile [localPath ncgi.tcl] set futlFile [tcllibPath fileutil/fileutil.tcl] set cmdlFile [tcllibPath cmdline/cmdline.tcl] # ------------------------------------------------------------------------- test ncgi-1.1 {ncgi::reset} { ncgi::reset list [info exist ncgi::query] [info exist ncgi::contenttype] } {0 0} test ncgi-1.2 {ncgi::reset} { ncgi::reset query=reset list $ncgi::query $ncgi::contenttype } {query=reset {}} test ncgi-1.3 {ncgi::reset} { ncgi::reset query=reset text/plain list $ncgi::query $ncgi::contenttype } {query=reset text/plain} test ncgi-2.1 {ncgi::query fake query data} { ncgi::reset "fake=query" ncgi::query set ncgi::query } "fake=query" test ncgi-2.2 {ncgi::query GET} { ncgi::reset set env(REQUEST_METHOD) GET set env(QUERY_STRING) name=value ncgi::query set ncgi::query } "name=value" test ncgi-2.3 {ncgi::query HEAD} { ncgi::reset set env(REQUEST_METHOD) HEAD catch {unset env(QUERY_STRING)} ncgi::query set ncgi::query } "" test ncgi-2.4 {ncgi::query POST} { ncgi::reset catch {unset env(QUERY_STRING)} set env(REQUEST_METHOD) POST set env(CONTENT_LENGTH) 10 makeFile [format { set auto_path {%s} source {%s} source {%s} source {%s} ncgi::query puts $ncgi::query exit } $sub_ap $cmdlFile $futlFile $ncgiFile] test1 ; # {} set f [open "|[list $::tcltest::tcltest test1]" r+] puts $f "name=value" flush $f gets $f line close $f removeFile test1 set line } "name=value" test ncgi-2.5 {ncgi::test} { ncgi::reset set env(CONTENT_TYPE) text/html ncgi::type } text/html test ncgi-2.6 {ncgi::test} { ncgi::reset foo=bar text/plain set env(CONTENT_TYPE) text/html ncgi::type } text/plain test ncgi-3.1 {ncgi::decode} { ncgi::decode abcdef0123 } abcdef0123 test ncgi-3.2 {ncgi::decode} { ncgi::decode {[abc]def$0123\x} } {[abc]def$0123\x} test ncgi-3.3 {ncgi::decode} { ncgi::decode {[a%25c]def$01%7E3\x%3D} } {[a%c]def$01~3\x=} test ncgi-3.4 {ncgi::decode} { ncgi::decode {hello+world} } {hello world} test ncgi-3.5 {ncgi::decode} { ncgi::decode {aik%C5%ABloa} } "aik\u016Bloa" ; # u+macron test ncgi-3.6 {ncgi::decode} { ncgi::decode {paran%C3%A1} } "paran\u00E1" ; # a+acute test ncgi-3.7 {ncgi::decode, bug 3601995} { ncgi::decode {%C4%85} } "\u0105" ; # a+ogonek test ncgi-3.8 {ncgi::decode, bug 3601995} { ncgi::decode {%E2%80%A0} } "\u2020" ; # dagger test ncgi-3.9 {ncgi::decode, bug 3601995} { ncgi::decode {%E2%A0%90} } "\u2810" ; # a braille pattern test ncgi-3.10 {ncgi::decode, bug 3601995, tkt [1f900bdf6b]} { ncgi::decode {%E2%B1} } "\u00e2\u00b1" ;# Changed with branch `ncgi-1f900bdf6b`, tkt [1f900bdf6b] test ncgi-4.1 {ncgi::encode} { ncgi::encode abcdef0123 } abcdef0123 test ncgi-4.2 {ncgi::encode} { ncgi::encode "\[abc\]def\$0123\\x" } {%5Babc%5Ddef%240123%5Cx} test ncgi-4.3 {ncgi::encode} { ncgi::encode {hello world} } {hello+world} test ncgi-4.4 {ncgi::encode} { ncgi::encode "hello\nworld\r\tbar" } {hello%0D%0Aworld%0D%09bar} test ncgi-5.1 {ncgi::nvlist} { ncgi::reset "name=hello+world&name2=%7ewelch" ncgi::nvlist } {name {hello world} name2 ~welch} test ncgi-5.2 {ncgi::nvlist} { ncgi::reset "name=&name2" application/x-www-urlencoded ncgi::nvlist } {name {} anonymous name2} test ncgi-5.3 {ncgi::nvlist} { ncgi::reset "name=&name2" application/x-www-form-urlencoded ncgi::nvlist } {name {} anonymous name2} test ncgi-5.4 {ncgi::nvlist} { ncgi::reset "name=&name2" application/xyzzy set code [catch ncgi::nvlist err] list $code $err } {1 {Unknown Content-Type: application/xyzzy}} # multipart tests at the end because I'm too lazy to renumber the tests test ncgi-6.1 {ncgi::parse, anonymous values} { ncgi::reset "name=&name2" ncgi::parse } {name anonymous} test ncgi-6.2 {ncgi::parse, no list restrictions} { ncgi::reset "name=value&name=value2" ncgi::parse } {name} test ncgi-7.1 {ncgi::input} { ncgi::reset catch {unset env(REQUEST_METHOD)} ncgi::input "name=value&name2=value2" } {name name2} test ncgi-7.2 {ncgi::input} { ncgi::reset "nameList=value1+stuff&nameList=value2+more" ncgi::input set ncgi::value(nameList) } {{value1 stuff} {value2 more}} test ncgi-7.3 {ncgi::input} { ncgi::reset "name=value&name=value2" catch {ncgi::input} err set err } {Multiple definitions of name encountered in input. If you're trying to do this intentionally (such as with select), the variable must have a "List" suffix.} test ncgi-8.1 {ncgi::value} { ncgi::reset "nameList=val+ue&nameList=value2" ncgi::input ncgi::value nameList } {{val ue} value2} test ncgi-8.2 {ncgi::value} { ncgi::reset "name=val+ue&name=value2" ncgi::parse ncgi::value name } {val ue} test ncgi-8.3 {ncgi::value} { ncgi::reset "name=val+ue&name=value2" ncgi::parse ncgi::value noname } {} test ncgi-9.1 {ncgi::valueList} { ncgi::reset "name=val+ue&name=value2" ncgi::parse ncgi::valueList name } {{val ue} value2} test ncgi-9.2 {ncgi::valueList} { ncgi::reset "name=val+ue&name=value2" ncgi::parse ncgi::valueList noname } {} test ncgi-10.1 {ncgi::import} { ncgi::reset "nameList=val+ue&nameList=value2" ncgi::input ncgi::import nameList set nameList } {{val ue} value2} test ncgi-10.2 {ncgi::import} { ncgi::reset "nameList=val+ue&nameList=value2" ncgi::input ncgi::import nameList myx set myx } {{val ue} value2} test ncgi-10.3 {ncgi::import} { ncgi::reset "nameList=val+ue&nameList=value2" ncgi::input ncgi::import noname set noname } {} test ncgi-10.4 {ncgi::importAll} { ncgi::reset "name1=val+ue&name2=value2" catch {unset name1} catch {unset name2} ncgi::parse ncgi::importAll list $name1 $name2 } {{val ue} value2} test ncgi-10.5 {ncgi::importAll} { ncgi::reset "name1=val+ue&name2=value2" catch {unset name1} catch {unset name2} catch {unset name3} ncgi::parse ncgi::importAll name2 name3 list [info exist name1] $name2 $name3 } {0 value2 {}} set URL http://www.tcltk.com/index.html test ncgi-11.1 {ncgi::redirect} { set env(REQUEST_URI) http://www.scriptics.com/cgi-bin/test.cgi set env(REQUEST_METHOD) GET set env(QUERY_STRING) {} set env(SERVER_NAME) www.scriptics.com set env(SERVER_PORT) 80 makeFile [format { set auto_path {%s} if {[catch { source %s source %s source %s ncgi::redirect %s } err]} { puts $err } exit } $sub_ap $cmdlFile $futlFile $ncgiFile $URL] test1 set f [open "|[list $::tcltest::tcltest test1]" r+] set res [read $f] close $f removeFile test1 set res } "Content-Type: text/html\nLocation: $URL\n\nPlease go to $URL\n" set URL /elsewhere/foo.html set URL2 http://www/elsewhere/foo.html test ncgi-11.2 {ncgi::redirect} { set env(REQUEST_URI) http://www/cgi-bin/test.cgi set env(REQUEST_METHOD) GET set env(QUERY_STRING) {} set env(SERVER_NAME) www.scriptics.com set env(SERVER_PORT) 80 makeFile [format { set auto_path {%s} if {[catch { source %s source %s source %s ncgi::setCookie -name CookieName -value 12345 ncgi::redirect %s } err]} { puts $err } exit } $sub_ap $cmdlFile $futlFile $ncgiFile $URL] test1 set f [open "|[list $::tcltest::tcltest test1]" r+] set res [read $f] close $f removeFile test1 set res } "Content-Type: text/html\nLocation: $URL2\nSet-Cookie: CookieName=12345 ;\n\nPlease go to $URL2\n" set URL foo.html set URL2 http://www.scriptics.com/cgi-bin/foo.html test ncgi-11.3 {ncgi::redirect} { set env(REQUEST_URI) http://www.scriptics.com/cgi-bin/test.cgi set env(REQUEST_METHOD) GET set env(QUERY_STRING) {} set env(SERVER_NAME) www.scriptics.com set env(SERVER_PORT) 80 makeFile [format { set auto_path {%s} if {[catch { source %s source %s source %s ncgi::redirect %s } err]} { puts $err } exit } $sub_ap $cmdlFile $futlFile $ncgiFile $URL] test1 set f [open "|[list $::tcltest::tcltest test1]" r+] set res [read $f] close $f removeFile test1 set res } "Content-Type: text/html\nLocation: $URL2\n\nPlease go to $URL2\n" set URL foo.html set URL2 http://www.scriptics.com/cgi-bin/foo.html test ncgi-11.4 {ncgi::redirect} { set env(REQUEST_URI) /cgi-bin/test.cgi set env(REQUEST_METHOD) GET set env(QUERY_STRING) {} set env(SERVER_NAME) www.scriptics.com set env(SERVER_PORT) 80 makeFile [format { set auto_path {%s} if {[catch { source %s source %s source %s ncgi::redirect %s } err]} { puts $err } exit } $sub_ap $cmdlFile $futlFile $ncgiFile $URL] test1 set f [open "|[list $::tcltest::tcltest test1]" r+] set res [read $f] close $f removeFile test1 set res } "Content-Type: text/html\nLocation: $URL2\n\nPlease go to $URL2\n" set URL foo.html set URL2 http://www.scriptics.com:8000/cgi-bin/foo.html test ncgi-11.5 {ncgi::redirect} { set env(REQUEST_URI) /cgi-bin/test.cgi set env(REQUEST_METHOD) GET set env(QUERY_STRING) {} set env(SERVER_NAME) www.scriptics.com set env(SERVER_PORT) 8000 makeFile [format { set auto_path {%s} if {[catch { source %s source %s source %s ncgi::redirect %s } err]} { puts $err } exit } $sub_ap $cmdlFile $futlFile $ncgiFile $URL] test1 set f [open "|[list $::tcltest::tcltest test1]" r+] set res [read $f] close $f removeFile test1 set res } "Content-Type: text/html\nLocation: $URL2\n\nPlease go to $URL2\n" set URL foo.html set URL2 https://www.scriptics.com/cgi-bin/foo.html test ncgi-11.6 {ncgi::redirect} { set env(REQUEST_URI) /cgi-bin/test.cgi set env(REQUEST_METHOD) GET set env(QUERY_STRING) {} set env(SERVER_NAME) www.scriptics.com set env(SERVER_PORT) 443 set env(HTTPS) "on" makeFile [format { set auto_path {%s} if {[catch { source %s source %s source %s ncgi::redirect %s } err]} { puts $err } exit } $sub_ap $cmdlFile $futlFile $ncgiFile $URL] test1 set f [open "|[list $::tcltest::tcltest test1]" r+] set res [read $f] close $f removeFile test1 set res } "Content-Type: text/html\nLocation: $URL2\n\nPlease go to $URL2\n" set URL login.tcl set URL2 https://foo.com/cgi-bin/login.tcl test ncgi-11.7 {ncgi::redirect} { set env(REQUEST_URI) https://foo.com/cgi-bin/view.tcl?path=/a/b/c set env(REQUEST_METHOD) GET set env(QUERY_STRING) {} set env(SERVER_NAME) foo.com set env(SERVER_PORT) 443 set env(HTTPS) "on" makeFile [format { set auto_path {%s} if {[catch { source %s source %s source %s ncgi::redirect %s } err]} { puts $err } exit } $sub_ap $cmdlFile $futlFile $ncgiFile $URL] test1 set f [open "|[list $::tcltest::tcltest test1]" r+] set res [read $f] close $f removeFile test1 set res } "Content-Type: text/html\nLocation: $URL2\n\nPlease go to $URL2\n" test ncgi-12.1 {ncgi::header} { makeFile [format { set auto_path {%s} if {[catch { source %s source %s source %s ncgi::header } err]} { puts $err } exit } $sub_ap $cmdlFile $futlFile $ncgiFile] test1 set f [open "|[list $::tcltest::tcltest test1]" r+] set res [read $f] close $f removeFile test1 set res } "Content-Type: text/html\n\n" test ncgi-12.2 {ncgi::header} { makeFile [format { set auto_path {%s} if {[catch { source %s source %s source %s ncgi::header text/plain } err]} { puts $err } exit } $sub_ap $cmdlFile $futlFile $ncgiFile] test1 set f [open "|[list $::tcltest::tcltest test1]" r+] set res [read $f] close $f removeFile test1 set res } "Content-Type: text/plain\n\n" test ncgi-12.3 {ncgi::header} { makeFile [format { set auto_path {%s} if {[catch { source %s source %s source %s ncgi::header text/html X-Comment "This is a test" } err]} { puts $err } exit } $sub_ap $cmdlFile $futlFile $ncgiFile] test1 set f [open "|[list $::tcltest::tcltest test1]" r+] set res [read $f] close $f removeFile test1 set res } "Content-Type: text/html\nX-Comment: This is a test\n\n" test ncgi-12.4 {ncgi::header} { makeFile [format { set auto_path {%s} if {[catch { source %s source %s source %s ncgi::setCookie -name Name -value {The+Value} ncgi::header } err]} { puts $err } exit } $sub_ap $cmdlFile $futlFile $ncgiFile] test1 set f [open "|[list $::tcltest::tcltest test1]" r+] set res [read $f] close $f removeFile test1 set res } "Content-Type: text/html\nSet-Cookie: Name=The+Value ;\n\n" test ncgi-13.1 {ncgi::parseMimeValue} { ncgi::parseMimeValue text/html } text/html test ncgi-13.2 {ncgi::parseMimeValue} { ncgi::parseMimeValue "text/html; charset=iso-8859-1" } {text/html {charset iso-8859-1}} test ncgi-13.3 {ncgi::parseMimeValue} { ncgi::parseMimeValue "text/html; charset='iso-8859-1'" } {text/html {charset iso-8859-1}} test ncgi-13.4 {ncgi::parseMimeValue} { ncgi::parseMimeValue "text/html; charset=\"iso-8859-1\"" } {text/html {charset iso-8859-1}} test ncgi-13.5 {ncgi::parseMimeValue} { ncgi::parseMimeValue "text/html; charset=\"iso-8859-1\"; ignored" } {text/html {charset iso-8859-1}} test ncgi-13.6 {ncgi::parseMimeValue} { ncgi::parseMimeValue "text/html; charset=\"iso-8859-1\"morecrap" } {text/html {charset iso-8859-1}} test ncgi-13.7 {ncgi::parseMimeValue} { ncgi::parseMimeValue {test/test; foo="bar\"baz\""} } {test/test {foo bar\"baz\"}} test ncgi-13.8 {ncgi::parseMimeValue} { ncgi::parseMimeValue {test/test; foo=""} } {test/test {foo {}}} test ncgi-14.1 {ncgi::multipart} { catch {ncgi::multipart "application/x-www-urlencoded" name=val+ue} err set err } {Not a multipart Content-Type: application/x-www-urlencoded} test ncgi-14.2 {ncgi::multipart} { catch {ncgi::multipart "multipart/form-data" {}} err set err } {No boundary given for multipart document} test ncgi-14.3 {ncgi::multipart} { set in [open [asset formdata.txt]] set X [read $in] close $in foreach line [split $X \n] { if {[string length $line] == 0} { break } if {[regexp {^Content-Type: (.*)$} $line x type]} { break } } regsub ".*?\n\n" $X {} X ncgi::reset $X $type ncgi::multipart $type $X } {field1 {{content-disposition form-data name field1} value} field2 {{content-disposition form-data name field2} {another value}} the_file_name {{content-disposition form-data name the_file_name filename {C:\Program Files\Netscape\Communicator\Program\nareadme.htm} content-type text/html} {