Attachment "ncgi-upload.patch" to
ticket [611595ffff]
added by
stevecassidy
2002-09-19 20:51:22.
Index: ncgi.man
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/ncgi/ncgi.man,v
retrieving revision 1.2
diff -c -r1.2 ncgi.man
*** ncgi.man 17 Jun 2002 20:33:45 -0000 1.2
--- ncgi.man 19 Sep 2002 13:32:18 -0000
***************
*** 88,93 ****
--- 88,108 ----
empty, then every CGI vale is imported. Otherwise each CGI variable
listed in [arg args] is imported.
+ [call [cmd ::ncgi::import_file] [arg cmd] [arg cginame] [opt [arg filename]]]
+
+ This provides information about an uploaded file from a form input
+ field of type 'file' with name [arg cginame]. [arg cmd] can be one of
+ [option -server] [option -client], [option -type] or [option -data].
+
+ [list_begin definitions]
+
+ [lst_item "[option -client] [arg cginame] returns the filename as sent by
+ the client"]
+ [lst_item "[option -type] [arg cginame] returns the mime type of the uploaded file"]
+ [lst_item "[option -data] [arg cginame] returns the contents of the file"]
+ [lst_item "[option -server] [arg cginame] [arg filename] writes the file contents to a local temporary file (or [arg filename] if supplied) and returns the name of the file. The caller is responsible for deleting this file after use."]
+ [list_end]
+
[call [cmd ::ncgi::input] [opt [arg fakeinput]] [opt [arg fakecookie]]]
Index: ncgi.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/ncgi/ncgi.tcl,v
retrieving revision 1.29
diff -c -r1.29 ncgi.tcl
*** ncgi.tcl 31 Aug 2002 06:27:47 -0000 1.29
--- ncgi.tcl 19 Sep 2002 13:32:19 -0000
***************
*** 152,159 ****
# May affects future calls to ncgi::urlStub
proc ncgi::urlStub {{url {}}} {
! global env
! variable urlStub
if {[string length $url]} {
set urlStub $url
return ""
--- 152,159 ----
# May affects future calls to ncgi::urlStub
proc ncgi::urlStub {{url {}}} {
! variable urlStub
! global env
if {[string length $url]} {
set urlStub $url
return ""
***************
*** 197,202 ****
--- 197,204 ----
} elseif {$env(REQUEST_METHOD) == "POST"} {
if {[info exists env(CONTENT_LENGTH)] &&
[string length $env(CONTENT_LENGTH)] != 0} {
+ ## added by Steve Cassidy to try to fix binary file upload
+ fconfigure stdin -translation binary -encoding binary
set query [read stdin $env(CONTENT_LENGTH)]
}
}
***************
*** 889,894 ****
--- 891,1030 ----
}
return $results
}
+
+
+
+ # ncgi::tempfile --
+ #
+ # generate a temporary file name suitable for writing to
+ # the file name will be unique, writable and will be in the
+ # appropriate system specific temp directory
+ # Code taken from http://mini.net/tcl/772 attributed to
+ # Igor Volobouev and anon.
+ #
+ # Arguments:
+ # prefix - a prefix for the filename, p
+ # Results:
+ # returns a file name
+ #
+ proc ncgi::tempfile {{prefix {}}} {
+ global tcl_platform
+
+ switch $tcl_platform(platform) {
+ unix {
+ set tmpdir /tmp; # or even $::env(TMPDIR), at times.
+ } macintosh {
+ set tmpdir $env(TRASH_FOLDER) ;# a better place?
+ } default {
+ set tmpdir [pwd]
+ catch {set tmpdir $env(TMP)}
+ catch {set tmpdir $env(TEMP)}
+ }
+ }
+
+ set chars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
+ set nrand_chars 10
+ set maxtries 10
+ set access [list RDWR CREAT EXCL TRUNC]
+ set permission 0600
+ set channel ""
+ set checked_dir_writable 0
+ set mypid [pid]
+ for {set i 0} {$i < $maxtries} {incr i} {
+ set newname $prefix
+ for {set j 0} {$j < $nrand_chars} {incr j} {
+ append newname [string index $chars \
+ [expr ([clock clicks] ^ $mypid) % 62]]
+ }
+ set newname [file join $tmpdir $newname]
+ if {[file exists $newname]} {
+ after 1
+ } else {
+ if {[catch {open $newname $access $permission} channel]} {
+ if {!$checked_dir_writable} {
+ set dirname [file dirname $newname]
+ if {![file writable $dirname]} {
+ error "Directory $dirname is not writable"
+ }
+ set checked_dir_writable 1
+ }
+ } else {
+ # Success
+ close $channel
+ return $newname
+ }
+ }
+ }
+ if {[string compare $channel ""]} {
+ error "Failed to open a temporary file: $channel"
+ } else {
+ error "Failed to find an unused temporary file name"
+ }
+ }
+
+
+ # ncgi::import_file --
+ #
+ # get information about a file upload field
+ #
+ # Arguments:
+ # cmd one of '-server' '-client' '-type' '-data'
+ # var cgi variable name for the file field
+ # filename filename to write to for -server
+ # Results:
+ # -server returns the name of the file on the server: side effect
+ # is that the file gets stored on the server and the
+ # script is responsible for deleting/moving the file
+ # -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]
+
+ pre - $vlist
+
+ array set fileinfo [lindex $vlist 0]
+ set contents [lindex $vlist 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 [tempfile ncgi]
+ if [catch {open $tmpfile 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)
+ }
+ -type {
+ return $fileinfo(content-type)
+ }
+ -data {
+ return $contents
+ }
+ default {
+ error "Unknown subcommand to ncgi::import_file: $cmd"
+ }
+ }
+ }
+
+
+
+
# ncgi::cookie
#
