Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Answer: I need a simple web upload script.

( #130392=categorized answer: print w/ replies, xml ) Need Help??

Q&A > CGI programming > I need a simple web upload script. contributed by atcroft

Below is some code I wrote a while back for doing something similar, though not necessarily exactly the same. Below that is the HTML form, so you can see the enctype entry.

There are some issues with this code, such as the chance of files being overwritten, but this should give you a starting point.

This script also lets the uploader send an email. Of course, this could be abused, so some restrictions on this should probably be put in place.

Relevant thread: Security issues when allowing file upload via CGI.

My post-upload.cgi script:

#!/usr/bin/perl -- use CGI qw( :standard escapeHTML ); use strict; my $megabyte = 1024 * 1024; # bytes my $max_mb = 10; # max no. of MB we will allow $CGI::DISABLE_UPLOADS = 0; # CGI module variable for en/disabling uploads (non-zero to disable) $CGI::POST_MAX = $megabyte * $max_mb; # CGI module variable for maximum upload size (bytes) my $base_dir = "/var/www/site1/web/"; my $base_dom = "http://www.website.here/"; my $target_dir = "../uploads"; my $directory = $base_dir . $target_dir; my $sendmail = "/usr/bin/sendmail"; my @sendmail_opts = ( '-oi', '-t' ); $| = 1; my $query = new CGI; my @names = $query->param; my $url = $query->param("URL"); my $fh = $query->upload('upload_file'); my $filename = $query->param('name'); $filename =~ s/[^A-Za-z0-9\.\_]/_/g; open OUTF, "> $directory$filename" or die; binmode OUTF; while ( $bytesread = read $fh, $buffer, 1024 ) { print OUTF $buffer; } close OUTF; if ( !$file && $query->cgi_error ) { print $query->header( -status => $query->cgi_error ); exit 0; } open MAIL, "| $sendmail @sendmail_opts" or die "Can't fork sendmail: $ +!\n"; print MAIL "From: $0\n", "To: ", $query->param("TO"), "\n", "Subject: ", ( $query->param("SUBJECT") || "mailed form submission +" ), "\n\n"; for my $param ( @names ) { printf MAIL "%s: %s\n", $para, $query->param($param); } print MAIL "\n\nThe link to the uploaded file is $base_dom$target_dir$filenam +e . ", "It was renamed by the upload script, so you will need to rename i +t.\n"; close MAIL; print $query->redirect( -URL => $url );

My sample upload form (body only):

<form action="/cgi-bin/post-upload.cgi" method="post" enctype="multipa +rt/form-data"> <!-- hidden inputs --> <input name="TO" type="hidden" value="my.address@my.domain" /> <input name="URL" type="hidden" value="http://www.website.here/submiss +ion.done.htm" /> <input name="SUBJECT" type="hidden" value="From Your Upload Center on +Website" /> <!-- visible inputs --> File to send: <input name="upload_file" type="file" size="30" /><br> Your name: <input name="name" size="42" /><br> E-mail: <input name="Email" size="42" /><br> <input type="submit" value="SEND FILE" /> <input type="reset" value="CLEAR" /> </form>

Comment on Answer: I need a simple web upload script.
Select or Download Code
Re: Answer: a simple picture upload script
by dws (Chancellor) on Dec 08, 2001 at 10:52 UTC
    To make this portable to Win32 web servers, add   bindmode(OUT);
    after the open()
Re: Answer: a simple picture upload script
by atcroft (Monsignor) on Dec 09, 2001 at 08:08 UTC
    And I forgot the ending  </FORM> on the upload form snippet, too.
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (8)
As of 2014-12-27 15:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (177 votes), past polls