PERL CGI Beginners - CGI Upload Code

Author

CGI Upload Code

David Gilden

2006-01-10, 3:56 am

Holiday Greetings,
I copied this from a CGI web site, and while it does work,
I was wondering what folks with more experience in PERL thought of=20
this code.
Thanks for any comments,
Dave Gilden

#!/usr/bin/perl -w

use CGI qw/:standard/;
use CGI;
use Fcntl qw( :DEFAULT :flock );
use CGI::Carp qw(fatalsToBrowser);
use strict;

# Upload Code
use constant UPLOAD_DIR =3D> "/home/sites/site01/web/private/mydata/";
use constant BUFFER_SIZE =3D> 16_384;
use constant MAX_FILE_SIZE =3D> 2 * 1_048_576; #Limit each upload to 2 M=
B
use constant MAX_DIR_SIZE =3D> 10 * 1_048_576; # Limit total uploads to 1=
0 MB
use constant MAX_OPEN_TRIES =3D> 100;

$CGI::DISABLE_UPLOADS =3D 0;
$CGI::POST_MAX =3D MAX_FILE_SIZE;

my $q =3D new CGI;
$q->cgi_error and error( $q, "Error transferring file: " . $q->cgi_error );

my $action =3D $q->param( "action" );
=20
if ($action =3D~ /Update/) {
print redirect("./import_clean_csv.php");
exit;
};
=20
if ($action =3D~ /Clean/) {
my @filesToRemove; =20
=20
chdir UPLOAD_DIR or die "Couldn't chdir to afm_data directory: $!";
=20
#my @filesToRemove =3D map {$_ =3D~ /^(\w[\w.-]*)/} <*>;
=20
opendir(DR,"./");
@filesToRemove =3D grep {$_ =3D~ /^(\w[\w.-]*)/} readdir DR;
closedir DR;

print $HTML_HEADER;
print '<div align=3D"center">';

foreach my $fr (@filesToRemove) {
=20
print "Deleted $fr<br>\n";
unlink($fr) or die "Couldn't Delete $fr $!";
}

print <<HTML_OUT;
<p class=3D"top-header">Your Done close this window!=20
<form><input type=3D"button" onclick=3D"self.close()" value=3D"Close Windo=
w"></form></p>
</div>
HTML_OUT
print end_html;
exit;
};

if ($action =3D~ /Upload/) {

my $file =3D $q->param( "file" ) || error( $q, "No file received." );

# my $filename =3D $q->param( "filename" ) || error( $q, "No filename ente=
red." );
my $fh =3D $q->upload( "file" );
my $buffer =3D "";

if ( dir_size( UPLOAD_DIR ) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) {
error( $q, "Upload directory is full." );
}

# Open output file, making sure the name is unique
until ( sysopen OUTPUT, UPLOAD_DIR . "/$file", O_CREAT | O_RDWR | O=
_EXCL ) {
# $file =3D~ s/(\d*)(\.\w+)$/($1||0) + 1 . $2/e;
$1 >=3D MAX_OPEN_TRIES and error( $q, "Unable to save your file=
=2E" );
}
=20

# This is necessary for non-Unix systems; does nothing on Unix
#binmode $fh;
#binmode OUTPUT;

# Write contents to output file
while ( read( $fh, $buffer, BUFFER_SIZE ) ) {
print OUTPUT $buffer;
}

close OUTPUT;

------snip-------

Cool music.....From Guine=C3=A9 comes this CD of kora fusion, electronica =
=20
[ Audition Mp3s at the URL below ]
<http://www.coraconnection.com/pages...ds.html#sabolan>

usenet@DavidFilmer.com

2006-01-10, 3:56 am

David Gilden wrote:
> Holiday Greetings,

Merry Christmas.

> I copied this from a CGI web site, and while it does work,
> I was wondering what folks with more experience in PERL thought of
> this code.

A lot of it looks familiar. I wonder about some bits (none of my
suggested code has been tested)...

> #!/usr/bin/perl -w

better to 'use wanings' - lexical warnings better than global (-w)

>
> use CGI qw/:standard/;
> use CGI;

no need to use the CGI module twice.

> use Fcntl qw( :DEFAULT :flock );
> use CGI::Carp qw(fatalsToBrowser);
> use strict;

Good!

> # Upload Code
> use constant UPLOAD_DIR => "/home/sites/site01/web/private/mydata/";
> use constant BUFFER_SIZE => 16_384;
> use constant MAX_FILE_SIZE => 2 * 1_048_576; #Limit each upload to 2 MB
> use constant MAX_DIR_SIZE => 10 * 1_048_576; # Limit total uploads to 10 MB
> use constant MAX_OPEN_TRIES => 100;
>
> $CGI::DISABLE_UPLOADS = 0;
> $CGI::POST_MAX = MAX_FILE_SIZE;
>
> my $q = new CGI;
> $q->cgi_error and error( $q, "Error transferring file: " . $q->cgi_error );
>
> my $action = $q->param( "action" );
>
> if ($action =~ /Update/) {
> print redirect("./import_clean_csv.php");

That should be ./import_clean_csv.cgi, dontcha think ;)

HOWEVER, this is a redirect to a relative URL. That's NOT supported by
the CGI module. See
http://search.cpan.org/~lds/CGI.pm-...IRECTION_HEADER

> exit;

This is normally considered bad practice. Proper flow control should
happen within your "if" constructs. Most programmers would say that
"exit" should only be used to bail out of a program unexpectedely (with
an exit code).

> };
>
> if ($action =~ /Clean/) {
> my @filesToRemove;
>
> chdir UPLOAD_DIR or die "Couldn't chdir to afm_data directory: $!";
>
> #my @filesToRemove = map {$_ =~ /^(\w[\w.-]*)/} <*>;
>
> opendir(DR,"./");
> @filesToRemove = grep {$_ =~ /^(\w[\w.-]*)/} readdir DR;

I hope your program knows what it's doing... this looks like a
potential security risk...

> closedir DR;
>
> print $HTML_HEADER;

Where did that come from?

> print '<div align="center">';
>
> foreach my $fr (@filesToRemove) {
>
> print "Deleted $fr<br>\n";
> unlink($fr) or die "Couldn't Delete $fr $!";
> }

So if you can't delete a file, you first say it WAS deleted, and then
say it wasn't? Why not make it a bit more clear:
if (unlink $fr) {
print "Deleted $fr<br>\n";
}else{
die "Oh no - $!\n"
}

I don't like that <br> though. It goes against CSS best practices. The
paragraph should be in a (styled) <P> tagest. <br> shouldn't be used
for paragraphs in a CSS world.

> print <<HTML_OUT;

YUCK! Here docs make me sick to my stomach.

> <p class="top-header">Your Done close this window!
> <form><input type="button" onclick="self.close()" value="Close Window"></form></p>
> </div>
> HTML_OUT

Why are you mixing HTML and CGI.pm? Use CGI.pm to print this (and
avoid a here doc):

print
p({class => 'top-header'},
form(
input({type => 'button', onclick => 'self.close()', value
=> 'Close Window'}),
)
);

You never need to print raw HTML when using CGI.pm.

> print end_html;
> exit;

Same comment about exit

The upload stuff looks OK (and fairly familiar...)

Cheers!

--
http://DavidFilmer.com

Sponsored Links