#!/usr/local/bin/perl
#
# yamform -- yet another CGI mail form handler
#
# Generic back-end program to accept a submission from a CGI form and 
# deliver the results by mail.  Yamform differs from other similar
# CGI programs because it allows the form designer to control the
# appearance of the output format.
#
# Usage: yamform [ -u ] address [address...]
#
# -u means undecoded: Just deliver CGI string; don't decode into
#    name/value pairs.  Also display environment.  This overrides the
#    "outform" field.
#
# Address is the e-mail address to which results will be mailed.
#
# 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.
#
#   from      E-mail address of user submitting form.
#   subject   E-mail subject line.
#   cc        E-mail address of person to get carbon copy.
#
#   pwfile    Password file for optional password authentication.
#   uname     Username for password authentication.
#   passwd    Password or PIN for password authentication.
#   nextpage  URL of an acknowledgment page to use instead of the default.
#
# The outform and subject fields may contain the names of CGI fields in
# the syntax "$fieldname".  Simple variable substitution will be
# applied to the outform and subject fields before they are used.  If
# no outform is specified, CGI fields and environment variables will be
# listed in a simple "name=value" format.  If no subject is specified,
# a generic subject line will be created.  If ackurl is not defined, a 
# generic acknowledgement page will be generated.
# 
# A NOTE ABOUT PASSWORD AUTHENTICATION: if a hidden "pwfile" field is
# supplied yamform will expect to see "uname" and "passwd" fields as well
# and will attempt to look up a matching entry in the file named in
# "pwfile".  The named file is expected on the local host in htpasswd
# format.  If no match is found, the user will receive a warning and no
# mail will be sent.  Designers of web forms that use this feature must
# understand that it is a weak form of authentication and must especially
# be on the lookout for mail forged to appear to come from yamform!

#-----------------------------------------------------------------------------
# History:
# 2/6/95  PASR  Original version by Prentiss Riddle (riddle@rice.edu).
#               Based on "mailform" by M-J. Dominus (mjd@saul.cis.upenn.edu).
#               See "http://www.cis.upenn.edu:80/~mjd/mailform/mailform.html".
# 1995.08.30 PASR  Added "@" check in e-mail addresses and $maildomain.
# 1995.10.12 PASR  Generate true "From" lines, not "Supposedly-from".
# 1995.11.09 PASR  Eliminated &protect call for nextpage-URL.
# 1996.01.18 PASR  Enabled multiple mail destinations.
# 1996.07.30 PASR  Added ampersand escapes on feedback page.
# 1996.08.12 PASR  Changes to be compatible with perl5.
# 1996.11.19 PASR  Added $refdomain, to (optionally) refuse forms from
#                  off-campus referrer pages.
# 1997.02.25 PASR  Accept \r interchangeably with \n for in outforms for
#                  compatibility with MSIE 3.01 and above.  (MSIE 3.0 and 
#                  below still appear to return neither \r nor \n, for no 
#                  good reason that I can see.)
# 1997.03.24 PASR  Allow underscore (_) in e-mail addresses.
#                  Escape @ in [] character selection.
# 1997.04.28 PASR  Change CRLF to LF ("\r\n" to "\n") in outform, to
#                  better handle forms badly uploaded from Windows boxes.
# 1997.08.14 PASR  In "anonymous" cases, set Reply-To header to destination
#                  address to keep misguided replies from going to $sender.
# 1997.09.10 PASR  Made date RFC822-compliant.
#                  Reject incomplete return addresses, with warning screen.
# 1998.04.15 PASR  Reject submissions without outform or subject.  For
#                  some reason we were seeing a few invocations of yamform
#                  that appeared not to come from a proper form, possibly
#                  due to a poorly behaved agent or robot.  This should
#                  cut down on them.  (See incidents 69.1505 & 69.1465)
# 1998.06.26 PASR  Added support for "cc" field.
# 1998.08.25 PASR  Added passwd authentication (&pwcheck etc.).
# 1998.08.26 PASR  Removed non-parsed headers from error routines to
#                  avoid peculiar problems with apacheSSL.  See
#                  Gunadavaram ch. 3 "Complete (non-parsed) headers".
# 1998.09.08 PASR  Uncommented "exit 1" after call to print_bad_passwd().
# 1999.03.26 PASR  Fixed a quirk in the escaping of ampersand entities
#                  in the acknowledgement page.
# 1999.04.30 PASR  Moved nextpage from command line to hidden CGI variable.

#-----------------------------------------------------------------------------
# CONFIGURATION:
#
# Set these variables according to local needs.
#
# Generic return address: the address which should be used for the
# "Sender:" line in e-mail.  Examples:
#   $sender = "nobody\@foo.com";
#   $sender = "webmaster\@bar.edu";
$sender = "";
#
# Administrative address: the address which should receive reports of abuse
# of this service.  Examples:
#   $admin = "root\@foo.com";
#   $admin = "webmaster\@bar.edu";
$admin = "";
#
# Logging: if $logfile is non-null, yamform will attempt to log to the 
# named file.
#   $logfile = "";
#   $logfile = "/var/log/yamform";
$logfile = "";
#
# Debug BCC: if $debugbcc is non-null, yamform will send a blind carbon
# copy to the named address.  Note that this may or may not violate
# policies regarding e-mail confidentiality at your site and should
# probably be used only for initial testing purposes.  Examples:
#   $debugbcc = "";
#   $debugbcc = "webmaster@bar.edu";
$debugbcc = "";
#
# Mail domain: When a user enters an incomplete e-mail address in a $from
# field (i.e., one containing neither "@" nor "%"), yamform will make a
# guess at a complete address.  First choice is the REMOTE_HOST environment
# variable, if available; second choice is the $maildomain variable.  Set
# $maildomain to your local mail domain.  Example:
#   $maildomain = "foo.edu";
$maildomain = "";
#
# Referrer domain: if $refdomain is non-null, then refuse forms submitted
# from domains that do not match the specified domain.  Note that this
# feature depends on the HTTP_REFERER CGI variable, which may not always
# be set; when in doubt we err in the direction of permissiveness.
#$refdomain = "\.foo\.edu";
$refdomain = "";
#-----------------------------------------------------------------------------

# This convoluted way of getting a four-digit year is necessary because
# not all implementations of date support the %Y spec.  (Pity we have to
# use GMT, but we can't count on ready access to timezone info.)
$bindate = "/bin/date";
$yyyy = `$bindate -u '+%y'`;
if ($yyyy < 70) {
	$yyyy += 2000;
} else {
	$yyyy += 1900;
}
chop($date = `$bindate -u "+%a, %d %h $yyyy %T +0000 (GMT)"`);
chop($logdate = `$bindate -u "+%d/%h/$yyyy:%T +0000"`);

require "getopts.pl";
require "cgi-lib.pl";

@crud = @ARGV;                  # DEBUG
&Getopts("un:");

$undecoded = defined($opt_u);
#$nextpage_url = $opt_n;

if (! defined($ARGV[0])) {
	# No destination address supplied
	&print_no_dest_message($date);
	exit 1;
}
$destaddr=join(" ",@ARGV);
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);
}

# Check for unathorized off-campus forms.
if ($refdomain && $referrer && ($referrer !~ m#http://[^/:]*$refdomain#i)) {
	# Gripe about the yamform pirates.
	&print_bad_ref_message($destaddr, $date, $referrer);
	exit 1;
}

# Make sure no metacharacters in destination address.
if ($destaddr =~ /[^\w\s,\.%:\@-]/) {
	# Refuse to send mail.
	&print_bad_dest_message($destaddr, $date);
	exit 1;
}

# 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;
}

# Process special CGI variables.
if ($subject = $in{'subject'}) {
	$subject = &varsub($subject);
} else {
	$subject = "WWW form from $ENV{'REMOTE_HOST'}";
	$nosubject = 1;
}
if ($from = $in{'from'}) {
	# Do sanity check on return address.
	if ($from !~ /[\@%]/ || $from =~ /[^A-Za-z0-9.%:\@_-]/) {
		# Found incomplete return address or nasty metacharacters. :-(
		&print_bad_from_message($destaddr, $date, $from);
		exit 1;
	}
}
if ($cc = $in{'cc'}) {
	# Do sanity check on CC address.
	if ($cc !~ /[\@%]/ || $cc =~ /[^A-Za-z0-9.%:\@_-]/) {
		# Found incomplete CC address or nasty metacharacters. :-(
		&print_bad_cc($destaddr, $date, $cc);
		exit 1;
	}
}
$uname = $in{'uname'};
$passwd = $in{'passwd'};
$pwfile = $in{'pwfile'};
if ($uname || $passwd || $pwfile) {
	unless (&pwcheck($uname, $passwd, $pwfile)) {
		&print_bad_passwd($date);
		exit 1;
	}
}
unless ($sender) {
	$sender = "webmaster\@$ENV{'SERVER_NAME'}";
}
# 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 ";
	}
	$outformval =~ s/\r\n/\n/g;		# Fix DOS/Windows-ism
	$outformval =~ tr/\r/\n/;
	if ($outformval =~ /\n./) {
		$outformnewline = 1;
	}
	$outform .= "$outformval\n";
}
chop($outformlong) if ($outformlong);
chop($outformshort) if ($outformshort);
if ($outform) {
	# Perform variable substitution.
	$outform = &varsub($outform);
}

if (!$outform && $nosubject) {
	# We appear not to be operating in the context of a web form. :-(
	&print_no_form_message($date);
	exit 1;
}

# Try to open mail.
unless (open (MAIL, "| /usr/lib/sendmail -t $destaddr")) {
	# Couldn't send mail.
	&print_mail_error_message($destaddr, $date, $!);
	exit 1;
}

# Build mail header.
print MAIL "Date: $date\n";
print MAIL "To: $destaddr\n";
print MAIL "Subject: $subject\n";
if ($from) {
	print MAIL "From: $from (unverified)\n";
	print MAIL "Reply-To: $from\n";
	print MAIL "Cc: $from,$cc\n";
} else {
	print MAIL "From: $sender (anonymous)\n";
	print MAIL "Reply-To: $destaddr\n";
	print MAIL "Cc: $cc\n";
}
print MAIL "Sender: $sender\n";
if ($debugbcc) {
	print MAIL "Bcc: $debugbcc\n";
}
print MAIL "X-Report-Abuse-To: $admin\n" if ($admin);
print MAIL "X-Posting-Host: $ENV{'REMOTE_HOST'}\n";
print MAIL "X-HTTP-Referer: $ENV{'HTTP_REFERER'}\n" if ($ENV{'HTTP_REFERER'});
print MAIL "X-Referer-URL: $ENV{'REFERER_URL'}\n" if ($ENV{'REFERER_URL'});
print MAIL "X-Remote-User: $ENV{'REMOTE_USER'}\n" if ($ENV{'REMOTE_USER'});
print MAIL "X-HTTP-User-Agent: $ENV{'HTTP_USER_AGENT'}\n" if ($ENV{'HTTP_USER_AGENT'});
print MAIL "X-Yamform-Warning: Form contains field(s) over 1023 chars: $outformlong\n" if ($outformlong);
print MAIL "X-Yamform-Warning: Form contains no newlines -- may be garbled by client\n" if (($outform ne "")  & ! $outformnewline);
if ($pwfile) {
	print MAIL "X-Yamform-Authentication-File: $pwfile\n";
	print MAIL "X-Yamform-Authentication-User: $uname\n";
}

# Report contents of form.
unless ($undecoded) {
	if ($outform) {
		# User-supplied output format.
		print MAIL "\n$outform\n";
	} else {
		# Name=value pairs.
		foreach $k (sort (keys %in)) {
			local($v) = $in{$k};
			$v =~ s/\x00/,/g;
			print MAIL "$k=$v\n";
		}
		print MAIL "\nEnvironment:\n";
		for $k (sort keys %ENV) {
			print MAIL "$k=$ENV{$k}\n";
		}
	}
} else {
	# Dump of undecoded CGI input.
	print MAIL "\n\n$in\n";
	print MAIL "\nEnvironment:\n";
	for $k (sort keys %ENV) {
		print MAIL "$k=$ENV{$k}\n";
	}
}

# Send the mail.
close MAIL;

# Success; display new URL.
if ($nextpage = $in{'nextpage'}) {
	$nextpage =~ tr:\\::d;
	# Protection here seems to make a garbled relative URL. Huh? -- PASR
	#$nextpage = &protect($nextpage);
	&print_redirection_message($nextpage);
	exit 0;
} else {
	&print_ackpage($date, $from, $outform, $outformlong, $outformnewline, $referrer);
	exit 0;
}
#-------------------------------------------------------------------------
sub log_entry {
	local($logfile, $date, $referrer) = @_;

	unless (open(LOG, ">> $logfile")) {
		print <<EOM;
$ENV{'SERVER_PROTOCOL'} 500 Server Error
Date: $date
Server: $ENV{'SERVER_SOFTWARE'}
MIME-version: 1.0
Content-type: text/html

<HEAD><TITLE>500 Server Error: Unable to open yamform log</TITLE></HEAD>
<BODY BGCOLOR="#ffffff">
<H1>Server Error: Unable to open yamform log</H1>

Unable to open yamform log file <tt>\"$logfile\"</tt>
due to error message \`\`$!\'\'.<p>

Please contact the server administrator,
<tt>webmaster\@$ENV{'SERVER_NAME'}</tt>, 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.<P>

<address>webmaster\@$ENV{'SERVER_NAME'}</address>

</BODY>
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 ord {
	$numval = unpack("C",$_[0]);
	@hexdigits = ('0' .. '9', 'A' .. 'F');
	($highnib, $lownib) = (($numval & 0xf0) >> 4, $numval & 0x0f);
	@chars=@hexdigits[$highnib, $lownib];
	return $chars[0] . $chars[1];
}
#-------------------------------------------------------------------------
sub protect {
	local($i) = @_;
	local($o) = '';

	while ($i) {
		($p, $i) = ($i =~ /^(.)(.*)$/);
		if ($p =~ /[A-Za-z0-9.\/-]/) {
			$o .= $p;
		} else {
			$o .= '%' . &ord($p);
		}
	}
	return $o;
}
#-------------------------------------------------------------------------
sub print_ackpage {
	local($date, $from, $outform, $outformlong, $outformnewline, $referrer) = @_;

	print <<EOM;
Content-type: text/html

<HEAD><title>Thank you!</title></HEAD>
<BODY BGCOLOR="#ffffff">
<h1>Form submitted</h1>

The contents of your form have been mailed to "<tt>$destaddr</tt>".

EOM
	if ($from || $cc ) {
		print "Copies will be sent to the address(es):";
		print " <tt>$from</tt>" if ($from);
		print " <tt>$cc</tt>" if ($cc);
		print "\n";
	}
	if ($badfrom) {
		print "<p><strong>WARNING</strong>: The return address\n";
		print "you entered (<tt>$badfrom</tt>) 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 "<p><strong>WARNING</strong>: The return address\n";
		print "you entered (<tt>$shortfrom</tt>) was incomplete.\n";
		print "Delivery will be attempted to <tt>$from</tt>.\n"
			if ($from);
		print "You may not receive a copy.\n";
		print "Next time, please use a full address like ";
		print "<tt>userid\@host.domain</tt>.";
	}
	if ($outformlong) {
		print "<p><strong>WARNING</strong>: 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 (<tt>$outformlong</tt>).\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 <tt>$destaddr</tt>.\n";
	}
	if (($outform ne "") & ! $outformnewline) {
		print "<p><strong>WARNING</strong>: 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 <tt>$destaddr</tt>\n";
		print "or try again with a different browser\n";
		print "(e.g., Netscape Navigator, lynx, or Microsoft\n";
		print "Internet Explorer v. 3.01 or higher).\n";
	}
	if ($outform) {
		print "<hr><pre>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/&/&amp;/gi;
		$outform =~ s/</&lt;/gi;
		$outform =~ s/>/&gt;/gi;
		print "$outform</pre><hr>\n";
	}
}
#-------------------------------------------------------------------------
sub print_bad_cc_message {
	local($destaddr, $date, $cc) = @_;

	print <<EOM;
Content-type: text/html

<HEAD><TITLE>500 Server Error: Bad CC address</TITLE></HEAD>
<BODY BGCOLOR="#ffffff">
<H1>Server Error: Bad CC address</H1>

Sorry, but you entered a Carbon Copy e-mail address ("<tt>$cc</tt>") which
was incomplete or contained illegal characters.
<p>
You must either omit a CC e-mail address entirely or enter a complete
address in the form <i>username\@host.domain</i>.  A username without
a domain is not sufficient.  Examples of complete
e-mail addresses might be:
<pre>
      jdoe\@foobar.edu
      jfulano\@abc.xyz.edu
      jsmith%my.private.network\@gateway.blah.com
</pre>
Please use the "BACK" button on your browser to go back and try again.
Thank you.
<P>
<address>webmaster\@$ENV{'SERVER_NAME'}</address>

</BODY>
EOM
}
#-------------------------------------------------------------------------
sub print_bad_dest_message {
	local($destaddr, $date) = @_;

	print <<EOM;
Content-type: text/html

<HEAD><TITLE>500 Server Error: Bad destination address</TITLE></HEAD>
<BODY BGCOLOR="#ffffff">
<H1>Server Error: Bad destination address</H1>

Sorry, the person who created the form you just filled out specified a
bad address to mail the results to.  The address ("<tt>$destaddr</tt>")
contains a character that is not usually found in addresses.  For
security reasons, I'm not going to attempt to mail to this address.
<p>
If you know who created the form, please inform them of this error.  If
you don't know who is responsible for the form, contact the server
administrator, <tt>webmaster\@$ENV{'SERVER_NAME'}</tt> 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.<P>

<address>webmaster\@$ENV{'SERVER_NAME'}</address>

</BODY>
EOM
}
#-------------------------------------------------------------------------
sub print_bad_from_message {
	local($destaddr, $date, $from) = @_;

	print <<EOM;
Content-type: text/html

<HEAD><TITLE>500 Server Error: Bad return address</TITLE></HEAD>
<BODY BGCOLOR="#ffffff">
<H1>Server Error: Bad return address</H1>

Sorry, but you entered a return e-mail address ("<tt>$from</tt>") which
was incomplete or contained illegal characters.
<p>
You must either omit a return e-mail address entirely or enter a complete
address in the form <i>username\@host.domain</i>.  A username without
a domain is not sufficient.  Examples of complete
e-mail addresses might be:
<pre>
      jdoe\@foobar.edu
      jfulano\@abc.xyz.edu
      jsmith%my.private.network\@gateway.blah.com
</pre>
Please use the "BACK" button on your browser to go back and try again.
Thank you.
<P>
<address>webmaster\@$ENV{'SERVER_NAME'}</address>

</BODY>
EOM
}
#-------------------------------------------------------------------------
sub print_bad_passwd {
        local($date) = @_;

	#$debugpw = crypt($passwd, $matchpw);
        print <<EOM;
Content-type: text/html

<HEAD><TITLE>500 Server Error: Password match failed</TITLE></HEAD>
<BODY BGCOLOR="#ffffff">
<H1>Server Error: Password match failed</H1>

Sorry, but the web form you filled out
required a password or PIN.  Either the user name and password or PIN
you entered
did not match the expected values, or there was a configuration
problem with the web form.
<p>
Please use the <strong>BACK</strong> button of your browser to try
again.  If you continue to have problems, please contact the
maintainers of the web form.
<p>
</BODY>
EOM

#DEBUG: uname=$uname passwd=$passwd pwfile=$pwfile matchname=$matchname matchpw=$matchpw crypt(passwd,matchpw)=$debugpw
#<p>
#</BODY>
#EOM
}
#-------------------------------------------------------------------------
sub print_bad_ref_message {
        local($destaddr, $date, $referrer) = @_;

        print <<EOM;
Content-type: text/html

<HEAD><TITLE>500 Server Error: Form not authorized</TITLE></HEAD>
<BODY BGCOLOR="#ffffff">
<H1>Server Error: Form not authorized</H1>

Sorry, but the web form you filled out (<tt>$referrer</tt>)
is not authorized to invoke the "yamform" script on this
server (<tt>$ENV{'SERVER_NAME'}</tt>).  Please inform the
creators of that form that they should remove their "yamform" link.
<p>
<address>webmaster\@$ENV{'SERVER_NAME'}</address>

</BODY>
EOM
}
#-------------------------------------------------------------------------
sub print_mail_error_message {
	local($destaddr, $date, $error) = @_;

	# JMD's comment says, "This doesn't work."  I haven't tried it...
	print <<EOM;
Content-type: text/html

<HEAD><TITLE>500 Server Error: Could not send mail</TITLE></HEAD>
<BODY BGCOLOR="#ffffff">
<H1>Server Error: Could not send mail</H1>

I was supposed to take the contents of your form and mail them to
$destaddr, but I couldn\'t run the mail program.  I got the error
message \`\`$error\'\'.<p>

Please contact the server administrator,
<tt>webmaster\@$ENV{'SERVER_NAME'}</tt> 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.<P>

<address>webmaster\@$ENV{'SERVER_NAME'}</address>

</BODY>
EOM
}
#-------------------------------------------------------------------------
sub print_no_dest_message {
	local($date) = @_;

	print <<EOM;
Content-type: text/html

<HEAD><TITLE>500 Server Error: No destination address</TITLE></HEAD>
<BODY BGCOLOR="#ffffff">
<H1>Server Error: No destination address</H1>

The form you filled in didn't say to whom the results should be mailed.<p>

If you know who created the form, please inform them of this error.  If
you don't know who is responsible for the form, contact the server
administrator, <tt>webmaster\@$ENV{'SERVER_NAME'}</tt> 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.<P>

<address>webmaster\@$ENV{'SERVER_NAME'}</address>

</BODY>
EOM
}
#-------------------------------------------------------------------------
sub print_no_form_message {
	local($date) = @_;

	print <<EOM;
Content-type: text/html

<HEAD><TITLE>500 Server Error: no form information available</TITLE></HEAD>
<BODY BGCOLOR="#ffffff">
<H1>Server Error: no form information available</H1>

The "yamform" CGI script is unable to access information normally provided
to it in an HTML form.  <p>

If you know who created the form, please inform them of this error.  If
you don't know who is responsible for the form, contact the server
administrator, <tt>webmaster\@$ENV{'SERVER_NAME'}</tt> 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.<P>

<address>webmaster\@$ENV{'SERVER_NAME'}</address>

</BODY>
EOM
}
#-------------------------------------------------------------------------
sub print_redirection_message {
	local($nextpage_url) = @_;

	if ($nextpage_url =~ m#^/#) {
		# Prepend the server address to the next-page URL.
		# Not sure how wise or useful this is -- it's not exactly
		# analogous to "relative URL" practice.  MJD's mailform
		# did this every time.
		$nextpage_url = "http://" . $ENV{'SERVER_NAME'} . ":" .
		                $ENV{'SERVER_PORT'} . $nextpage_url;
	}

#	# old method using non-parsed header
#	print <<EOM;
#$ENV{'SERVER_PROTOCOL'} 302 Found
#Date: $date
#Server: $ENV{'SERVER_SOFTWARE'}
#MIME-version: 1.0
#Location: $nextpage_url
#Content-type: text/html
#
#<HEAD><TITLE>Document moved</TITLE></HEAD>
#<BODY BGCOLOR="#ffffff"><H1>Document moved</H1>
#This document has moved <A HREF="$nextpage_url">here</A>.<P>
#</BODY>
#EOM

	# new method per Gundavaram ch. 3 on Server Redirection
	print "Location: $nextpage_url\n\n";

	return ;
}
#-------------------------------------------------------------------------
# pwcheck: see whether passwd in form matches file
#
sub pwcheck {
	local($uname, $passwd, $pwfile) = @_;
	local($matchname, $matchpw, $remainder);

	# have all necessary parameters been set?
	return(0) unless ($uname && $passwd && $pwfile);

	# try to find entry in $pwfile matching $uname
	open(PWFILE, $pwfile) || return(0);
	while (<PWFILE>) {
		chop;
		($matchname, $matchpw, $remainder) = split(/:/, $_, 3);
		last if ($matchname eq $uname);
	}
	close(PWFILE);
	return(0) unless ($matchname eq $uname);

	# does password match?
	return(crypt($passwd, $matchpw) eq $matchpw);
}
#-------------------------------------------------------------------------
# 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/\$([\w-]+)/$in{$1}/g;
	$str =~ s/DoLlAr/\$/g;
	return($str);
}
#-------------------------------------------------------------------------
# end of yamform script