Attachment "ncgi-import-fix.patch" to
ticket [611595ffff]
added by
stevecassidy
2003-06-17 07:39:24.
diff -Naur tcllib-1.4/modules/ncgi/ncgi.tcl tcllib-1.4.patched/modules/ncgi/ncgi.tcl
--- tcllib-1.4/modules/ncgi/ncgi.tcl 2003-04-26 04:11:04.000000000 +1000
+++ tcllib-1.4.patched/modules/ncgi/ncgi.tcl 2003-06-16 22:14:29.000000000 +1000
@@ -117,10 +117,13 @@
proc ::ncgi::reset {args} {
global env
+ global ncgi::_tmpfiles
variable query
variable contenttype
variable cookieOutput
+ array unset ncgi::_tmpfiles
+
set cookieOutput {}
if {[llength $args] == 0} {
@@ -908,41 +911,44 @@
# -client returns the name of the file sent from the client
# -type returns the mime type of the file
# -data returns the contents of the file
-
+#
proc ::ncgi::import_file {cmd var {filename {}}} {
- set vlist [ncgi::valueList $var]
+ set vlist [ncgi::valueList $var]
- pre - $vlist
-
- array set fileinfo [lindex $vlist 0]
- set contents [lindex $vlist 1]
+ array set fileinfo [lindex [lindex $vlist 0] 0]
+ set contents [lindex [lindex $vlist 0] 1]
switch -exact -- $cmd {
-server {
## take care not to write it out more than once
global ncgi::_tmpfiles
- if {$filename != {}} {
- ## use supplied filename
- set ncgi::_tmpfiles($var) $filename
- } elseif {![info exists ncgi::_tmpfiles($var)]} {
- ## create a tmp file
- set tmpfile [::fileutil::tempfile ncgi]
- if [catch {open $tmpfile w} h] {
+ if {![info exists ncgi::_tmpfiles($var)]} {
+ if {$filename != {}} {
+ ## use supplied filename
+ set ncgi::_tmpfiles($var) $filename
+ } else {
+ ## create a tmp file
+ set ncgi::_tmpfiles($var) [::fileutil::tempfile ncgi]
+ }
+
+ # write out the data only if it's not been done already
+ if [catch {open $ncgi::_tmpfiles($var) w} h] {
error "Can't open temporary file in ncgi::import_file"
}
+
fconfigure $h -translation binary -encoding binary
puts -nonewline $h $contents
close $h
- set ncgi::_tmpfiles($var) $tmpfile
}
+
return $ncgi::_tmpfiles($var)
}
-client {
- return $fileinfo(filename)
+ return [lindex [array get fileinfo filename] 1]
}
-type {
- return $fileinfo(content-type)
+ return [lindex [array get fileinfo content-type] 1]
}
-data {
return $contents
diff -Naur tcllib-1.4/modules/ncgi/ncgi.test tcllib-1.4.patched/modules/ncgi/ncgi.test
--- tcllib-1.4/modules/ncgi/ncgi.test 2003-05-02 17:42:06.000000000 +1000
+++ tcllib-1.4.patched/modules/ncgi/ncgi.test 2003-06-16 22:14:52.000000000 +1000
@@ -525,36 +525,6 @@
}}
-test ncgi-14.5 {ncgi::multipart--check binary file} {
- set in [open [file join [file dirname [info script]] formdata.txt]]
-
- # Read the file in as though it were binary.
- fconfigure $in -translation binary
- 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
- set content [ncgi::value the_file_naame]
- list [ncgi::value field1] [ncgi::value field2] $content
-} "value {another value} {\r
-<center><h1>\r
- Netscape Address Book Sync for Palm Pilot\r
- User Guide\r
-</h1></center>\r
-\r
-\r
-}"
test ncgi-14.6 {ncgi::multipart setValue} {
set in [open [file join [file dirname [info script]] formdata.txt]]
@@ -593,4 +563,152 @@
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_naame "; 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_naame]
+ list [ncgi::value field1] [ncgi::value field2] $content
+} [list value {another value} $binary_content]
+
+
+test ncgi-16.1 {ncgi::import_file} {
+
+ global binary_content
+
+ set X [genformdata $binary_content]
+
+ ncgi::reset $X [genformcontent_type]
+ ncgi::parse
+
+ ncgi::import_file -client the_file_naame
+
+} "C:\\Program Files\\Netscape\\Communicator\\Program\\nareadme.htm"
+
+test ncgi-16.2 {ncgi::import_file - content type} {
+
+ global binary_content
+
+ set X [genformdata $binary_content]
+
+ ncgi::reset $X [genformcontent_type]
+ ncgi::parse
+
+ ncgi::import_file -type the_file_naame
+
+} text/html
+
+
+test ncgi-16.3 {ncgi::import_file -- file contents} {
+
+ global binary_content
+
+ set X [genformdata $binary_content]
+
+ ncgi::reset $X [genformcontent_type]
+ ncgi::parse
+
+ ncgi::import_file -data the_file_naame
+
+} $binary_content
+
+test ncgi-16.4 {ncgi::import_file -- save file} {
+
+ global binary_content
+
+ set X [genformdata $binary_content]
+
+ ncgi::reset $X [genformcontent_type]
+ ncgi::parse
+
+ set localfile [ncgi::import_file -server the_file_naame]
+
+ # 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::import_file -- save file, given name} {
+
+ global binary_content
+
+ set X [genformdata $binary_content]
+
+ ncgi::reset $X [genformcontent_type]
+ ncgi::parse
+
+ set localfile [ncgi::import_file -server the_file_naame 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::import_file -- bad input} {
+
+ set X "bad multipart data"
+
+ ncgi::reset $X [genformcontent_type]
+ ncgi::parse
+
+ ncgi::import_file -client the_file_naame
+
+} {}
+
+
+
::tcltest::cleanupTests
