#!/usr/local/bin/perl # # printform -- web input to a printable form # # Generic CGI script to accept form input from a user and return a page # which she can print from her web browser. # # A bit of a hack, really, but provided upon request. # # Usage: printform # # Special CGI fields: # # outform* Output format. This can be a single CGI field called # "outform" or, in order to specify an output format which # is longer than the 1024-character length limit for CGI # fields, it can be a series of fields whose names begin # with "outform" (e.g., "outform1", "outform2", "outform3", # etc.). If a series of "outform*" fields is specified, # they will be concatenated in their alphanumerically # sorted order to produce the actual output format. Each # "outform*" CGI variable must be less than 1024 characters # long. # # Additional CGI fields may be user-defined. # # The outform fields may contain the names of CGI fields in the syntax # "$fieldname". Simple variable substitution will be applied to the # outform fields before they are used. If no outform is specified, CGI # fields variables will be listed in a simple table format. # #----------------------------------------------------------------------------- # History: # 1996.08.30 PASR Original version by Prentiss Riddle (riddle@rice.edu) # based on "yamform", which in turn was based on "mailform" # by M-J. Dominus (mjd@saul.cis.upenn.edu). See # "http://www.cis.upenn.edu:80/~mjd/mailform/mailform.html". # # 1996.09.07 PASR Made varsub require variables to begin with alpha # (to prevent clobbering dollar amounts in forms). #----------------------------------------------------------------------------- # CONFIGURATION: # # Set these variables according to local needs. # # Logging: if $logfile is non-null, printform will attempt to log to the # named file. # $logfile = ""; # $logfile = "/var/log/printform"; $logfile = "/var/log/printform"; # #----------------------------------------------------------------------------- require "getopts.pl"; require "cgi-lib.pl"; $bindate = "/bin/date"; @weekdays = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday'); chop($date = `$bindate -u '+%d-%h-%y %T GMT'`); $date = $weekdays[`$bindate -u +%w`] . ', ' . $date; $yyyy = `$bindate -u '+%y'`; if ($yyyy < 70) { $yyyy += 2000; } else { $yyyy += 1900; } chop($logdate = `$bindate -u "+%d/%h/$yyyy:%T +0000"`); chop($nicedate = `$bindate`); if ($ENV{'HTTP_REFERER'}) { $referrer = " $ENV{'HTTP_REFERER'}"; } elsif ($ENV{'REFERER_URL'}) { $referrer = "$ENV{'REFERER_URL'}"; } else { $referrer = ""; } # Do logging. if ($logfile) { &log_entry($logfile, $date, "($referrer)"); } # Parse CGI input. &ReadParse; foreach $k (sort (keys %in)) { # Guard against redundantly named fields -- they're delimited by # nulls, which give HTTP and SMTP indigestion. Change 'em to commas. $in{$k} =~ s/\x00/,/g; } # Build output format from fragments if necessary. $outform = ""; $outformnewline = 0; foreach $outformname ( sort(grep(/^outform/, keys(%in))) ) { $outformval = $in{$outformname}; $outformnames .= "$outformname "; if (length($outformval) <= 1) { $outformshort .= "$outformname "; } if (length($outformval) > 1024) { $outformlong .= "$outformname "; } if ($outformval =~ /\n./) { $outformnewline = 1; } $outform .= "$outformval\n"; } chop($outformlong) if ($outformlong); chop($outformshort) if ($outformshort); if ($outform) { # Perform variable substitution. $outform = &varsub($outform); } # Initiate HTTP reply. print < Print this page from your browser EOM # Report contents of form. if ($outform) { # User-supplied output format. print "\n$outform\n"; } else { # Simple table format. print "\n"; foreach $k (sort (keys %in)) { print "\n"; } print "

$in{$k}

\n"; } print "\n

$referrer $nicedate (printform)\n"; print "\n"; exit 0; #------------------------------------------------------------------------- sub log_entry { local($logfile, $date, $referrer) = @_; unless (open(LOG, ">> $logfile")) { print <500 Server Error

500 Server Error

Unable to open printform log file \"$logfile\" due to error message \`\`$!\'\'.

Please contact the server administrator, webmaster\@$ENV{'SERVER_NAME'}, and inform them of the time the error occured, the URL of the form, and anything else you can think of that might be relevant. Thank you.

webmaster\@$ENV{'SERVER_NAME'}

EOM exit 1; } # Log it. The format: # clienthost - - DD/Mon/YYYY:hh:mm:ss +0000 "destaddress[(referrerURL)]" 0 0 # This tips its hat at the standard HTTP log file format, but # unfortunately isn't quite there: we pack the referrerURL in # with the target address and we don't handle the status or bytes # properly. See "http://hoohoo.ncsa.uiuc.edu/docs/Upgrade.html". print LOG "$ENV{'REMOTE_HOST'} - - $logdate \"$destaddr$referrer\" 0 0\n"; close LOG; } #------------------------------------------------------------------------- sub print_ackpage { local($date, $from, $outform, $outformlong, $outformnewline, $referrer) = @_; print <Thank you!

Form submitted

The contents of your form have been mailed to "$destaddr". EOM if ($from) { print "A copy will be sent to your address $from.\n"; } if ($badfrom) { print "

WARNING: The return address\n"; print "you entered ($badfrom) contained characters\n"; print "which should not be found in an e-mail address.\n"; print "You will not receive a copy.\n"; } elsif ($shortfrom) { print "

WARNING: The return address\n"; print "you entered ($shortfrom) was incomplete.\n"; print "Delivery will be attempted to $from.\n" if ($from); print "You may not receive a copy.\n"; print "Next time, please use a full address like "; print "userid\@host.domain."; } if ($outformlong) { print "

WARNING: The form you filled out\n"; print "$referrer\n" if ($referrer); print "contained a field or fields which were 1024\n"; print "characters long or longer ($outformlong).\n"; print "This means that the information you entered in the\n"; print "form may have been truncated.\n"; print "If you see problems with the report below, please\n"; print "report them to $destaddr.\n"; } if (($outform ne "") & ! $outformnewline) { print "

WARNING: The form you filled out\n"; print "$referrer\n" if ($referrer); print "appears to be missing newline characters.\n"; print "It may have been garbled by your WWW browser"; print " ($ENV{'HTTP_USER_AGENT'})\n" if ($ENV{'HTTP_USER_AGENT'}); print ".\n"; print "If you see problems with the report below, please\n"; print "report them to $destaddr\n"; print "or try again with a different browser\n"; print "(e.g., Netscape, lynx, or Unix Mosaic).\n"; } if ($outform) { print "

Subject: $subject\n\n";
		# Escape ampersand entities.  This isn't perfect -- something
		# mysterious is doing some escaping for us -- but we can live
		# with it.
		$outform =~ s//>/g;
		$outform =~ s/&/&/g;
		print "$outform

\n"; } } #------------------------------------------------------------------------- # varsub: perform variable substitution on a string using the %in and %ENV # arrays. # # This is somewhat simple-minded: we don't handle a number of syntactic # problems (such as a variable which is immediately followed by alpha text). # # Global variables used: %in %ENV # sub varsub { local($str) = @_; $str =~ s/\\\$/DoLlAr/g; $str =~ s/\$([a-zA-Z][\w-]*)/$in{$1}/g; $str =~ s/DoLlAr/\$/g; return($str); } #------------------------------------------------------------------------- # end of printform script