#!/usr/bin/perl use CGI::Carp qw(fatalsToBrowser); # # Software download script # # Copyright Wojciech Golab, December 2003 # (wgolab@uwaterloo.ca), # ##### require 'cgi-lib.pl'; ##### included inline because I can't get inclusion to work properly ##### trg, 2006-2-2 #!/usr/bin/perl # Perl Routines to Manipulate CGI input # # Copyright (c) 1995 Steven E. Brenner # Permission granted to use and modify this library so long as the # copyright above is maintained, modifications are documented, and # credit is given for any use of the library. # # Thanks are due to many people for reporting bugs and suggestions # especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen, # Andrew Dalke, Mark-Jason Dominus, Dave Dittrich, Jason Mathews # # For more information, see: # http://cgi-lib.berkeley.edu/ # # Minimalist http form and script (http://www.bio.cam.ac.uk/web/minimal.cgi): # # require "cgi-lib.pl"; # if (&ReadParse(*input)) { # print &PrintHeader, &PrintVariables(%input); # } else { # print &PrintHeader,'
Data: '; #} # ReadParse # Reads in GET or POST data, converts it to unescaped text, # creates key/value pairs in %in, using '\0' to separate multiple # selections # Returns TRUE if there was input, FALSE if there was no input # UNDEF may be used in the future to indicate 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 variable-glob parameter (e.g., *cgi_input) is passed to ReadParse, # information is stored there, rather than in $in, @in, and %in. sub ReadParse { local (*in) = @_ if @_; local ($i, $key, $val); # Read in text if (&MethGet) { $in = $ENV{'QUERY_STRING'}; } elsif (&MethPost) { read(STDIN,$in,$ENV{'CONTENT_LENGTH'}); } @in = split(/[&;]/,$in); foreach $i (0 .. $#in) { # Convert plus's to spaces $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/%(..)/pack("c",hex($1))/ge; $val =~ s/%(..)/pack("c",hex($1))/ge; # Associate key and value $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator $in{$key} .= $val; } return 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"; } # HtmlTop # Returns the of a document and the beginning of the body # with the title and a body

header as specified by the parameter sub HtmlTop { local ($title) = @_; return < $title

$title

END_OF_TEXT } # Html Bot # Returns the , codes for the bottom of every HTML page sub HtmlBot { return "\n\n"; } # MethGet # Return true if this cgi call was using the GET request, false otherwise sub MethGet { return ($ENV{'REQUEST_METHOD'} eq "GET"); } # MethPost # Return true if this cgi call was using the POST request, false otherwise sub MethPost { } # MyURL # Returns a URL to the script sub MyURL { local ($port); $port = ":" . $ENV{'SERVER_PORT'} if $ENV{'SERVER_PORT'} != 80; return 'http://' . $ENV{'SERVER_NAME'} . $port . $ENV{'SCRIPT_NAME'}; } # CgiError # Prints out an error message which which containes appropriate headers, # markup, etcetera. # Parameters: # If no parameters, gives a generic error message # Otherwise, the first parameter will be the title and the rest will # be given as different paragraphs of the body sub CgiError { local (@msg) = @_; local ($i,$name); if (!@msg) { $name = &MyURL; @msg = ("Error: script $name encountered fatal error"); }; print &PrintHeader; print "$msg[0]\n"; print "

$msg[0]

\n"; foreach $i (1 .. $#msg) { print "

$msg[$i]

\n"; } print "\n"; } # Identical to CgiError, but also quits with the passed error message. sub CgiDie { local (@msg) = @_; &CgiError (@msg); die @msg; } # PrintVariables # Nicely formats variables in an associative array passed as a parameter # And returns the HTML string. sub PrintVariables { local (%in) = @_; local ($old, $out, $output); $old = $*; $* =1; $output .= "\n
\n"; foreach $key (sort keys(%in)) { foreach (split("\0", $in{$key})) { ($out = $_) =~ s/\n/
\n/g; $output .= "
$key\n
$out
\n"; } } $output .= "
\n"; $* = $old; return $output; } # PrintVariablesShort # Now obsolete; just calls PrintVariables sub PrintVariablesShort { return &PrintVariables(@_); } ##### ##### end on inclusion ##### # # Customizable global parameters # # # name of program used to send email messages # $mailprog = '/usr/bin/mail'; # # e-mail address to which customer information is sent # $recipient = 'drallen@uwaterloo.ca'; # # folder where temporary download session IDs are stored, must end with path separator # $downloadIDdir = '/tmp/'; # # number of seconds for which a download session ID is valid after customer submits information # $dowloadIDlife = 43200; # # name of file to serve in final download screen, must be readable to the user ID under which this # script runs, should be obscure so that customer can't guess it an download the file directly # without filling out the information form and accepting the license agreement # $fileToServe = 'jssesamples.zip'; # # type of content in $fileToServe # $contentTypeToServe = 'application/zip'; # # file name to report to the client, should be meaningful # $contentFileNameToReport = 'file.zip'; # Mainline MAIN: { # Read in all the variables set by the form ReadParse(*input); # first check if all info has been submitted and customer is ready to download if ($input{'next'} eq 'servefile') { ServeFile(); exit; } # customer not ready to download, make him fill in personal information # Print the header print PrintHeader(); print < Download ENDOFTEXT ##### foreach $key (keys %input ) {print "$input($key)\n" } if (!exists $input{'next'}) { PrintLicenseForm(); } elsif ($input{'next'} eq 'infoform') { if ($input{'submit'} eq 'Accept') { print "Please enter the following information:\n"; PrintInfoForm(); } else { print "You are not permitted to download or use the software.\n"; } } elsif ($input{'next'} eq 'infoformvalidate') { if ($err = ProcessInfoForm()) { print ""; print $err; print ""; PrintInfoForm(); } else { PrintThankYouForm(); #PrintDownloadForm(); } } print < ENDOFTEXT } # # Called after the form with customer information is submitted, ensures that the # form was completely filled out, if not then return error message, if so then # submits information by email to the email address stored in global var $recipient # sub ProcessInfoForm { # # some regexps to be used while validating form data # $nonemptyalphanum_filter = '^.*[\w\d]+.*$'; $email_filter = '^[\d\w\.\-]+\@[\d\w\.\-]+$'; # # now validate the submitted form data # if ($input{'firstname'} !~ /$nonemptyalphanum_filter/) { return 'Please enter a valid first name'; } if ($input{'lastname'} !~ /$nonemptyalphanum_filter/) { return 'Please enter a valid last name'; } if ($input{'company'} !~ /$nonemptyalphanum_filter/) { return 'Please enter a valid company or institution name'; } if ($input{'department'} !~ /$nonemptyalphanum_filter/) { return 'Please enter a valid department name'; } if ($input{'phone'} !~ /$nonemptyalphanum_filter/) { return 'Please enter a valid phone number'; } if ($input{'email'} !~ /$email_filter/) { return 'Please enter a valid email address'; } if ($input{'address'} !~ /$nonemptyalphanum_filter/) { return 'Please enter a valid street address'; } if ($input{'city'} !~ /$nonemptyalphanum_filter/) { return 'Please enter a valid city'; } if ($input{'provincestate'} !~ /$nonemptyalphanum_filter/) { return 'Please enter a valid province or state'; } if ($input{'postalzip'} !~ /$nonemptyalphanum_filter/) { return 'Please enter a valid postal or zip code'; } if ($input{'country'} !~ /$nonemptyalphanum_filter/) { return 'Please enter a valid country name'; } if ($input{'targetnet'} !~ /$nonemptyalphanum_filter/) { return 'Please enter a valid target network name'; } # # everything is peachy, so email the info to $recipient # open MAIL, "|$mailprog $recipient\n"; print MAIL "Subject: UCLP software download\n"; print MAIL "\n"; print MAIL "First name: $input{'firstname'}\n"; print MAIL "Last name: $input{'lastname'}\n"; print MAIL "Company or institution: $input{'company'}\n"; print MAIL "Department: $input{'department'}\n"; print MAIL "Telephone: $input{'phone'}\n"; print MAIL "E-mail address: $input{'email'}\n"; print MAIL "Street address: $input{'address'}\n"; print MAIL "City: $input{'city'}\n"; print MAIL "Province/state: $input{'provincestate'}\n"; print MAIL "Postal/zip code: $input{'postalzip'}\n"; print MAIL "Country: $input{'country'}\n"; print MAIL "Target network: $input{'targetnet'}\n"; print MAIL "Time: " . localtime() . "\n"; print MAIL "Remote IP address: $ENV{'REMOTE_ADDR'}\n"; close MAIL; return; } # # Prints the form that collects information from the customer # sub PrintInfoForm { # replaces " with "e; in each submitted value foreach $key (keys %input) { $value = $input{$key}; $value =~ s/"/"/; $input{$key} = $value; } print "

\n"; print "\n"; print "
\n"; print "First name
\n"; print "
\n"; print "Last name
\n"; print "
\n"; print "Company/Institution
\n"; print "
\n"; print "Department
\n"; print "
\n"; print "Telephone number
\n"; print "
\n"; print "E-mail address
\n"; print "
\n"; print "Street address
\n"; print "
\n"; print "City
\n"; print "
\n"; print "Province/state
\n"; print "
\n"; print "Postal/zip code
\n"; print "
\n"; print "Country
\n"; print "
\n"; print "Target network
\n"; print "

\n"; print "\n"; print ""; } # # Prints the form that is used to download the software # sub PrintDownloadForm { srand; $downloadID = int(rand(999999999)); RememberDownloadID($downloadID); print "Thank you for filling out our customer information form.

\n"; print "
\n"; print "
\n"; print "
\n"; print "\n"; print "
"; } # # Saves a download session ID # sub RememberDownloadID { my ($downloadID) = @_; $file = MapDownloadIDtoFileName($downloadID); open(IDFILE, "> " . $downloadIDdir . "downloadID_" . $downloadID); close(IDFILE); CleanUpOldDownloadIDs(); } # # Determines whether a download session ID still exists # sub ExistsDownloadID { my ($downloadID) = @_; CleanUpOldDownloadIDs(); return -e MapDownloadIDtoFileName($downloadID); } # # Returns the file name corresponding to a download session ID # sub MapDownloadIDtoFileName { my ($downloadID) = @_; return $downloadIDdir . "downloadID_" . $downloadID; } # # Invalidates expired download session IDs # sub CleanUpOldDownloadIDs { opendir(DIR, $downloadIDdir); while (defined($file = readdir(DIR))) { next if ($file !~ /^downloadID_.*/); $fullFileName = $downloadIDdir . $file; ($modifiedTime) = (stat($fullFileName))[9]; $age = time() - $modifiedTime; if ($age > $dowloadIDlife) { unlink($fullFileName); } } closedir(DIR); } # # Serves the file to the client # sub ServeFile { $downloadID = $input{'downloadID'}; if (!ExistsDownloadID($downloadID)) { print PrintHeader(); $referer = $ENV{'REFERER'}; print "Please fill in the customer information form first.
\n"; return; } print "Content-type: $contentTypeToServe\n"; print "Content-disposition: filename=$contentFileNameToReport\n"; ($fileSize) = (stat($fileToServe))[7]; print "Content length: $fileSize\n"; print "\n"; open(FILE, "< $fileToServe"); binmode(FILE); binmode(STDOUT); while (read (FILE, $buffer, 65536) and print STDOUT $buffer) {}; close(FILE); } # # Prints out the license agreement and displays a form where the user can accept or reject # sub PrintLicenseForm { print "Please carefully read through the following license agreement:

\n"; print "
\n";
		
	open(FILE, "< /u/uclp-web/public_html/uclp-cgi/license.txt") 
            or die "cannot open licence file";
	print ();
	close(FILE);
	print "
\n"; print "

\n"; print "
\n"; print "
\n"; print "\n"; print "\n"; print "
"; } # # Prints out confirmation message after downloading the software # sub PrintThankYouForm { print "Thank you for filling in the information form. Download instructions will be sent to you by email when the request is processed"; }