#!/usr/bin/perl -w # Where is the upload file going? my $Upload_Dir = 'uploads'; $| = 1; use strict; use CGI::Carp qw(fatalsToBrowser); use CGI qw/:standard/; use CGI::Ajax; use File::Basename; my $safe_filename_characters = "a-zA-Z0-9_.-"; # get the ID from the action-url # this will be used to grab the id from the action-part of the url this script is called with (thanks to Anonymous Monk) my $q = CGI->new($ENV{QUERY_STRING}); # I will initially save my file with 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) my $data = $q->param('id'); #$data = $1 if $data =~ //;# untaint id - for some reason this sets the contents of $data to .. nothing? # create new object $q = CGI->new(\&hook, $data); my $pjx = new CGI::Ajax('check_status' => \&check_status); my $init_rand_string = 0; if(!$q->param('process')){ $init_rand_string = generate_rand_string(); } my $d = <
EOF ; my $outfile; my $outfile2; if ($q->param('uploadedfile')) { $outfile = $q->param('uploadedfile'); my ($name, $path, $extension) = fileparse($outfile, qr/\.[^.]*/); $outfile2 = $q->param('rand_string') . $extension; } else { $outfile = $outfile2 = "na"; } my $p = <

Done!:

"$outfile" saved as "$outfile2"

back EOF ; main(); sub main { if($q->param('process')){ if($q->param('yes_upload')) { upload_that_file($q); } print $q->header(); print $p; dump_meta_file(); } else { print $pjx->build_html( $q, $d); } } sub upload_that_file { my $q = shift; my $fh = $q->upload('uploadedfile'); my $filename = $q->param('uploadedfile'); if ($filename =~ m/c:/i) { fileparse_set_fstype('MSWin32'); } my ($name, $path, $extension) = fileparse($filename, qr/\.[^.]*/); $filename = $q->param('rand_string') . $extension; $filename =~ tr/ /_/; $filename =~ s/[^$safe_filename_characters]//g; return '' if ! $filename; my $outfile = $Upload_Dir . '/' . $filename; open (OUTFILE, '>' . $outfile) or die("can't write to " . $outfile . ": $!"); my $bytes_read = 0; while (my $bytesread = read($fh, my $buffer, 1024)) { print OUTFILE $buffer; $bytes_read += $bytesread; } close (OUTFILE); } sub check_status { # here we use the passed $data to look up the status of that particular upload my $filename = $q->param('rand_string'); # shoul be detainted, but we're just testing, right? return '' if ! -f $Upload_Dir . '/' . $filename . '-meta.txt'; open my $META, '<', $Upload_Dir . '/' . $filename . '-meta.txt' or die $!; my $s = do { local $/; <$META> }; close ($META); my $small = 100 - ($s * 1); my $big = $s * 1; my $r .= '
'.$s.'%
'; $r .= '
'; return $r; } sub dump_meta_file { my $filename = $q->param('rand_string'); unlink($Upload_Dir . '/' . $filename . '-meta.txt') or warn "deleting meta file didn't work..."; } # will be replaced with my own sub that interacts with a DB sub generate_rand_string { my $chars = shift || 'aAeEiIoOuUyYabcdefghijkmnopqrstuvwxyzABCDEFGHJKMNPQRSTUVWXYZ23456789'; my $num = shift || 1024; require Digest::MD5; my @chars = split '', $chars; my $ran; for(1..$num){ $ran .= $chars[rand @chars]; } return Digest::MD5::md5_hex($ran); } sub hook { # here we use the passed $data to provide a proper ID for the current file being uploaded my ($filename, $buffer, $bytes_read, $data) = @_; $bytes_read ||= 0; open(COUNTER, ">" . $Upload_Dir . '/' . $data . '-meta.txt'); my $per = 0; if($ENV{CONTENT_LENGTH} > 0){ # This *should* stop us from dividing by 0, right? $per = int(($bytes_read * 100) / $ENV{CONTENT_LENGTH}); } print COUNTER $per; close(COUNTER); }