#!/usr/bin/perl ###################################################### # upload a file with netscape 2.0+ or IE 4.0+ # Muhammad A Muquit # When: Long time ago # Changelog: # James Bee" reported that from Windows filename # such as c:\foo\fille.x saves as c:\foo\file.x, Fixed, Jul-22-1999 # Sep-30-2000, muquit@muquit.com # changed the separator in count.db to | from : # As in NT : can be a part of a file path, e.g. c:/foo/foo.txt ###################################################### # # $Revision: 5 $ # $Author: Muquit $ # $Date: 3/28/04 9:38p $ #use strict; use CGI; # if you want to restrict upload a file size (in bytes), uncomment the # next line and change the number #$CGI::POST_MAX=50000; $|=1; my $version="V1.4"; ## vvvvvvvvvvvvvvvvvvv MODIFY vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv # the text database of the user. The text database contains the | # separated items, namely login|encrypted password|upload path # example: muquit|fhy687kq1hger|/usr/local/web/upload/muquit # if no path is specified, the file must be located in the cgi-bin directory. my $g_upload_db="upload.db"; # overwrite the existing file or not. Default is to overwrite # chanage the value to 0 if you do not want to overwrite an existing file. my $g_overwrite=1; # if you want to restrict upload to files with certain extentions, change # the value of $g_restrict_by_ext=1 and ALSO modify the @g_allowed_ext if you # want to add other allowable extensions. my $g_restrict_by_ext=0; # case insensitive, so file with Jpeg JPEG GIF gif etc will be allowed my @g_allowed_ext=("jpeg","jpg","gif","png"); ## ^^^^^^^^^^^^^^^^^^^ MODIFY ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ #-------------- globals---------- STARTS ------------------ my $query=new CGI; my $g_debug=0; my $g_title="File upload"; my $g_upload_path=''; #-------------- globals---------- ENDS ------------------ print $query->header; # Java Script for form validation # my $JSCRIPT=<path_info eq "/author" or $query->path_info eq "/about") { &printForm; &printAuthorInfo; return; } if ($query->param) { &doWork(); } else { &printForm(); } ##----- # printForm() - print the HTML form ##----- sub printForm { print "
\n"; print "\n"; print $query->start_multipart_form,"\n"; #------------- userid print "\n"; print "\n"; print "\n"; print "\n"; #------------- password print "\n"; print "\n"; print "\n"; print "\n"; #------------- upload print "\n"; print "\n"; print "\n"; print "\n"; #------------- submit print "\n"; print "\n"; print "\n"; print $query->endform,"\n"; print "
\n"; print "Userid:\n"; print "\n"; print $query->textfield(-name=>'userid', -size=>20); print "
\n"; print "Password:\n"; print "\n"; print $query->password_field(-name=>'password', -size=>20); print "
\n"; print "Upload file:\n"; print "\n"; print $query->filefield(-name=>'upload_file', -size=>30, -maxlength=>80); print "
\n"; print "
\n"; print $query->submit(-label=>'Upload', -value=>'Upload', -onClick=>"return ValidateAllFields(this.form)"),"\n"; print "
\n"; print "
\n"; } ##------ # printHTMLHeader() ##------ sub printHTMLHeader { print $query->start_html( -title=>"$g_title", -script=>$JSCRIPT, -bgcolor=>"#ffffff", -link=>"#ffff00", -vlink=>"#00ffff", -alink=>"#ffff00", -text=>"#000000"); } ##------- # doWork() - upload file ##------- sub doWork { ################## my $em=''; ################## # import the paramets into a series of variables in 'q' namespace $query->import_names('q'); # check if the necessary fields are empty or not $em .= "
You must specify your Userid!
" if !$q::userid; $em .= "You must specify your Password!
" if !$q::password; $em .= "You must select a file to upload!
" if !$q::upload_file; &printForm(); if ($em) { &printError($em); return; } if (&validateUser() == 0) { &printError("Will not upload! Could not validate Userid: $q::userid"); return; } # if you want to restrict upload to files with certain extention if ($g_restrict_by_ext == 1) { my $file=$q::upload_file; my @ta=split('\.',$file); my $sz=scalar(@ta); if ($sz > 1) { my $ext=$ta[$sz-1]; if (! grep(/$ext/i,@g_allowed_ext)) { &printError("You are not allowed to upload this file"); return; } } else { &printError("You are not allowed to upload this file"); return; } } # now upload file &uploadFile(); if ($g_debug == 1) { my @all=$query->param; my $name; foreach $name (@all) { print "$name ->", $query->param($name),"
\n"; } } } ##------ # printError() - print error message ##------ sub printError { my $em=shift; print<
Error - $em
EOF ; } ##-- # validate login name # returns 1, if validated successfully # 0 if validation fails due to password or non existence of login # name in text database ##-- sub validateUser { my $rc=0; my ($u,$p); my $userid=$query->param('userid'); my $plain_pass=$query->param('password'); # open the text database unless(open(PFD,$g_upload_db)) { my $msg=< Reason: $!
Make sure that your web server has read permission to read it. EOF ; &printError("$msg"); return; } # first check if user exist $g_upload_path=''; my $line=''; while () { $line=$_; chomp($line); # get rid of CR $line =~ s/\r$//g; ($u,$p,$g_upload_path)=split('\|',$line); if ($userid eq $u) { $rc=1; last; } } close(PFD); if (crypt($plain_pass,$p) ne $p) { $rc=0; } return ($rc); } ##-------- # uploadFile() ##-------- sub uploadFile { my $bytes_read=0; my $size=''; my $buff=''; my $start_time; my $time_took; my $filepath=''; my $filename=''; my $write_file=''; $filepath=$query->param('upload_file'); # James Bee" reported that from Windows filename # such as c:\foo\fille.x saves as c:\foo\file.x, so we've to get the # filename out of it # look at the last word, hold 1 or more chars before the end of the line # that doesn't include / or \, so it will take care of unix path as well # if it happens, muquit, Jul-22-1999 if ($filepath =~ /([^\/\\]+)$/) { $filename="$1"; } else { $filename="$filepath"; } # if there's any space in the filename, get rid of them $filename =~ s/\s+//g; $write_file="$g_upload_path" . "/" . "$filename"; &print_debug("Filename=$filename"); &print_debug("Writefile= $write_file"); if ($g_overwrite == 0) { if (-e $write_file) { &printError("File $filename exists, will not overwrite!"); return; } } if (!open(WFD,">$write_file")) { my $msg=<$write_file
It could be:
  1. The upload directory: \"$g_upload_path\" does not have write permission for the web server.
  2. The upload.db file has Control character at the end of line
EOF ; &printError("$msg"); return; } $start_time=time(); while ($bytes_read=read($filepath,$buff,2096)) { $size += $bytes_read; binmode WFD; print WFD $buff; } &print_debug("size= $size"); close(WFD); if ((stat $write_file)[7] <= 0) { unlink($write_file); &printError("Could not upload file: $filename"); return; } else { $time_took=time()-$start_time; print<
File $filename of size $size bytes is uploaded successfully!
EOF ; } } sub printAuthorInfo { my $url="http://www.muquit.com/muquit/"; my $upl_url="http://muquit.com/muquit/software/upload_pl/upload_pl.html"; print<
upload.pl $version by Muhammad A Muquit
EOF ; } sub print_debug { my $msg=shift; if ($g_debug) { print "(debug) $msg
\n"; } }