require 'cgi-lib2.pl'; # Indicate if your server O/S is Unix/Linux or Windows NT # Set to "unix" if Unix or Linux; set to "nt" if Windows NT $serverOS = "unix"; # This parameter defines what character set you want the Web # browser to be set to when viewing your Html pages. # Default is "". Chinese GB = "gb2312". Chinese Big5 = "Big5". $charset = "us-ascii"; # Supervisor Password. $superpwd = "whatever"; # Full pathname of directory (parent) which is 1 level higher than # the "file upload" directory (directory storing the uploaded files). # This directory must be resided in a Html directory # Create this directory manually if it is not already existed. # Use chmod command to set this directory to writable, i.e. 0777. # The last "/" character is significant. #I have refered this $parent_dir to the password file/files,(but no help). $parent_dir="/home/virtual/site71/fst/var/www/html/uploads/mp3/"; $return_url="http://www.mysite.net/"; @valid=('http://www.mysite.net/uploads/MP3Upload.html'); ################################################################### # Parse Form Contents &ReadParse; if ($ENV{'REQUEST_METHOD'} ne 'POST') { &error_not_a_command; } $| = 1; # Validate & execute command according to Action Type unless ( ($in{'action'} eq "uploadfile") || ($in{'action'} eq "listfilenames")) { &error_not_a_command; } if ($in{'action'} eq "uploadfile") {&uploadfile} if ($in{'action'} eq "listfilenames") {&listfilenames} exit; sub uploadfile { &check_url_referer; if ($in{'pwd'} ne $superpwd) { &error_password; } if (!$in{'sourcefile'}) { &error_uploadfile; } if (!$in{'filedirname'}) { &error_no_upload_directory; } if ($in{'filedirname'} =~ /[^a-z0-9A-Z]+/) { &error_invalid_directory_name; } if ($in{'maxfilesize'}) { $maxfilesize = $in{'maxfilesize'}; }

if ($ENV{'CONTENT_LENGTH'} > $maxfilesize) { &error_file_too_large; } $upload_dir = "$parent_dir$in{'filedirname'}"; if (opendir(DIR,"$upload_dir") != 1) { if (mkdir($upload_dir,0777) == 0) { &cannot_create_directory; } if ($serverOS =~ /^unix$/i) { `chmod 0777 $upload_dir`; } } $upload_dir = "$upload_dir/"; open(REAL,">$upload_dir$in{'destn_filename'}") || &error_open_file; if ($serverOS =~ /^nt$/i) { binmode(REAL); } print REAL $in{'sourcefile'}; close(REAL); if ($serverOS eq "unix") { `chmod 0777 $upload_dir$in{'destn_filename'}`; } &upload_ok; } sub listfilenames { &check_url_referer; if ($in{'pwd'} ne $superpwd) { &error_password; } if (!$in{'filedirname'}) { &error_no_upload_directory; } $list_dir = "$parent_dir$in{'filedirname'}"; if (opendir(DIR,"$list_dir") == 1) { @files = readdir(DIR); closedir(DIR); } else { &error_cannot_open_dir; } &set_content_type; print "Listing of Filenames

\n"; print "The following filenames are found in directory \"$in{'filedirname'}\":
\n"; $count = 0; foreach $fitem (@files) { $fitem_pathname = "$list_dir" . "/" . "$fitem"; if (-e $fitem_pathname) { if (-d $fitem_pathname) {next;} $count++; print " $fitem
\n"; } } if ($count == 0) { print " Sorry, nothing found!!
\n"; } print "

\n"; &listfilenames_ok; } sub return { print "Location: $ENV{'DOCUMENT_URI'}\n\n"; } sub check_url_referer { $referral_cnt = @valid; if ($referral_cnt > 0) { foreach $referer (@valid) { if ($ENV{'HTTP_REFERER'} =~ /$referer/i) { $good_ref = "yes"; last; } } if ($good_ref ne "yes") { &go_away; } } } sub error_password { &set_content_type; print "

ERROR: Invalid password"; print "

You didn't supply a valid password. Please check and enter again.

\n"; exit; } sub error_not_a_command { &set_content_type; print "ERROR: Not a valid command"; print "

You did not select a valid command. Please check and try again.

\n"; exit; } sub go_away { &set_content_type; print "ERROR: Unauthorised Access"; print "

Request denied. You are attempting to access our server using an unauthorized form.

\n"; exit; } sub cannot_create_directory { &set_content_type; print "ERROR: Cannot create the upload directory"; print "

Please check your input and try again. If the problem repeats, please contact your Webmaster.

\n"; print "

Back Home

\n"; exit; } sub error_invalid_directory_name { &set_content_type; print "ERROR: Invalid upload directory name"; print "

Please check your input and try again. Directory name must contain alphanumeric characters only.

\n"; print "

Back Home

\n"; exit; } sub set_content_type { if ($charset eq "") { print "content-type: text/html\n\n"; } else { print "content-type: text/html\; charset=$charset\n\n"; } } sub upload_ok { &set_content_type; print "

File Upload Completed"; print "

Back Home

\n"; exit; } sub listfilenames_ok { print "

Total files listed = $count

\n"; print "

Back Home

\n"; exit; } sub error_no_source_file { &set_content_type; print "ERROR: Source File Is Empty"; print "

You must select a source file to be uploaded. Please try again.

\n"; print "

Back Home

\n"; exit; } sub error_no_upload_directory { &set_content_type; print "ERROR: Upload directory name absent"; print "

You did not enter an upload directory name. Please try again. Directory name must contain alphanumeric characters only.

\n"; print "

Back Home

\n"; exit; } sub error_cannot_open_dir { &set_content_type; print "ERROR: Cannot open the directory"; print "

Please supply a valid directory name and try again.

\n"; print "

Back Home

\n"; exit; } sub error_file_too_large { &set_content_type; print "ERROR: Upload file too large."; print "

Size of your upload file exceeds $maxfilesize bytes. Please try again.

\n"; print "

Back Home

\n"; exit; } sub error_uploadfile { &set_content_type; print "ERROR: Upload file not specified or empty."; print "

You did not provide a file to be uploaded or it is empty. Please try again.

\n"; print "

Back Home

\n"; exit; } sub error_open_file { &set_content_type; print "ERROR: Destination upload file cannot be opened."; print "

Please contact Webmaster.

\n"; exit; } #End of uploader.cgi ####################################################################################################################################### #Below is the accompanying 'cgi-lib2.pl' script. ################################################# $cgi_lib'version = sprintf("%d.%02d", q$Revision: 2.17 $ =~ /(\d+)\.(\d+)/); # Parameters affecting cgi-lib behavior # User-configurable parameters affecting file upload. $cgi_lib'maxdata = '5000000'; # maximum bytes to accept via POST - 2^21 $cgi_lib'writefiles = '/home/virtual/site71/fst/var/www/html/uploads/mp3/';# directory to which to write files, or # 0 if files should not be written #What does this mean?Prefix of file? #I know what it is on a phone number,but...? #Could it be anything, for assignment purposes? $cgi_lib'filepre = "audio"; # Prefix of file names, in directory above # Do not change the following parameters unless you have special reasons $cgi_lib'bufsize = '8192'; # default buffer size when reading multipart $cgi_lib'maxbound = '100'; # maximum boundary length to be encounterd $cgi_lib'headerout = '0'; # indicates whether the header has been printed # ReadParse # Reads in GET or POST data, converts it to unescaped text, and puts # key/value pairs in %in, using "\0" to separate multiple selections # Returns >0 if there was input, 0 if there was no input # undef indicates some failure. # Now that cgi scripts can be put in the normal file space, it is useful # to combine both the form and the script in one place. If no parameters # are given (i.e., ReadParse returns FALSE), then a form could be output. # If a reference to a hash is given, then the data will be stored in that # hash, but the data from $in and @in will become inaccessable. # If a variable-glob (e.g., *cgi_input) is the first parameter to ReadParse, # information is stored there, rather than in $in, @in, and %in. # Second, third, and fourth parameters fill associative arrays analagous to # %in with data relevant to file uploads. # If no method is given, the script will process both command-line arguments # of the form: name=value and any text that is in $ENV{'QUERY_STRING'} # This is intended to aid debugging and may be changed in future releases sub ReadParse { local (*in) = shift if @_; # CGI input local (*incfn, # Client's filename (may not be provided) *inct, # Client's content-type (may not be provided) *insfn) = @_; # Server's filename (for spooled files) local ($len, $type, $meth, $errflag, $cmdflag, $perlwarn, $got, $name); # Disable warnings as this code deliberately uses local and environment # variables which are preset to undef (i.e., not explicitly initialized) $perlwarn = $^W; $^W = 0; binmode(STDIN); # we need these for DOS-based systems binmode(STDOUT); # and they shouldn't hurt anything else binmode(STDERR); # Get several useful env variables $type = $ENV{'CONTENT_TYPE'}; $len = $ENV{'CONTENT_LENGTH'}; $meth = $ENV{'REQUEST_METHOD'}; # if ($len > $cgi_lib'maxdata) { # cnctek # &CgiDie("cgi-lib2.pl: Request to receive too much data: $len bytes\n"); # cnctek # } # cnctek if (!defined $meth || $meth eq '' || $meth eq 'GET' || $meth eq 'HEAD' || $type eq 'application/x-www-form-urlencoded') { local ($key, $val, $i); # Read in text if (!defined $meth || $meth eq '') { $in = $ENV{'QUERY_STRING'}; $cmdflag = 1; # also use command-line options } elsif($meth eq 'GET' || $meth eq 'HEAD') { $in = $ENV{'QUERY_STRING'}; } elsif ($meth eq 'POST') { if (($got = read(STDIN, $in, $len) != $len)) {$errflag="Short Read: wanted $len, got $got\n";}; } else { &CgiDie("cgi-lib2.pl: Unknown request method: $meth\n"); } @in = split(/[&;]/,$in); push(@in, @ARGV) if $cmdflag; # add command-line parameters foreach $i (0 .. $#in) { # Convert plus to space $in[$i] =~ s/\+/ /g; # Split into key and value. ($key, $val) = split(/=/,$in[$i],2); # splits on the first =. # Convert %XX from hex numbers to alphanumeric $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; # Associate key and value $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator $in{$key} .= $val; } } elsif ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) { # for efficiency, compile multipart code only if needed $errflag = !(eval <<'END_MULTIPART'); local ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype, $blen); local ($bpos, $lpos, $left, $amt, $fn, $ser); local ($bufsize, $maxbound, $writefiles) = ($cgi_lib'bufsize, $cgi_lib'maxbound, $cgi_lib'writefiles); # The following lines exist solely to eliminate spurious warning messages $buf = ''; ($boundary) = $type =~ /boundary="([^"]+)"/; #"; # find boundary ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary; &CgiDie ("Boundary not provided: probably a bug in your server") unless $boundary; $boundary = "--" . $boundary; $blen = length ($boundary); if ($ENV{'REQUEST_METHOD'} ne 'POST') { &CgiDie("Invalid request method for multipart/form-data: $meth\n"); } if ($writefiles) { local($me); stat ($writefiles); $writefiles = "/tmp" unless -d _ && -w _; # ($me) = $0 =~ m#([^/]*)$#; $writefiles .= "/$cgi_lib'filepre"; } # read in the data and split into parts: # put headers in @in and data in %in # General algorithm: # There are two dividers: the border and the '\r\n\r\n' between # header and body. Iterate between searching for these # Retain a buffer of size(bufsize+maxbound); the latter part is # to ensure that dividers don't get lost by wrapping between two bufs # Look for a divider in the current batch. If not found, then # save all of bufsize, move the maxbound extra buffer to the front of # the buffer, and read in a new bufsize bytes. If a divider is found, # save everything up to the divider. Then empty the buffer of everything # up to the end of the divider. Refill buffer to bufsize+maxbound # Note slightly odd organization. Code before BODY: really goes with # code following HEAD:, but is put first to 'pre-fill' buffers. BODY: # is placed before HEAD: because we first need to discard any 'preface,' # which would be analagous to a body without a preceeding head. $left = $len; PART: # find each part of the multi-part while reading data while (1) { die $@ if $errflag; $amt = ($left > $bufsize+$maxbound-length($buf) ? $bufsize+$maxbound-length($buf): $left); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; $in{$name} .= "\0" if defined $in{$name}; $in{$name} .= $fn if $fn; $name=~/([-\w]+)/; # This allows $insfn{$name} to be untainted if (defined $1) { $insfn{$1} .= "\0" if defined $insfn{$1}; $insfn{$1} .= $fn if $fn; } BODY: while (($bpos = index($buf, $boundary)) == -1) { if ($left == 0 && $buf eq '') { foreach $value (values %insfn) { unlink(split("\0",$value)); } &CgiDie("cgi-lib2.pl: reached end of input while seeking boundary " . "of multipart. Format of CGI input is wrong.\n"); } die $@ if $errflag; if ($name) { # if no $name, then it's the prologue -- discard if ($fn) { print FILE substr($buf, 0, $bufsize); } else { $in{$name} .= substr($buf, 0, $bufsize); } } $buf = substr($buf, $bufsize); $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; } if (defined $name) { # if no $name, then it's the prologue -- discard if ($fn) { print FILE substr($buf, 0, $bpos-2); } else { $in {$name} .= substr($buf, 0, $bpos-2); } # kill last \r\n } close (FILE); last PART if substr($buf, $bpos + $blen, 2) eq "--"; substr($buf, 0, $bpos+$blen+2) = ''; $amt = ($left > $bufsize+$maxbound-length($buf) ? $bufsize+$maxbound-length($buf) : $left); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; undef $head; undef $fn; HEAD: while (($lpos = index($buf, "\r\n\r\n")) == -1) { if ($left == 0 && $buf eq '') { foreach $value (values %insfn) { unlink(split("\0",$value)); } &CgiDie("cgi-lib: reached end of input while seeking end of " . "headers. Format of CGI input is wrong.\n$buf"); } die $@ if $errflag; $head .= substr($buf, 0, $bufsize); $buf = substr($buf, $bufsize); $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; } $head .= substr($buf, 0, $lpos+2); push (@in, $head); @heads = split("\r\n", $head); ($cd) = grep (/^\s*Content-Disposition:/i, @heads); ($ct) = grep (/^\s*Content-Type:/i, @heads); ($name) = $cd =~ /\bname="([^"]+)"/i; #"; ($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name; ($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; # filename can be null-str ($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname; $incfn{$name} .= (defined $in{$name} ? "\0" : "") . (defined $fname ? $fname : ""); ($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i; #"; ($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defined $ctype; $inct{$name} .= (defined $in{$name} ? "\0" : "") . $ctype; if ($incfn{$name}) { # cnctek $source_filename = $incfn{$name}; # cnctek $source_filename =~ s/[:\\]/\//g; # cnctek $source_filename =~ s/.*\///g; # cnctek } # cnctek if ($writefiles && defined $fname) { $ser++; $fn = $writefiles . ".$$.$ser"; open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n"); binmode (FILE); # write files accurately } substr($buf, 0, $lpos+4) = ''; undef $fname; undef $ctype; } 1; END_MULTIPART if ($errflag) { local ($errmsg, $value); $errmsg = $@ || $errflag; foreach $value (values %insfn) { unlink(split("\0",$value)); } &CgiDie($errmsg); } else { if (!$in{'destn_filename'} || $in{'destn_filename'} =~ /^[ ]+$/) { # cnctek if ($source_filename) { # cnctek $in{'destn_filename'} = $source_filename; # cnctek } # cnctek } # cnctek # everything's ok. } } else { &CgiDie("cgi-lib2.pl: Unknown Content-type: $ENV{'CONTENT_TYPE'}\n"); } # no-ops to avoid warnings $insfn = $insfn; $incfn = $incfn; $inct = $inct; $^W = $perlwarn; return ($errflag ? undef : scalar(@in)); } # PrintHeader # Returns the magic line which tells WWW that we're an HTML document sub PrintHeader { return "Content-type: text/html\n\n"; }