#!/usr/bin/perl ####################################################################################### # # PSUpload Helper (PSUpload) V2.1 # ©2000, Perl Services # # Requirements: UNIX Server, Perl5+, CGI.pm # Created: September 22nd, 2000 # Author: Jim Melanson # Contact: www.perlservices.net # Phone: 1-877751-5900, ext. 908 # Fax: 1-208-694-1613 # E-Mail: info@perlservices.com # info@charityware.ws # # # http://www.perlservices.net/en/programs/psupload/users_guide.shtml # ####################################################################################### # # # This utility is distributed under the same terms as Perl itself. It may be # modified and utilized as you will so long as the original copyright notice # remains in the header and that any modifications you make are state in the # header along with the date of the modification and the name and email addy # of the person who made the modification. # # Additionally, this program has been designated as Charity Ware. That means # that if you use the program or modify the program to use it in/with another # program then you are required to make a charitable donation to a charity # of YOUR choice in the amount of YOUR choice. We'd appreciate your dropping # by Charity Ware (www.charityware.ws) to register your donation so others can # see who is benefiting from our work. If your too busy, drop us a line telling # us who benefited and how much you gave them and we'll post the registration # for you. # # This program requires installation on a UNIX server running Perl4 or higher. # # This program require the use of the CGI.pm module. If it is not installed # on your server, you can have your sysadmin obtain the latest version of CGI.pm # form the CPAN site at www.cpan.org # # Please see the accompanying HTML demonstration file for instructions on # creating the upload form you will put on your HTML page. # # History: # This program was originally written in a basic form by Mark Knickelbain. After # Perl Services was taken over by Jim Melanson, this utility was re-written. This # re-write has been based on the feedback of hundreds of users. The features # incorporated in the re-write were the most common requests of PSUpload Helper # users. Version 2.0 of this program was released on February 22nd, 2001. # # It was the authors choice that PSUpload Helper 2.0 should be distributed from # the Charity Ware site at www.charityware.ws so that others less fortunate may # benefit from his efforts. # ####################################################################################### # # FINAL WORD: Do you have comments or criticisms (constructive ones) please # send them to jim@perlservices.com or info@charityware.ws. This # library and the V2 of PSUpload Helper are the results of input # from end users and incorporate the most common requests. # ####################################################################################### #!/usr/bin/perl use GD; my $req = new CGI; # CONFIGURE VARIABLES $jpeg_quality = 75; # # $Data = "pictures"; # On your server, create a directory where this program will write the files # to. Make sure you CHMOD this directory to 777. If you do NOT specify a $Data # directory, the program will attempt to write to the web root directory. # NOTE: YOU SHOULD ALWAYS SPECIFY A DIRECTORY TO STORE THE UPLOAD @good_extensions = ('gif', 'jpg', 'jpeg','png', 'PNG','GIF', 'JPG', 'JPEG'); # If you want to limit the types of extension that can be uploaded, specify them # here by adding them to the array. For example, if you wanted to permit only # the upload of gif's, jpg's and png's, then you would set the above array to # look like this: # @good_extensions = ('gif', 'jpg', 'jpeg', 'png'); # @bad_extensions = (); # If you want to permit the upload of all file types with only certain exceptions, # then specify those extensins in the bad_extensions array. This means that if set # this array to contain .exe, .pl, .cgi files, then the program will only store a # file if the extension of that file is NOT found in this array. # To set the array to exclude these sample extensions, you would set it like this: # @bad_extensions = ('exe', 'cgi', 'pl'); # # NOTE: If you specify both @good_extensions and @bad_extensions, then # the settings in @bad_extensions will be ignored and the program will # use @good_extensions as it's refrence. #$redirect = ""; # When the upload of files is complete, the program must print someting out on the # browser screen. Set the $redirect variable to the full URL (don't forget the http://) # that you want the person taken to once the program is finished. If you don't specify # a URL here, the program will print out a simple upload summary page. $max_size = "2000"; # Set the maximum size of each file that is permitted. For example, if you only want # files to be uploaded that are under 50Kb in size, set the value to: # $max_size = 50; # If you set the value to zero, remove it or comment it out, then the size of the # uploaded file will NOT be checked. $max_num_files = 5; # You must specify the maximum number of files that can be uploaded at one time. You # can set this to any number you want but be realistic. The limit before the server # times out will depend on the maximum size of the upload. I have tested this program # with ASCII files up to 8MB in size successfully but that was on a particularly # robust server. I recommend that you set this no higher than 5 if you are going to # be using this for larger binary files such as images or executables or word docs, etc. # If you remove, comment out or set this value to zero, the program will default the # value to 1 file. # ####################################################################################### # # DO NOT EDIT ANYTHING BELOW THIS LINE # UNLESS YOU KNOW WHAT YOU ARE DOING # if(($ENV{'QUERY_STRING'} =~ /^debug/) && !$no_debug) { print "Pragma: no-cache\nContent-type: text/html\n\n"; print "PSUpload Demonstration Upload Program - Debug Mode\n"; print"
$URL
$Half_Credit_Limit
$req->param('URL')
"; print "

Charity Ware's PSUpload Program



\n"; print "
Your web root directory appears to be located at:
$ENV{'DOCUMENT_ROOT'}

You specified directory for storing the uploads is:
$Data

Your specified directory...
\n"; if(-d $Data) { print "...appears to be a valid directory.

Make sure this \$Data directory is CHMOD 777.\n"; } else { print "...does not appear to be a valid directory.

\n"; unless($Data =~ /^$ENV{'DOCUMENT_ROOT'}/) { print "The value you specified in the \$Data variable is incorrect. Please
correct your \$Data variable and run debug again.

\n"; } } if($Data =~ /\/$/) { print "NOTE: Your variable \$Data ends with a trailing slash. Please
remove this trailing slash, upload the program again
and run debug once more to see if you have a valid directory.


\n"; } print "


OS:
$^O

Perl:
$]
Installed:
"; my @inst = split(/\//, $ENV{'SERVER_SOFTWARE'}); print join("
", @inst); print"






\n"; } else { use CGI; $max_num_files ||= 1; $Data ||= $ENV{'DOCUMENT_ROOT'}; undef @bad_extensions if @good_extensions; for(my $a = 1; $a <= $max_num_files; $a++) { # my $req = new CGI; if($req->param("FILE$a")) { my $file = $req->param("FILE$a"); my $filename = $file; $filename =~ s/^.*(\\|\/)//; $filename =~ s/ +/\_/g; my $proceed_type = 0; if(@good_extensions) { foreach(@good_extensions) { my $ext = $_; $ext =~ s/\.//g; if($filename =~ /\.$ext$/) { $proceed_type = 1; last; } } unless($proceed_type) { push(@was_not_good_type, $filename); } } elsif(@bad_extensions) { $proceed_type = 1; foreach(@bad_extensions) { my $ext = $_; $ext =~ s/\.//g; if($filename =~ /\.$ext$/) { $proceed_type = 0; last; } } unless($proceed_type) { push(@was_a_bad_type, $filename); } } else { $proceed_type = 1; } if($proceed_type) { if(open(OUTFILE, ">$Data/$filename")) { while (my $bytesread = read($file, my $buffer, 2000)) { print OUTFILE $buffer; } close (OUTFILE); push(@file_did_save, $filename); } else { push(@did_not_save, $filename); } } if($max_size) { if((-s "$Data/$filename") > ($max_size * 2000)) { push(@was_too_big, $filename); unlink("$Data/$filename"); } } ### Image resize begin $im = GD::Image->new("$Data/$filename"); if(!$im){push(@gif_not, $filename);} else{ ($x,$y) = $im->getBounds(); $new_ord = 400; if ($x > $y) { $new_width = $new_ord; $new_height = $y * ($new_width * 100 / $x) / 100; } if ($x < $y) { $new_height = $new_ord; $new_width = $x * ($new_height * 100 / $y) / 100; }; if ($x == $y) { $new_height = $new_ord; $new_width = $new_ord; } if(($x > $new_ord) || ($y > $new_ord)){ $myImg = new GD::Image($new_width,$new_height,1); $myImg->copyResized($im,0,0,0,0,$new_width,$new_height,$x,$y); open(F,">$Data/$filename"); print F $myImg->jpeg($jpeg_quality); close(F); } } ### Image resize end } } print "Pragma: no-cache\n"; if($redirect && ($redirect =~ /^http\:\/\//)) { print "Location: $redirect\n\n"; } else { print "Content-type: text/html\n\n"; print "PSUpload Results

Upload Results




\n"; if(@file_did_save) {print "The following file(s) were saved:

\n"; print join("
", @file_did_save); print "

\n"} if(@was_not_good_type) {print "The following file(s) were not stored as their file extension
did not match any of the valid extensions specified in the program:

\n"; print join("
", @was_not_good_type); print "

\n"} if(@was_a_bad_type) {print "The following files were not stored as their file extension
are on the list of extensions not permitted for upload:

\n"; print join("
", @was_a_bad_type); print "

\n"} if(@was_too_big) {print "The following files were not stored as their file size
exceeded the maximum file size of $max_size Kb.:

\n"; print join("
", @was_too_big); print "

\n"} if(@gif_not) {print "GIF resize not supported by GD

\n"; print join("
", @gif_not); print "

\n"} if(@did_not_save) {print "The following files were not stored because the
program could not open their destination file:

\n"; print join("
", @did_not_save);print "

\n"; if(!@file_did_save) {print "NOTE: Check to ensure that the \$Data variable reflects the correct
absolute path to the directory these files should be store in.


"} } print "




\n"; } }