#### #!/usr/bin/perl -w use strict; use CGI qw/:standard/; use CGI::Carp qw(fatalsToBrowser); my $query = CGI->new($ENV{QUERY_STRING}); # I will initially save my file with this name and copy it to the correct name later (ID+original suffix) # ID has to be passed to 'hook', to keep track of the upload-status in a DB (I will just use a plain file here for testing) # as only $filename (the originale name on the client-disk is passed to the hook, there is no relation between the # sanitized filename I will use when saving the uploaded file, and the filename used in the hook, thus practically rendering # the hook useless my $data = $query->param('pregeneratedID'); if (!$data) { print $query->header(); print "no data?"; exit; } $data = $1 if $data =~ //;# untaint generatedID - for some reason this sets the contents of $data to .. nothing if (!$data) { print $query->header(); print "no data?"; exit; } $query = CGI->new(\&hook, $data); my $fh = $query->upload('file'); # I want to save the file with the same filename as the ID (so it's easier to keep track of during download) # for testing purposes, I will not handle renaming and moving the file in this example my $name = $data; open ( UPLOADFILE, ">uploads/$name" ) or die ("$!"); binmode UPLOADFILE; while ( <$fh> ) { print UPLOADFILE; } close UPLOADFILE; print $query->header(); print "look in uploads/test.log and see if $data was passed to the hook
\n"; print "If the file is not there, it means hook was never called, proving the manual right (blasted!))
\n"; print "filetype: ".$query->uploadInfo($fh)->{'Content-Type'}; # this barfs, as nothing survives the sanitizing.. #### sub hook { my ($filename,$buffer,$bytes_received,$data) = @_; open (LOG, ">>uploads/test.log"); print LOG $filename." ".$bytes_received. " - ".$data."\n"; close (LOG); }