#!/usr/bin/perl -w use strict; use warnings; use CGI; use CGI::Carp "fatalsToBrowser"; # Make a file upload hook. my $q = new CGI (\&hook); # This is the file upload hook, where we can update our session # file with the dirty details of how the upload is going. sub hook { my ($filename,$buffer,$bytes_read,$file) = @_; # Get our sessid from the form submission. my ($sessid) = $ENV{QUERY_STRING}; $sessid =~ s/[^A-F0-9]//g; # Calculate the (rough estimation) of the file size. This isn't # accurate because the CONTENT_LENGTH includes not only the file's # contents, but also the length of all the other form fields as well, # so it's bound to be at least a few bytes larger than the file size. # This obviously doesn't work out well if you want progress bars on # a per-file basis, if uploading many files. This proof-of-concept only # supports a single file anyway. my $length = $ENV{'CONTENT_LENGTH'}; my $percent = 0; if ($length > 0) { # Don't divide by zero. $percent = sprintf("%.1f", (( $bytes_read / $length ) * 100) ); } # Write this data to the session file. open (SES, ">$sessid.session"); print SES "$bytes_read:$length:$percent"; close (SES); } # Now the meat of the CGI script. print "Content-Type: text/html\n\n"; my $action = $q->param("do") || "unknown"; if ($action eq "upload") { # They are first submitting the file. This code doesn't really run much # until AFTER the file is completely uploaded. my $filename = $q->param("incoming"); my $handle = $q->upload("incoming"); my $sessid = $q->param("sessid"); $sessid =~ s/[^A-F0-9]//g; $filename =~ s/(?:\\|\/)([^\\\/]+)$/$1/g; # Copy the file to its final location. open (FILE, ">./files/$filename") or die "Can't create file: $!"; my $buffer; while (read($handle,$buffer,2048)) { print FILE $buffer; } close (FILE); # Delete the session file. unlink("./$sessid.session"); # Done. print "Thank you for your file. Here it is again."; } elsif ($action eq "ping") { # Checking up on the status of the upload. my $sessid = $q->param("sessid"); $sessid =~ s/[^A-F0-9]//g; # Exists? if (-f "./$sessid.session") { # Read it. open (READ, "./$sessid.session"); my $data = ; close (READ); print $data; } else { print "0:0:0:error session $sessid doesn't exist"; } } else { print "0:0:0:error invalid action $action"; }