#
# dispatch.test -- 
# nca-073-9
# 
# Copyright (c) 1996-2000 by Netcetera AG.
# Copyright (c) 2001 by Apache Software Foundation.
# All rights reserved.
#
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# @(#) $Id$
#

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

# set ::tcltest::verbose "bp"


# -----------------------------------------------------------------------------
# util
# -----------------------------------------------------------------------------

global dispatchTestLogCatcher
if {[info exists dispatchTestLogCatcher]} {unset dispatchTestLogCatcher}
web::request -reset

proc catchLogMsg {msg} {
    global dispatchTestLogCatcher
    set dispatchTestLogCatcher $msg
}
proc getLastCatchedLogMsg {} {
    global dispatchTestLogCatcher
    return $dispatchTestLogCatcher
}

# add log filter/dest for catcher
set dispatchTestLogLevel [web::loglevel add *.-debug]
set dispatchTestLogDest   [web::logdest add -format {$m} *.-debug command catchLogMsg]


proc cleanParam {} {
    web::cmdurlcfg -unset
    web::formvar -unset
    web::param -unset
    web::request -unset
}

proc writePostDataFile {fname content} {

    if { [file exists $fname]  == 0 } {

        set f2Id [open $fname "w"]
	fconfigure $f2Id -translation binary
        puts -nonewline $f2Id $content
        close $f2Id
    }
}

proc setAndParsePostDataFormData {} {

    cleanParam
    set fn "formvar-multipart-formdata.tst"

    writePostDataFile $fn "-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"i1a\"\u0d
\u0d
\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"i1\"\u0d
\u0d
1st\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"i2\"\u0d
\u0d
2nd\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"i3\"\u0d
\u0d
äöü%20\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"i4\"\u0d
\u0d
4th\u0d
4th (no newline)\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"i5\"\u0d
\u0d
5th\u0d
5th (newline)\u0d
\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"os\"\u0d
\u0d
Linux\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"os\"\u0d
\u0d
BeOs\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"country\"\u0d
\u0d
USA\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"phon\"\u0d
\u0d
M\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data;\u0d
name=\"tv\"\u0d
\u0d
on\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"vcr\"\u0d
\u0d
on\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"file\"; filename=\"test.dat\"\u0d
\u0d
\[begin\]
Test
\[end with one newline\]
\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"file2\"; filename=\"\"\u0d
\u0d
\u0d
-----------------------------6962123843993--\u0d
"

    set fileId [open $fn "r"]

    ## parse
    web::dispatch -querystring "" -cmd "" \
    -postdata $fileId end "multipart/form-data; boundary=---------------------------6962123843993"
    close $fileId
}

proc setAndParsePostDataFormData9 {} {

    cleanParam
    set fn "formvar-multipart-formdata9.tst"

    writePostDataFile $fn "-----------------------------14448277420642\u0d
Content-Disposition: form-data; name=\"name\"\u0d
\u0d
back.gif\u0d
-----------------------------14448277420642\u0d
Content-Disposition: form-data; name=\"source\"; filename=\"space.gif\"\u0d
Content-Type: image/gif\u0d
\u0d
GIF89a  €     ÿÿÿ!ù   ,       L ;\u0d
-----------------------------14448277420642\u0d
Content-Disposition: form-data; name=\"load\"\u0d
\u0d
Laden\u0d
-----------------------------14448277420642\u0d
Content-Disposition: form-data; name=\"alt\"\u0d
\u0d
\u0d
-----------------------------14448277420642\u0d
Content-Disposition: form-data; name=\"width\"\u0d
\u0d
\u0d
-----------------------------14448277420642\u0d
Content-Disposition: form-data; name=\"height\"\u0d
\u0d
\u0d
-----------------------------14448277420642\u0d
Content-Disposition: form-data; name=\"ltype\"\u0d
\u0d
none\u0d
-----------------------------14448277420642\u0d
Content-Disposition: form-data; name=\"link\"\u0d
\u0d
\u0d
-----------------------------14448277420642--\u0d
"

    set fileId [open $fn "r"]

    ## parse
    web::dispatch -querystring "" -cmd "" \
    -postdata $fileId end "multipart/form-data; boundary=---------------------------14448277420642"
    close $fileId
}

proc setAndParsePostDataFormData2 {} {

    cleanParam

    set fname "formvar-multipart-formdata2.tst"

    writePostDataFile $fname "--xxxx\u0d
Content-Disposition: form-data; name=i1\u0d
\u0d
1st\u0d
--xxxx--\u0d
"

    set f2Id [open $fname "r"]
    ## parse
    web::dispatch -querystring "" -cmd "" \
    -postdata $f2Id end "multipart/form-data; boundary=xxxx"

    close $f2Id
}

proc setAndParsePostDataFormData3 {} {

    cleanParam

    set fname "formvar-multipart-formdata3.tst"

    writePostDataFile $fname "--xxxx\u0d
content-disposition: FoRm-DAta; NaMe=i1\u0d
\u0d
1st\u0d
--xxxx--\u0d
"

    set f2Id [open $fname "r"]
    ## parse
    web::dispatch -querystring "" -cmd "" \
	-postdata $f2Id [file size $fname] "multipart/form-data; boundary=xxxx"
    close $f2Id
}

proc setAndParsePostDataFormData4 {} {

    cleanParam

    set fname "formvar-multipart-formdata4.tst"

    writePostDataFile $fname "--xxxx\u0d
content-disposition: FoRm-DAta; NaMe=i1\u0d
\u0d
1st\u0d
--xxxx--\u0d
"
    set f2Id [open $fname "r"]
    ## parse
    web::dispatch -querystring "" -cmd "" \
	-postdata $f2Id [file size $fname] "multipart/form-data; boundary=xxxx"
    close $f2Id
}


proc setAndParsePostDataFormData5 {} {

    cleanParam

    set fname "formvar-multipart-formdata5.tst"

    writePostDataFile $fname "--xxxx\u0d
content-disposition:      FoRm-DAta;      NaMe=i1\u0d
\u0d
1st\u0d
--xxxx--\u0d
"
    set f2Id [open $fname "r"]
    ## parse
    web::dispatch -querystring "" -cmd "" \
	-postdata $f2Id end "multipart/form-data; boundary=xxxx"
    close $f2Id
}

proc setAndParsePostDataFormData6 {} {

    cleanParam
    set fn "formvar-multipart-formdata6.tst"

    writePostDataFile $fn "-----------------------------6962123843993\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"file1\"; filename=\"test.dat\"\u0d
\u0d
no mime type (no LF)\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"file2\"; filename=\"test.dat\"\u0d
Content-Type: text/html\u0d
\u0d
with mime type + LF
\u0d
-----------------------------6962123843993--\u0d
"

    set fileId [open $fn "r"]

    ## parse
    web::dispatch -querystring "" -cmd "" -postdata $fileId [file size $fn] \
    "multipart/form-data; boundary=---------------------------6962123843993"
    close $fileId
}

proc setAndParsePostDataFormData7 {} {

    cleanParam
    set fn "formvar-multipart-formdata7.tst"

    writePostDataFile $fn "-----------------------------6962123843993\u0d
-----------------------------6962123843993\u0d
Content-Disposition: form-data; name=\"file\"; filename=\"e\"\u0d
\u0d
no mime type + CRLF\u0d
\u0d
-----------------------------6962123843993--\u0d
"

    set fileId [open $fn "r"]

    ## parse
    web::dispatch -querystring "" -cmd "" -postdata $fileId end \
    "multipart/form-data; boundary=---------------------------6962123843993"
    close $fileId
}

proc setAndParsePostDataFormData8 {} {

    cleanParam

    set fname "formvar-multipart-formdata8.tst"

    writePostDataFile $fname "--xxxx\u0d
content-disposition: FoRm-DAta; NaMe=i1\u0d
\u0d
1st\u0d\u0d
--xxxx--\u0d
"
    set f2Id [open $fname "r"]
    ## parse
    web::dispatch -querystring "" -cmd "" \
	-postdata $f2Id end "multipart/form-data; boundary=xxxx"
    close $f2Id
}

proc setAndParsePostDataFormDataA {} {

    cleanParam

    set fname "formvar-multipart-formdataA.tst"

    writePostDataFile $fname "--xxxx\u0d
--xxxx\u0d
Content-Disposition: form-data; name=\"file\"; filename=\"test1.dat\"\u0d
\u0d
no mime type (no LF)\u0d
--xxxx\u0d
Content-Disposition: form-data; name=\"file\"; filename=\"test2.dat\"\u0d
Content-Type: text/html\u0d
\u0d
with mime type + LF
\u0d
--xxxx--\u0d
"
    set f2Id [open $fname "r"]
    ## parse
    web::dispatch -querystring "" -cmd "" \
	-postdata $f2Id end "multipart/form-data; boundary=xxxx"
    close $f2Id
}

proc cleanUp {} {

    global dispatchTestLogLevel
    global dispatchTestLogDest

    file delete "./formvar-multipart-formdata.tst"
    file delete "./formvar-multipart-formdata2.tst"
    file delete "./formvar-multipart-formdata3.tst"
    file delete "./formvar-multipart-formdata4.tst"
    file delete "./formvar-multipart-formdata5.tst"
    file delete "./formvar-multipart-formdata6.tst"
    file delete "./formvar-multipart-formdata7.tst"
    file delete "./formvar-multipart-formdata8.tst"
    file delete "./formvar-multipart-formdata9.tst"
    file delete "./formvar-multipart-formdataA.tst"

    #puts "will delete $dispatchTestLogLevel, $dispatchTestLogDest" 
    #puts "filters are: [web::loglevel names]"
    #puts "dests   are: [web::logdest names]"

    web::loglevel delete $dispatchTestLogLevel
    web::logdest   delete $dispatchTestLogDest
}

# -----------------------------------------------------------------------------
# cfg
# -----------------------------------------------------------------------------
web::config encryptchain web::encryptd
web::config decryptchain web::decryptd

web::config uploadfilesize 0


# -----------------------------------------------------------------------------
# errors
# -----------------------------------------------------------------------------

# -----------------------------------------------------------------------------
# test options of dispatch
# -----------------------------------------------------------------------------
test dispatch-2.1 {skip querystring parsing} {

    cleanParam

    web::dispatch -querystring {k1=dispatch2_1} -postdata "" -cmd ""
    web::dispatch -querystring "" -postdata "" -cmd ""
    set res [web::param k1]
} {dispatch2_1}

test dispatch-2.2 {skip postdata parsing} {

    cleanParam

    set data {k1=dispatch2_2}
    web::dispatch -querystring "" -cmd "" \
	-postdata \#data
    web::dispatch -querystring "" -postdata "" -cmd ""
    set res [web::formvar k1]
} {dispatch2_2}

web::command tst_dispatch_2_3 {
    web::put "tst_dispatch_2_3"
}
if {[info exists dispatch2_3]} {
    unset dispatch2_3
}
test dispatch-2.3 {switch into command} {

    cleanParam

    web::response -select #dispatch2_3
    web::response -sendheader 0

    web::dispatch -querystring "" -postdata "" -cmd tst_dispatch_2_3
    set dispatch2_3
} {tst_dispatch_2_3}


web::command tst_dispatch_2_4 {
    web::put "tst_dispatch_2_4"
}
if {[info exists dispatch2_4]} {
    unset dispatch2_4
}
test dispatch-2.4 {do NOT switch into command} {

    cleanParam

    web::response -select #dispatch2_4
    web::response -sendheader 0
    set dispatch2_4 ""

    web::dispatch -cmd "" -querystring "cmd=default" -postdata "" 
    set dispatch2_4
} {}

if {[info exists dispatch2_5]} {
    unset dispatch2_5
}
test dispatch-2.5 {do NOT parse querystring} {

    cleanParam

    web::response -select #dispatch2_5
    web::response -sendheader 0
    set dispatch2_5 {}

    ## reset formvar and param
    web::param -unset
    web::formvar -unset

    web::dispatch -querystring "" -cmd "" -postdata "" \
	-querystring {cmd=default}
    web::param cmd
} {}

if {[info exists dispatch2_6]} {
    unset dispatch2_6
}
test dispatch-2.6 {do NOT parse form-data} {

    cleanParam

    web::response -select #dispatch2_6
    web::response -sendheader 0
    set dispatch2_6 ""

    set data {k1&v1}
    web::dispatch -postdata "" -cmd "" \
	-querystring {cmd=default} \
	-postdata \#data end

    web::formvar k1
} {}

# -----------------------------------------------------------------------------
# parse query-string
# -----------------------------------------------------------------------------
test dispatch-3.1 {parse querystring} {

    cleanParam

    web::dispatch -querystring {k1=v1} -postdata "" -cmd ""
    set res [web::param k1]
    set res
} {v1}

test dispatch-3.2 {parse querystring "&"} {

    cleanParam

    web::dispatch -querystring {&} -postdata "" -cmd ""
    set res [llength [web::param -names]]
} {0}

test dispatch-3.3 {parse querystring "k1&k2=v2"} {

    cleanParam

    web::dispatch -querystring {k1&k2=v2} -postdata "" -cmd ""
    set res [llength [web::param -names]]
    lappend res [web::param k1]
    lappend res [web::param k2]
} "2 {} v2"


# -----------------------------------------------------------------------------
# parse url-encoded
# -----------------------------------------------------------------------------
test dispatch-4.1 {parse url-encoded} {

    cleanParam

    set in i1=1st&i2=2nd&i3=%E4%F6%FC&os=Linux&os=BeOs&country=USA&phon=M&tv=on
    web::dispatch -querystring "" -cmd "" \
	-postdata \#in

    set keys [lsort [web::formvar -names]]
    set res $keys
    foreach key $keys {
	lappend res $key
	set vals [web::formvar $key]
	lappend res $vals
    }
    set res
} {country i1 i2 i3 os phon tv country USA i1 1st i2 2nd i3 äöü os {Linux BeOs} phon M tv on}

test dispatch-4.2 {parse url-encoded} {

    cleanParam

    set in i1=1st

    web::dispatch -querystring "" -cmd "" \
	-postdata \#in end

    set keys [web::formvar -names]
} {i1}


# -----------------------------------------------------------------------------
# parse multipart/form-data
# -----------------------------------------------------------------------------
test dispatch-5.0a {parse multipart/form-data from stdout} {

    cleanParam

    catch {
    web::dispatch -cmd "" -querystring "" \
        -postdata stdout 10 "multipart/form-data; boundary=xxx"
    } err
    set err
} {web::dispatch -postdata: channel "stdout" not open for reading}

test dispatch-5.0b {parse multipart/form-data from stdout} {

    cleanParam
    catch {
	web::dispatch -cmd "" -querystring "" \
		-postdata stdout end test
    } err
    set err
} {web::dispatch -postdata: unknown content-type "test"}

# -----------------------------------------------------------------------------
# access data
# -----------------------------------------------------------------------------
test dispatch-5.1 {list all keys} {

    cleanParam

    setAndParsePostDataFormData

    # access items
    set res [lsort [web::formvar -names]]
} {country file file2 i1 i1a i2 i3 i4 i5 os phon tv vcr}

test dispatch-5.1a {list all keys} {

    cleanParam

    setAndParsePostDataFormData

    # access items
    set res [web::formvar i1a]
} {}

test dispatch-5.1b {file upload} {

    cleanParam

    web::config uploadfilesize 0

    setAndParsePostDataFormData

    # access items
    set res [web::formvar file2]
} {{} {} -2 {}}

test dispatch-5.1c {file upload} {

    cleanParam

    web::config uploadfilesize 10

    setAndParsePostDataFormData

    # access items
    set res [web::formvar file2]
} {{} {} -2 {}}

test dispatch-5.2 {check disabled file upload} {

    cleanParam

    web::config uploadfilesize 0

    setAndParsePostDataFormData
    set tmp [web::formvar file]
    set res [lrange $tmp 1 2]
    set res
} {test.dat -1}

test dispatch-5.3 {check file upload: truncation} {

    cleanParam

    web::config uploadfilesize 8

    setAndParsePostDataFormData
    set res [lrange [web::formvar file] 1 2]

    lappend res [file size [lindex [web::formvar file] 0]]
    set res
} {test.dat 28 8}

test dispatch-5.4 {check file upload} {

    cleanParam

    web::config uploadfilesize 1024

    setAndParsePostDataFormData
    set tmp [web::formvar file]
    set fid [open [lindex $tmp 0] "r"]
    fconfigure $fid -translation binary
    set content [read $fid]
    close $fid
    web::config uploadfilesize 0
    set content
} {[begin]
Test
[end with one newline]
}

test dispatch-5.5 {values for all keys} {

    cleanParam

    setAndParsePostDataFormData
    set tmp [web::formvar file]
    set tmp [list "tempfilename.dat" [lrange $tmp 1 2]]

    set keys [lsort [web::formvar -names]]
    set res $keys
    if {[info exists res2]} {unset res2}
    foreach key $keys {
	lappend res2 $key
	set vals [web::formvar $key]
        if { [string compare $key "file"] == 0 } {
            set vals [lreplace $vals 0 0 "temp.dat"]
        }
	lappend res2 $vals
    }
    # cleanUp
    set res2
} "country USA file {temp.dat test.dat -1 {}} file2 {{} {} -2 {}} i1 1st i1a {} i2 2nd i3 äöü%20 i4 {4th\u0d
4th (no newline)} i5 {5th\u0d
5th (newline)\u0d
} os {Linux BeOs} phon M tv on vcr on"

test dispatch-5.6 {special cases (no quotes)} {

    cleanParam

    web::config uploadfilesize 0

    setAndParsePostDataFormData2
    set tmp [web::formvar i1]
} {1st}

test dispatch-5.7 {special cases (case-insensitive)} {

    cleanParam

    web::config uploadfilesize 0

    setAndParsePostDataFormData3
    set tmp [web::formvar i1]
} {1st}

test dispatch-5.8 {special cases (crlf input)} {

    cleanParam

    web::config uploadfilesize 0

    setAndParsePostDataFormData4
    set tmp [web::formvar i1]
} {1st}

test dispatch-5.9 {special cases (additional whitespace)} {

    cleanParam

    web::config uploadfilesize 0
    web::formvar -unset

    setAndParsePostDataFormData5
    set tmp [web::formvar i1]
} {1st}

test dispatch-5.10 {file upload with mime type} {

    cleanParam

    web::config uploadfilesize 1024

    setAndParsePostDataFormData6
    set res [web::formvar file2]

    set fid [open [lindex $res 0] "r"]
    # remove temp file name
    set res [lreplace $res 0 0 {}]

    lappend res [read $fid]
    close $fid

    set tmp [web::formvar file1]

    set fid [open [lindex $tmp 0] "r"]

    # remove temp file name
    set tmp [lreplace $tmp 0 0 {}]

    lappend res $tmp

    lappend res [read $fid]
    close $fid

    web::config uploadfilesize 0

    set res
} {{} test.dat 0 text/html {with mime type + LF
} {{} test.dat 0 {}} {no mime type (no LF)}}

test dispatch-5.11 {file upload short filename} {

    cleanParam

    web::config uploadfilesize 1024

    setAndParsePostDataFormData7
    set res [web::formvar file]

    set fh [open [lindex $res 0] r]
    fconfigure $fh -translation binary
    lappend res [read $fh]
    close $fh

    web::config uploadfilesize 0

    lreplace $res 0 0 tmpfn
} "tmpfn e 0 {} {no mime type + CRLF\u0d
}"


test dispatch-5.12 {mis-behaved file upload} {emptyTest} {

    cleanParam

    web::config uploadfilesize 1024

    setAndParsePostDataFormData8

    set res [web::formvar -names]

    web::config uploadfilesize 0

    lappend res [web::formvar i1]
} "i1 1st\u0d"

test dispatch-5.13 {file upload: strange truncation problem} {

    cleanParam

    web::config uploadfilesize 1024

    setAndParsePostDataFormData9

    set res [lsort [web::formvar -names]]
    set src [web::formvar source]
    set src [lreplace $src 0 0 tmpfile]

    web::config uploadfilesize 0

    lappend res $src
} "alt height link load ltype name source width {tmpfile space.gif 0 image/gif}"

test dispatch-5.14 {two file uploads with same formvar name} {

    cleanParam

    web::config uploadfilesize 1024

    setAndParsePostDataFormDataA

set tmp [web::formvar file]

    web::config uploadfilesize 0

set res [list [llength $tmp] [llength [lindex $tmp 0]] [llength [lindex $tmp 1]]]
} {2 4 4}

test dispatch-6.0 {multipart/form-data from a string} {
    
    cleanParam
    
    set content "--xxxx\u0d
Content-Disposition: form-data; name=\"i1a\"\u0d
\u0d
\u0d
--xxxx\u0d
Content-Disposition: form-data; name=\"i3\"\u0d
\u0d
äöü%20\u0d
--xxxx\u0d
Content-Disposition: form-data; name=\"os\"\u0d
\u0d
Linux\u0d
--xxxx\u0d
Content-Disposition: form-data; name=\"os\"\u0d
\u0d
BeOs\u0d
--xxxx\u0d
Content-Disposition: form-data; name=\"tv\"\u0d
\u0d
on\u0d
--xxxx\u0d
Content-Disposition: form-data; name=\"vcr\"\u0d
\u0d
on\u0d
--xxxx\u0d
content-disposition: FoRm-DAta; NaMe=funny1K\u0d
\u0d
funny1V\u0d
--xxxx\u0d
content-disposition:      FoRm-DAta;      NaMe=funny2K\u0d
\u0d
funny2
V\u0d
--xxxx\u0d
content-disposition: form-data; name=funny2Kn\u0d
\u0d
funny2
V2
\u0d
--xxxx\u0d
Content-Disposition: form-data; name=\"file\"; filename=\"test.dat\"\u0d
\u0d
\[begin\]
Test
\[end without newline\]\u0d
--xxxx\u0d
Content-Disposition: form-data; name=\"file2\"; filename=\"\"\u0d
\u0d
\u0d
--xxxx--\u0d
"

web::dispatch -cmd "" -querystring "" \
	-postdata \#content end "multipart/form-data; boundary=xxxx"

    set keys [lsort [web::formvar -names]]
    set res $keys
    set res2 {}
    foreach key $keys {
	lappend res2 $key
	set vals [web::formvar $key]
        if { [string compare $key "file"] == 0 } {
            set vals [lreplace $vals 0 0 {}]
        }
	lappend res2 $vals
    }

    set res2
} {file {{} test.dat -1 {}} file2 {{} {} -2 {}} funny1K funny1V funny2K {funny2
V} funny2Kn {funny2
V2
} i1a {} i3 äöü%20 os {Linux BeOs} tv on vcr on}

test dispatch-6.1 {parse empty string} {

    cleanParam

    web::dispatch -cmd "" -querystring "" \
        -postdata ""
    set res [llength [web::param -names]]
    lappend res [llength [web::formvar -names]]
    
    cleanParam

    web::dispatch -cmd "" -querystring "&" -postdata ""
    lappend res [llength [web::param -names]]
    lappend res [llength [web::formvar -names]]

    cleanParam

    set data "&"
    web::dispatch -cmd "" -querystring "" -postdata \#data
    lappend res [llength [web::param -names]]
    lappend res [llength [web::formvar -names]]

    cleanParam

    web::dispatch -cmd "" -querystring "k1=" -postdata ""
    lappend res [llength [web::param -names]]
    lappend res [llength [web::formvar -names]]

    cleanParam

    set data "k1="
    web::dispatch -cmd "" -querystring "" -postdata \#data
    lappend res [llength [web::param -names]]
    lappend res [llength [web::formvar -names]]
} {0 0 0 0 0 0 1 0 0 1}


test dispatch-6.2 {parsing twice adds twice} {

    cleanParam

    web::dispatch -cmd "" -querystring "k1=v1" -postdata ""
    set res [web::param -count k1]
    web::dispatch -cmd "" -querystring "k1=v1" -postdata ""
    lappend res [web::param -count k1]
    lappend res [web::param k1]
} {1 2 {v1 v1}}

test dispatch-6.3 {parsing twice adds twice (formvar/url-encoded)} {

    cleanParam

    set data "k1=v1"
    web::dispatch -cmd "" -querystring "" -postdata \#data
    set res [web::formvar -count k1]
    web::dispatch -cmd "" -querystring "" -postdata \#data end
    lappend res [web::formvar -count k1]
    lappend res [web::formvar k1]
} {1 2 {v1 v1}}


test dispatch-6.4 {parsing twice adds twice (formvar/form-data)} {

    cleanParam

    set content "--xxxx\u0d
Content-Disposition: form-data; name=\"k1\"\u0d
\u0d
v1\u0d
--xxxx--\u0d
"

    web::dispatch -cmd "" -querystring "" \
	-postdata \#content end "multipart/form-data; boundary=xxxx"
    set res [web::formvar -count k1]
    web::dispatch -cmd "" -querystring "" \
	-postdata \#content [string length $content] "multipart/form-data; boundary=xxxx"
    lappend res [web::formvar -count k1]
    lappend res [web::formvar k1]
} {1 2 {v1 v1}}

web::command dispatch6_5 {return dispatch6_5}
test dispatch-6.5 {test dispatching of cmd} {
    set res [web::dispatch -querystring "cmd=dispatch6_5" -postdata ""]
    lappend res [web::dispatch -querystring "cmd=dispatch6_5" \
		     -postdata "" -cmd ""]
    set res
} {dispatch6_5 {}}


test dispatch-6.6 {-track} {

    cleanParam

    set res [lsort [web::cmdurlcfg -names]]
    web::dispatch -querystring "k1=v1&k2=dispatch6_6&foo=bar" \
	-postdata "" -cmd "" -track [list k2 foo]
    lappend res [lsort [web::cmdurlcfg -names]]
    lappend res [web::cmdurlcfg k2]
    lappend res [web::cmdurlcfg foo]
    set res
} {{foo k2} dispatch6_6 bar}

test dispatch-6.6b {-track with list 1} {

    cleanParam

    set res [lsort [web::cmdurlcfg -names]]
    web::dispatch -querystring "k1=v1&k2=dispatch6_6&foo=bar+bar2" \
	-postdata "" -cmd "" -track [list k2 foo]
    lappend res [lsort [web::cmdurlcfg -names]]
    lappend res [web::cmdurlcfg k2]
    lappend res [web::cmdurlcfg foo]
    lappend res [web::cmdurlcfg -count foo]
    set res
} {{foo k2} dispatch6_6 {bar bar2} 1}

test dispatch-6.6c {-track with multiple same parameters} {

    cleanParam

    set res [lsort [web::cmdurlcfg -names]]
    web::dispatch -querystring "k1=v1&k2=dispatch6_6&foo=bar&foo=bar2" \
	-postdata "" -cmd "" -track [list k2 foo]
    lappend res [lsort [web::cmdurlcfg -names]]
    lappend res [web::cmdurlcfg k2]
    lappend res [web::cmdurlcfg foo]
    lappend res [web::cmdurlcfg -count foo]
    set res
} {{foo k2} dispatch6_6 {bar bar2} 2}

test dispatch-6.7 {tolerant -track} {

    cleanParam

    set res [lsort [web::cmdurlcfg -names]]
    web::dispatch -querystring "k1=v1&k2=dispatch6_7&foo=bar" \
	-postdata "" -cmd "" -track [list bar k2 foo]
    lappend res [lsort [web::cmdurlcfg -names]]
    lappend res [web::cmdurlcfg k2]
    lappend res [web::cmdurlcfg foo]
    set res
} {{foo k2} dispatch6_7 bar}


web::command dispatch6_8 { web::put pdispatch6_8 }
if {[info exists dispatch6_8]} {
    unset dispatch6_8
}
test dispatch-6.8 {-hook} {

    cleanParam

    web::response -select #dispatch6_8

    # puts "dispatch6_8 registered"
    # flush stdout

    web::response -sendheader 0

    set tmp {web::put [web::param k1]}
    set qs "cmd=dispatch6_8&k1=v1"

    set res [web::dispatch -querystring $qs -postdata ""]
    lappend res [web::dispatch -querystring ""  \
		     -postdata "" -hook $tmp]
    lappend res [web::dispatch -querystring ""  -postdata ""]

    web::response -select stdout
    set dispatch6_8
} {pdispatch6_8v1pdispatch6_8pdispatch6_8}

test dispatch-6.9 {weird string} {

    cleanParam

    set data "k=%22Bildschirm+Eizo+19%22%22+%22"
    web::dispatch -cmd "" -querystring "" \
	-postdata \#data
    set res [web::formvar -names]
    lappend res [web::formvar -count k] [web::formvar k]
} {k 1 {"Bildschirm Eizo 19"" "}}

test dispatch-6.10 {weird string} {

    cleanParam

    set content "--xxxx\u0d
Content-Disposition: form-data; name=\"k\"\u0d
\u0d
\"Bildschirm Eizo 19\"\" \"\u0d
--xxxx--\u0d
"

    web::dispatch -cmd "" -querystring "" \
	-postdata \#content end "multipart/form-data; boundary=xxxx"
    set res [web::formvar -names]
    lappend res [web::formvar -count k] [web::formvar k]
} {k 1 {"Bildschirm Eizo 19"" "}}

proc dispatchTest6_11_LogCatcher {msg} {
    lappend ::dispatchTest6_11_Log $msg
}
web::command default {
    set a 1
}

test dispatch-6.11 {command not found} {

    cleanParam

    set ::dispatchTest6_11_Log ""
    set tmpfilt [web::loglevel add *.-debug]
    set tmpdest [web::logdest add -format {$m} *.-debug \
		     command dispatchTest6_11_LogCatcher]
    catch {
	web::dispatch -querystring "cmd=dispatchtest6_11" -postdata ""} msg
    set res $msg
    web::loglevel delete $tmpfilt
    web::logdest delete $tmpdest
    lappend res $::dispatchTest6_11_Log
} {1 {{web::decryptd: crypt type not recognized} {web::dispatch: Handling command "dispatchtest6_11"} {web::dispatch: command "dispatchtest6_11" not found. Switching to command "default"}}}


test dispatch-6.12 {unknown mime type} {

    cleanParam
    set data "a=b"
    catch {
	web::dispatch -querystring "" -cmd "" -postdata \#data end "some/mime"
    } err
    set err
} {web::dispatch -postdata: unknown content-type "some/mime"}


test dispatch-6.13 {file upload w/ mime type from string} {

    cleanParam

    set content "--xxxx\u0d
Content-Disposition: form-data; name=\"file1\"; filename=\"test.dat\"\u0d
\u0d
no mime type\u0d
--xxxx
Content-Disposition: form-data; name=\"file2\"; filename=\"test.dat\"\u0d
Content-Type: text/html\u0d
\u0d
with mime type and newline
\u0d
--xxxx--\u0d
"

    web::config uploadfilesize 1024

    web::dispatch -cmd "" -querystring "" \
        -postdata \#content end "multipart/form-data; boundary=xxxx"

    set res {}

    set fid [open [lindex [web::formvar file1] 0] "r"]
    fconfigure $fid -translation binary
    # remove temp file name
    lappend res [lreplace [web::formvar file1] 0 0 tmpfile]
    lappend res [read $fid]
    close $fid

    set fid [open [lindex [web::formvar file2] 0] "r"]
    fconfigure $fid -translation binary
    # remove temp file name
    lappend res [lreplace [web::formvar file2] 0 0 tmpfile]
    lappend res [read $fid]
    close $fid

    web::config uploadfilesize 0

    set res
} {{tmpfile test.dat 0 {}} {no mime type} {tmpfile test.dat 0 text/html} {with mime type and newline
}} 

test dispatch-6.14 {file upload w/ charset w/ and w/o transfer-econding} {

    cleanParam

    # note: the third file is actually wrong (the quotes around the charset), but
    # I still sthink we should be as tolerant as possible...

    set content "--xxxx\u0d
Content-Disposition: form-data; name=\"file1\"; filename=\"test.dat\"\u0d
Content-Type: text/html; charset=ISO-8859-1\u0d
\u0d
charset but no encoding\u0d
--xxxx
Content-Disposition: form-data; name=\"file2\"; filename=\"test.dat\"\u0d
Content-Type: text/html; charset=ISO-8859-1\u0d
Content-Transfer-Encoding: 8bit\u0d
\u0d
with mime type and newline AND transfer encoding
\u0d
--xxxx
Content-Disposition: form-data; name=\"file3\"; filename=\"test.dat\"\u0d
Content-Type: text/html; charset=\"ISO-8859-1\"\u0d
Content-Transfer-Encoding: 8bit\u0d
\u0d
with mime type AND transfer encoding no newline but quotes\u0d
--xxxx--\u0d
"

    web::config uploadfilesize 1024

    web::dispatch -cmd "" -querystring "" \
        -postdata \#content end "multipart/form-data; boundary=xxxx"

    set res {}

    set fid [open [lindex [web::formvar file1] 0] "r"]
    fconfigure $fid -translation binary
    # remove temp file name
    lappend res [lreplace [web::formvar file1] 0 0 tmpfile]
    lappend res [read $fid]
    close $fid

    set fid [open [lindex [web::formvar file2] 0] "r"]
    fconfigure $fid -translation binary
    # remove temp file name
    lappend res [lreplace [web::formvar file2] 0 0 tmpfile]
    lappend res [read $fid]
    close $fid

    set fid [open [lindex [web::formvar file3] 0] "r"]
    fconfigure $fid -translation binary
    # remove temp file name
    lappend res [lreplace [web::formvar file3] 0 0 tmpfile]
    lappend res [read $fid]
    close $fid

    web::config uploadfilesize 0

    set res
} {{tmpfile test.dat 0 {text/html; charset=ISO-8859-1}} {charset but no encoding} {tmpfile test.dat 0 {text/html; charset=ISO-8859-1}} {with mime type and newline AND transfer encoding
} {tmpfile test.dat 0 {text/html; charset="ISO-8859-1"}} {with mime type AND transfer encoding no newline but quotes}} 

if {[info exists var]} {
    unset var
}
test dispatch-7.0 {var channel} {
    set res {}
    global var
    set o [web::response -select #var]
    web::response -sendheader 0
    web::put first
    lappend res $var

    unset var

    web::response -select $o
    web::put #var second
    lappend res $var
} {first second}

test dispatch-8.0 {missing "--" in multipart messages} {
    
    cleanParam
    
    set content "--xxxx\u0d
Content-Disposition: form-data; name=\"i3\"\u0d
\u0d
äöü%20\u0d
--xxxx\u0d
Content-Disposition: form-data; name=\"os\"\u0d
\u0d
Linux\u0d
--xxxx--\u0d
"
    catch {
	web::dispatch -cmd "" -querystring "" \
		-postdata \#content end "multipart/form-data; boundary=--xxxx"
    } err
    set err
} {web::dispatch -postdata: error accessing 'Content-Disposition'. Check boundary}

cleanUp

# cleanup
::tcltest::cleanupTests