####
#!/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);
}