I am trying to write a CGI script in Perl that would let me upload files onto my server through port 80, the only usable open port in my Colleges WiFi and as long as I don’t flood their WiFi with uploads not going to upload anything bigger than ~5MB so I don’t see a problem. I have this started and it generates the form correctly in the browser but it doesn’t save the file on the server when I try.
#!/usr/bin/perl -T
use warnings;
use strict;
use CGI qw(:standard);
BEGIN {
$|=1;
print "Content-type: text/html
";
use CGI::Carp('fatalsToBrowser');
}
use diagnostics;
#Declare any variables
my $radio_button;
my $filename;
#Generate the form
print header;
print start_html ("File Uploader v4");
print "<h1>File Uploader</h1>
";
print "<hr>
";
print "<p>Which file type: </p>
";
print radio_group(-name=>'File_Type',
-values=>'HTML', 'CGI'],
-default=>'HTML');
print start_multipart_form();
print "<p>File upload: </p>
";
print filefield (-name=>'Uploaded_file',
-default=>'Give a file',
-size=>50);
print "<br><br>
";
print submit('Upload', 'Upload');
print reset;
print endform;
#Do the work
$radio_button = param('File_Type');
if ( $radio_button eq "HTML" ) {
$filename = upload('Uploaded_file');
#open (OUTFILE, ">>/srv/www/htdocs/");
open (OUTFILE, ">>/tmp/$filename") || die "Can't open the file: $!";
my $old_filehandle = select( OUTFILE );
$|++;
select( $old_filehandle );
while (<$filename>) {
print OUTFILE $_;
}
close (OUTFILE);
open (MAIL, "|/usr/bin/mail -s \"File uploaded\" vendion");
select( MAIL );
$|++;
select( $old_filehandle );
print MAIL "A file has just been uploaded!
";
close (MAIL);
} else {
$filename = upload('Uploaded_file');
open (OUTFILE, ">>/srv/www/cgi-bin/");
while (<$filename>) {
print OUTFILE $_;
}
}
print end_html;
When I run it nothing happens that causes CGI::Carp to run, but I find this in Apache’s error logs
“[Mon Dec 08 14:23:57 2008] [error] [client ...*] [Mon Dec 8 14:23:57 2008] upload: print() on closed filehandle OUTFILE at /srv/www/cgi-bin/upload line 58, <fh00001quotes> line 7., referer: http://vendion.dyndns.org/cgi-bin/upload”
Anyone know how to fix this, or have a clue as to what is going wrong?
my $old_filehandle = select( OUTFILE );
$|++;
select( $old_filehandle );
Why all that futzing around with OUTFILE? The man page just suggests this:
# Read a text file and print it out
while (<$filename>) {
print OUTFILE $_;
}
or this:
# Copy a binary file to somewhere safe
open (OUTFILE,">>/usr/local/web/users/feedback");
while ($bytesread=read($filename,$buffer,1024)) {
print OUTFILE $buffer;
}
# Read a text file and print it out
while (<$filename>) {
print OUTFILE $_;
}
You can still see it in the mess, but it didn’t work so I asked in nntp.perl.org and got no where and looking through Perl Monks site there was an article on debugging CGI scripts, which caught my eye so I read it and it said that to get the best result with CGI::Carp you need to use $|++ to have the script flush the buffer to have the error show up in the logs, so I had it flush the buffer for the OUTFILE file handle although I don’t think it works because the error showing up in the logs are the same as before I just haven’t removed it yet.
All the script is setup to handle is HTML files and CGI scripts which both are plain text so I didn’t try the code for the binary uploader that the man pages has.
If you look at the line number (which I should have), it’s actually the print near the bottom of the file. You didn’t catch the error on the open:
open (OUTFILE, “>>/srv/www/cgi-bin/”);
First of all you can’t open a directory for writing like that, and secondly you probably wouldn’t have the permissions to anyway. What were you trying to do there anyway?
I didn’t think that would be the problem because I always had the “HTML” radio button selected so I figured it would try and upload it in /tmp and quit. What I was wanting to do there is if I selected the “CGI” radio button, then obviously I’m uploading a CGI script, and I want it to be placed in /srv/www/cgi-bin and once I get the upload problem maybe even make it chmod the file so it can be ran right there. I guess if I edit it so that it correctly opens some directory for writing and it works then I can move the files and chmod them as needed by hand, I just want this to work.
Well its uploading now but no matter what Radio button is selected it gets uploaded in the same directory
I have one directory setup, owned by wwwrun:www, with two sub directories one called html and one called cgi. In my script if the Radio button is HTML then it writes to /srv/www/uploaded/html/$filename if the radio button is CGI then it writes to /srv/www/uploaded/cgi/$filename but for some reason they both are ending up in the cgi directory. The problem with this is $radio_button = param(‘File_Type’_); is not reading the Radio buttons that is why my script was always running the else part. I’m looking in the documentation now to see if this is correct.
Well I want something so that only one option can be selected, I know with Radio Buttons this is true the problem is that when the script can not read what is selected in the radio button. I guess this can be down with a single check box but will cause problems later on if I expand it for more file types. Then again having it upload into different directories is not needed so I guess at this point I need to rethink how I want to do this.
What do you mean by rereading? I have my code like the one from the man page
print radio_group(-name=>‘group_name’,
-values=>‘eenie’,‘meenie’,‘minie’],
-default=>‘meenie’);
minus the optional arguments and its the same to return the selected value but when it is ran $radio_button is undefined.
The problem with your CGI script is control flow. Right after presenting the form you then test for the returned values. At that point nothing has been submitted, so none of the params will be defined, and in particular the radio_button is not defined, and so you drop to the else case. The correct way to arrange the program is:
# display form
if (param) {
# process form
}
or
if (param) {
# process form and display result
} else {
# display form
}
if you don’t want to display the form again after submitting.
This should do the trick… it might have more than you need but anyway.
#!/usr/bin/perl -T
use warnings;
use strict;
use CGI qw(:standard);
use File::Copy;
use File::Basename;
use Fcntl qw( :DEFAULT :flock );
use constant BUFFER_SIZE => 16_384;
use constant MAX_FILE_SIZE => 1_048_576; # Limit each upload to 1 MB
use constant MAX_DIR_SIZE => 100 * 1_048_576; # Limit total uploads to 100 MB
use constant MAX_OPEN_TRIES => 100;
use constant UPLOAD_DIR => "/tmp/";
BEGIN {
$|=1;
use CGI::Carp('fatalsToBrowser');
}
use diagnostics;
$CGI::DISABLE_UPLOADS = 0;
$CGI::POST_MAX = MAX_FILE_SIZE;
#Declare any variables
my $q = new CGI;
my $radio_button;
my $filename;
#print "content-type: text/html
";
#Generate the form
print header;
print start_html ("File Uploader v4");
print "<h1>File Uploader</h1>
";
print "<hr>
";
print "<p>Which file type: </p>
";
print start_multipart_form();
print radio_group(-name=>'File_Type',
-values=>'HTML', 'CGI'],
-default=>'HTML');
print "<p>File upload: </p>
";
print filefield (-name=>'Uploaded_file',
-default=>'Give a file',
-size=>50);
print "<br><br>
";
print submit('Upload', 'Upload');
print reset;
print endform;
if ($q->param("Upload")){
&uploadfile;
}
print end_html;
sub display_msg() {
my ($msg) = @_;
if ($msg =~ m/uploaded/ig){
print "<br/>";
print "<font size=-1 color=\"#FF0000\">$msg</font><br>
";
}
}
sub uploadfile {
my $radio_button = $q->param('File_Type');
my $file = $q->param( "Uploaded_file" ) || error( $q, "No file received." );
my $filename = $file;
my(undef, undef, $file_ext) = fileparse($filename,qr{\..*});
my $fh = $q->upload( "Uploaded_file" );
my $buffer = "";
if ( dir_size( UPLOAD_DIR ) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) {
error( $q, "Upload directory is full." );
}
if ($file_ext eq ".html" && $radio_button eq "CGI"){
error( $q, "You have selected a CGI file but you are trying to upload a $file_ext file");
}
if ($file_ext eq ".cgi" && $radio_button eq "HTML") {
error( $q, "You have selected a HTML file but you are trying to upload a $file_ext file");
}
if ($file_ext ne ".cgi" && $file_ext ne ".html") {
error( $q, "File type is invalid, you are trying to upload a $file_ext file");
}
my @array = split(/\\/,$filename);
$filename = $array$#array];
# Allow letters, digits, periods, underscores, dashes
# Convert anything else to an underscore
$filename =~ s/^\w.-]/_/g;
if ( $filename =~ /^(\w\w.-]*)/ ) {
$filename = $1;
}
else {
error( $q, "Invalid file name; files must start with a letter or number." );
}
# Open output file, making sure the name is unique
until ( sysopen OUTPUT, UPLOAD_DIR . "/$filename", O_CREAT | O_RDWR | O_EXCL )
{
$filename =~ s/(\d*)(\.\w+)$/($1||0) + 1 . $2/e;
$1 >= MAX_OPEN_TRIES and error( $q, "Unable to save your file." );
}
# Write contents to output file
while (read($fh,$buffer,BUFFER_SIZE))
{
print OUTPUT $buffer;
}
close OUTPUT;
my $msg = "The file $filename has been successfully uploaded.";
&display_msg($msg);
} # End of uploadfile()
sub error
{
my( $q, $reason ) = @_;
print
$q->start_html( "Error" ),
$q->h1( "Error" ),
$q->p( "Your upload was not processed because the following error ",
"occured: " ),
$q->p( $q->i( $reason ) ),
$q->end_html;
exit;
}
sub dir_size
{
my $dir = shift;
my $dir_size = 0;
# Loop through files and sum the sizes; doesn't descend down subdirs
opendir DIR, $dir or die "Unable to open $dir: $!";
while ( readdir DIR )
{
$dir_size += -s "$dir/$_";
}
return $dir_size;
} # End of dir_size()
