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
  #
