'''File Upload Example''' Here are two files that I use to upload files to [Tclhttpd]. They can be loaded in the custom directory. Create a "hup" directory under the Doc_Root directory where the files will be uploaded. The upfile.tcl file displays a page that allows you to select the files you want to upload. It also lists the files that are currently in the "hup" directory and gives you a check box option to delete them. The fileupload.tcl handles the upload of files and has some javascript which causes the upfile page to be retrieved again. Point your browser to http://yourserver/upfile ************* Save to upfile.tcl ********* Direct_Url /upfile UpFile proc UpFile {} { global env set html "You can upload files to the /hup directory. The files currently in the /hup directory are listed in the table below.\n" append html "
\n\
\n\ \n\ \n" set file "" foreach f [glob -nocomplain -- [Doc_Root]/hup/*] { set file [file tail $f] append html "\n" } append html "\n\
Delete Files in /hup/ Directory
$file
\n\ \n\ " append html "
\n" append html "File \n" append html "

\n" append html "\n" append html "

\n" return $html } proc UpFile/filedelete {args} { global env foreach {name value} $args { file delete [Doc_Root]/hup/$name } set html "\n" append html "\n" append html "" append html "" append html "" append html "" append html "" return $html } **************** Save to fileupload.tcl ********************* package require httpd::upload Upload_Url /fileupload [Doc_Root]/hup FileUpload proc FileUpload {args} { global env # Generate Page Header set html "\n" append html "\n" append html "\n" append html "\n" append html "\n" append html "\n" append html "\n" return $html } ---- I just tried the procedures by pasting them directly in the server console (tclhttpd with some stuff stripped and my own additions, not a multithreading version), and after making the needed dir it works nicely, though I do wonder whether the obvious and less obvious hacks are possible to get in the Docroot or worse file system by using the ../ or one could try to change the upload url parameters. I didn't check either; when I do, I'll inform the audience of this page. As an aside, for the potential malicious hacker who may come across these pages: don't bother all too much, I make backups regularly, even intermediate ones on a CD-ROM I can simply drop everything new on, so there is not too much to gain anyway. And downloading outside the Docroot tree (within which everything is public anyhow) is not enabled in the server. ---- Question about '''Upload_Url''': The optional argument -maxbytes nnn doesn't seem to work. So the webserver has to receive a hole file before seeing that it is too large and purging it. Although running a multithread-supporting version of tcl an tclhttpd, the optional parameter -thread 1 hangs the fileupload process. Can anyone help? mailto:M.Hoffmann@hmk.info. ---- I don't think some of the arguments in the upload.tcl file are implemented. I had a similar experience with -maxfiles nnn. I posted the TclHttpd mailing list and Brent Welch the author confirmed it wasn't. He was very kind and wrote some code which helped me get the feature to work but I don't think the code made it into the production release. Search the TclHttpd mailing list archive http://sourceforge.net/mail/?group_id=12884 or join the list and ask, everyone is friendly and willing to help. [Michael Hankinson] ---- [CMCc] Spurred by this page, I implemented -maxfiles, -maxbytes and -totalbytes. (They're in CVS HEAD) I also fixed upload domain's ability to handle redirection, so now the following version of the above upload file will work. It's a bit shorter. # a file upload capability package require httpd::upload Upload_Url /fileupload [file join [Doc_Root] hup] FileUpload -totalbytes 10000000 proc FileUpload {args} { return [Redirect_Self /upfile] } Direct_Url /upfile UpFile proc UpFile {} { append html {
} set files [glob -nocomplain -- [file join [Doc_Root] hup *]] if {$files != {}} { append html {
} set file "" foreach f $files { set file [file tail $f] append html [subst { }] } append html {
Files Size Date
$file [file size $f] [clock format [file mtime $f] -format "%x %X"]
} } return $html } proc UpFile/filedelete {args} { foreach {name value} $args { set name [file tail [file normalize $name]] file delete [file join [Doc_Root] hup $name] } return [Redirect_Self /upfile] } ---- [[ [Category Internet] | [Category TclHttpd] ]]