# -*- 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
#
# RCS: @(#) $Id: ncgi.test,v 1.19 2005/09/30 22:23:24 andreas_kupries Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}


if { [lsearch $auto_path [file dirname [info script]]] == -1 } {
    set auto_path [linsert $auto_path 0 [file dirname [info script]]]
}

package forget ncgi
catch {namespace delete ncgi}

set ncgiFile [file join [file dirname [info script]] ncgi.tcl]
set     sub_ap $auto_path
lappend sub_ap [file dirname [file dirname [info script]]]

if {[catch {source $ncgiFile} msg]} {
    puts "skipped [file tail [info script]]: $msg"
    return
}
puts "- ncgi [package present ncgi]"


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}
	ncgi::query
	puts $ncgi::query
    } $sub_ap $ncgiFile] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    puts $f "name=value"
    flush $f
    gets $f line
    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-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.4 {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
	ncgi::redirect %s
	} err]} {
	    puts $err
	}
    } $sub_ap $ncgiFile $URL] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    read $f
} "Content-Type: text/html\nLocation: $URL\n\nPlease go to <a href=\"$URL\">$URL</a>\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
	ncgi::setCookie -name CookieName -value 12345
	ncgi::redirect %s
	} err]} {
	    puts $err
	}
    } $sub_ap $ncgiFile $URL] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    read $f
} "Content-Type: text/html\nLocation: $URL2\nSet-Cookie: CookieName=12345 ;\n\nPlease go to <a href=\"$URL2\">$URL2</a>\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
	ncgi::redirect %s
	} err]} {
	    puts $err
	}
    } $sub_ap $ncgiFile $URL] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    read $f
} "Content-Type: text/html\nLocation: $URL2\n\nPlease go to <a href=\"$URL2\">$URL2</a>\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
	ncgi::redirect %s
	} err]} {
	    puts $err
	}
    } $sub_ap $ncgiFile $URL] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    read $f
} "Content-Type: text/html\nLocation: $URL2\n\nPlease go to <a href=\"$URL2\">$URL2</a>\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
	ncgi::redirect %s
	} err]} {
	    puts $err
	}
    } $sub_ap $ncgiFile $URL] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    read $f
} "Content-Type: text/html\nLocation: $URL2\n\nPlease go to <a href=\"$URL2\">$URL2</a>\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
	ncgi::redirect %s
	} err]} {
	    puts $err
	}
    } $sub_ap $ncgiFile $URL] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    read $f
} "Content-Type: text/html\nLocation: $URL2\n\nPlease go to <a href=\"$URL2\">$URL2</a>\n"

test ncgi-12.1 {ncgi::header} {
    makeFile [format {
	set auto_path {%s}
	if {[catch {
	source %s
	ncgi::header
	} err]} {
	    puts $err
	}
    } $sub_ap $ncgiFile] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    read $f
} "Content-Type: text/html\n\n"

test ncgi-12.2 {ncgi::header} {
    makeFile [format {
	set auto_path {%s}
	if {[catch {
	source %s
	ncgi::header text/plain
	} err]} {
	    puts $err
	}
    } $sub_ap $ncgiFile] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    read $f
} "Content-Type: text/plain\n\n"

test ncgi-12.3 {ncgi::header} {
    makeFile [format {
	set auto_path {%s}
	if {[catch {
	source %s
	ncgi::header text/html X-Comment "This is a test"
	} err]} {
	    puts $err
	}
    } $sub_ap $ncgiFile] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    read $f
} "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
	ncgi::setCookie -name Name -value {The+Value}
	ncgi::header
	} err]} {
	    puts $err
	}
    } $sub_ap $ncgiFile] test1
    set f [open "|[list $::tcltest::tcltest test1]" r+]
    read $f
} "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-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 [file join [file dirname [info script]] 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} {
<center><h1>
                  Netscape Address Book Sync for Palm Pilot
                                         User Guide
</h1></center>


}}}

test ncgi-14.4 {ncgi::multipart} {
    set in [open [file join [file dirname [info script]] 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::parse
    list [ncgi::value field1] [ncgi::value field2] [ncgi::value the_file_name]
} {value {another value} {
<center><h1>
                  Netscape Address Book Sync for Palm Pilot
                                         User Guide
</h1></center>


}}


test ncgi-14.6 {ncgi::multipart setValue} {
    set in [open [file join [file dirname [info script]] 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::parse
    ncgi::setValue userval1 foo
    ncgi::setValue userval2 "a b"
    list [ncgi::value field1] [ncgi::value field2] [ncgi::value userval1] [ncgi::value userval2] [ncgi::value the_file_name]
} {value {another value} foo {a b} {
<center><h1>
                  Netscape Address Book Sync for Palm Pilot
                                         User Guide
</h1></center>


}}

test ncgi-15.1 {ncgi::setValue} {
    ncgi::reset "nameList=val+ue&nameList=value2"
    ncgi::input
    ncgi::setValue foo 1
    ncgi::setValue bar "a b"
    list [ncgi::value nameList] [ncgi::value foo] [ncgi::value bar]
} {{{val ue} value2} 1 {a b}}




## ------------ tests for binary content and file upload ----------------

## some utility procedures to generate content 

set form_boundary {17661509020136}

proc genformcontent_type {} {
    global form_boundary
    return "multipart/form-data; boundary=\"$form_boundary\""
}

proc genformdata {bcontent} {

    global form_boundary

    proc genformdatapart {name cd value} {
	global form_boundary
	return "--$form_boundary\nContent-Disposition: form-data; name=\"$name\"$cd\n\n$value\n"
    }

    set a [genformdatapart field1 "" {value}]
    set b [genformdatapart field2 "" {another value}]
    set c [genformdatapart the_file_name "; filename=\"C:\\Program Files\\Netscape\\Communicator\\Program\\nareadme.htm\"\nContent-Type: text/html" $bcontent]

    return "$a$b$c--$form_boundary--\n" 
}

set binary_content "\r
\r
<center><h1>\r
                  Netscape Address Book Sync for Palm Pilot\r
                                         User Guide\r
</h1></center>\r
\r
"

test ncgi-14.5 {ncgi::multipart--check binary file} {

    global binary_content

    set X [genformdata $binary_content]

    ncgi::reset $X [genformcontent_type]
    ncgi::parse
    set content [ncgi::value the_file_name]
    list [ncgi::value field1] [ncgi::value field2] $content
} [list value {another value} $binary_content]


test ncgi-16.1 {ncgi::importFile} {

    global binary_content

    set X [genformdata $binary_content]

    ncgi::reset $X [genformcontent_type]
    ncgi::parse

    ncgi::importFile -client the_file_name

} "C:\\Program Files\\Netscape\\Communicator\\Program\\nareadme.htm"

test ncgi-16.2 {ncgi::importFile - content type} {

    global binary_content

    set X [genformdata $binary_content]

    ncgi::reset $X [genformcontent_type]
    ncgi::parse

    ncgi::importFile -type the_file_name

} text/html


test ncgi-16.3 {ncgi::importFile -- file contents} {

    global binary_content

    set X [genformdata $binary_content]

    ncgi::reset $X [genformcontent_type]
    ncgi::parse

    ncgi::importFile -data the_file_name

} $binary_content

test ncgi-16.4 {ncgi::importFile -- save file} {

    global binary_content

    set X [genformdata $binary_content]

    ncgi::reset $X [genformcontent_type]
    ncgi::parse

    set localfile [ncgi::importFile -server the_file_name]

    # get the contents of the local file to verify
    set in [open $localfile]
    fconfigure $in -translation binary
    set content [read $in]
    close $in
    file delete $localfile
    set content

} $binary_content

test ncgi-16.5 {ncgi::importFile -- save file, given name} {

    global binary_content

    set X [genformdata $binary_content]

    ncgi::reset $X [genformcontent_type]
    ncgi::parse

    set localfile [ncgi::importFile -server the_file_name fofo]

    # get the contents of the local file to verify
    set in [open $localfile]
    fconfigure $in -translation binary
    set content [read $in]
    close $in
    file delete $localfile
    set content

} $binary_content


test ncgi-16.6 {ncgi::importFile -- bad input} {

    set X "bad multipart data"

    ncgi::reset $X [genformcontent_type]
    ncgi::parse

    ncgi::importFile -client the_file_name

} {}


test ncgi-17.1 {ncgi::names} {
    ncgi::reset "name=hello+world&name2=%7ewelch"
    ncgi::names
} {name name2}

test ncgi-17.2 {ncgi::names} {
    ncgi::reset  "name=&name2"	application/x-www-urlencoded
    ncgi::names
} {name}

test ncgi-17.3 {ncgi::names} {
    ncgi::reset  "name=&name2"	application/x-www-form-urlencoded
    ncgi::names
} {name}

test ncgi-17.4 {ncgi::names} {
    ncgi::reset  "name=&name2"	application/xyzzy
    set code [catch ncgi::names err]
    list $code $err
} {1 {Unknown Content-Type: application/xyzzy}}



::tcltest::cleanupTests