On Tue, 27 Aug 2002 13:35:23 -0700, [EMAIL PROTECTED] (Vargas
Media) wrote:
>Below is an example of a upload.cgi that utilizes CGI.pm
>Any help extremely appreciated.
>Steve
I've commented your script with the changes I made to make it run.
A full copy-n-paste is below.
I had to add an O_RDWR flag to the sysopen statement.
I added a header at the very end if successful.
>############################################################################
>#########
>#!/usr/bin/perl -wT
>use strict;
>use CGI;
>use Fcntl qw( :DEFAULT :flock );
>
># use constant UPLOAD_DIR => "/usr/local/bin";
>use constant UPLOAD_DIR => " /www/vargasmedia/uploads/";
Couldn't get the UPLOAD_DIR constant to be accepted in the
statements? I don't know why. But I changed it to using a
variable $uploadir.
>use constant BUFFER_SIZE =>16_384;
>use constant MAX_FILE_SIZE => 100 * 1_048_576;
>use constant MAX_DIR_SIZE => 100 * 1_048_576;
>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 $uploadir = '/home/zentara/public_html/cgi-bin/uploads/';
>
>my $file = $q->param( "file" ) || error( $q, "No file
>recieved." );
>my $filename = $q->param( "filename" ) || error( $q, "No filename
>entered." );
>my $fh = $q->upload( $file );
>my $buffer = "";
>
if ( dir_size($uploadir ) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) {
> error( $q, "Upload directory is full." );
>}
>
># Convert odd ball characters to 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 file name is unique
until ( sysopen OUTPUT, $uploadir . $filename, O_CREAT | O_EXCL |O_RDWR)
{
> $filename =~ s/(\d*)(\.\w+)$/($1||0) + 1 . $2/e;
> $1 >= MAX_OPEN_TRIES and error( $q, "Unable to save your file." );
>}
># This is neccessary 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;
print $q->header( "text/html" );
print "Thanks";
>
>sub dir_size {
.......
>sub error {
........
> exit;
>}
#########################################################################
my working copy
##################################################################
#!/usr/bin/perl -wT
use strict;
use CGI;
use Fcntl qw( :DEFAULT :flock );
use constant BUFFER_SIZE =>16_384;
use constant MAX_FILE_SIZE => 100 * 1_048_576;
use constant MAX_DIR_SIZE => 100 * 1_048_576;
use constant MAX_OPEN_TRIES =>100;
my $uploadir= '/home/zentara/public_html/cgi-bin/uploads/';
$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 $file = $q->param( "file" ) || error( $q, "No file recieved."
);
my $filename = $q->param( "filename" ) || error( $q, "No filename
entered." );
my $fh = $q->upload('file');
my $buffer = "";
if ( dir_size($uploadir) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) {
error( $q, "Upload directory is full." );
}
# Convert odd ball characters to 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 file name is unique
until ( sysopen OUTPUT, $uploadir.$filename, O_CREAT | O_EXCL | O_RDWR)
{
$filename =~ s/(\d*)(\.\w+)$/($1||0) + 1 . $2/e;
$1 >= MAX_OPEN_TRIES and error( $q, "Unable to save your file." );
}
#This is neccessary 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;
print $q->header( "text/html" );
print "Thanks";
############################################
sub dir_size {
my $dir = shift;
my $dir_size = 0;
# loop through files and sume the sizes; doesn't decend down subdirs
opendir DIR, $dir or die "Unable to open $dir: $!";
while ( readdir DIR ) {
$dir_size += -s "$dir/$_";
}
return $dir_size;
}
#############################################
sub error {
my( $q, $reason ) = @_;
print $q->header( "text/html" ),
$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;
}
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
