#!/usr/bin/perl -Tw

# old path: /usr/local/bin/perl5.00503 -Tw

# listmail.cgi
# by Julie Bernstein
# February 1999
# ---------------------
# (based on a simple mail cgi script)
# Rewritten 8/30/1999 to use CGI.pm module and include replyFile option 
# Modified 3/8/2000 to add security checks and e-mail address verification (thanks to CERT and to the author of FormMail)

#
# How to use this script
# ----------------------
# This script sends listserv actions to listserv@listserv.ucsf.edu.
# Create an HTML form 
# Make the form action /cgi-bin/listmail.cgi
# Make a hidden field with the name "listname" and the value the name of the list
# Make visible fields with names "name" and "email" for the subscriber's name and email
# If desired, make a hidden field with name "replyFile" and value the URL for an HTML page to be returned to the user (otherwise a default message will be displayed)
# Make buttons with name "action" and values "SUBSCRIBE", "SIGNOFF", etc.
# For example of all this see source of http://www.ucsf.edu/y2k/forum.html



use strict ;

# push (@INC, '/usr/local/lib/perl5/5.00503') ;

use CGI qw(:standard) ;

sub bail
{
	my $error = "@_" ;
	print header, start_html("Unexpected error") ;
	print h1("Unexpected error"), p($error), end_html ;
	die $error ;
}


sub check_email # thanks to Matt Wright, the author of FormMail, for this
{
    # Initialize local email variable with input to subroutine.              #
    my $email = $_[0];

    # If the e-mail address contains:                                        #
    if ($email =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||

        # the e-mail address contains an invalid syntax.  Or, if the         #
        # syntax does not match the following regular expression pattern     #
        # it fails basic syntax verification.                                #

        $email !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/) {

        # Basic syntax requires:  one or more characters before the @ sign,  #
        # followed by an optional '[', then any number of letters, numbers,  #
        # dashes or periods (valid domain/IP characters) ending in a period  #
        # and then 2 or 3 letters (for domain suffixes) or 1 to 3 numbers    #
        # (for IP addresses).  An ending bracket is also allowed as it is    #
        # valid syntax to have an email address like: user@[255.255.255.0]   #

        # Return a false value, since the e-mail address did not pass valid  #
        # syntax.                                                            #
        return 0;
    }

    else {

        # Return a true value, e-mail verification passed.                   #
        return 1;
    }
}

sub bad_email
{
	print header, start_html("Invalid e-mail address") ;
	print h1("Invalid e-mail address") ;
	print p("The e-mail address you provided is invalid. Please go back and try again.") ; 
	print end_html ;
}


sub data_filter # thanks to CERT for this
{
    my $value = $_[0] ;
    
    if ( $value =~ /[^a-zA-Z0-9_\-\ ]/g ) # allow only alphanum, space, dash, underscore
    	{ return 0 ; }
    else
    	{ return 1 ;}
}


sub invalid_data
{
	print header, start_html("Invalid data") ;
	print h1("Invalid data") ;
	print p("Some of the data provided could not be processed. There are forbidden characters in the input or in the source code of the form you just filled out.") ;
	print p("Please go back and try again, or contact the maintainer of the web page for assistance.") ; 
	print end_html ;
}

sub check_replyFile # also borrowed from Matt Wright
{
	my $value = $_[0] ;
	
	if ( $value =~ m|^https?://([\w\.]+)|i ) # check to make sure the reply page URL is valid
		{ return 1 ; }
	else
		{ return 0 ; }

}


$ENV{PATH} = '/usr/bin:/etc:/usr/sbin:/usr/ucb:/usr/bin/X11:/sbin' ; # set path explicitly to satisfy taint-checking

# my $mailprog = '/usr/lib/sendmail' ;
my $mailprog = '/usr/sbin/sendmail' ;

my $recipient = "listserv\@listserv.ucsf.edu" ;



my $email = param("email") ; if (!check_email($email)) { bad_email ; exit ;}
my $listname = param("listname") ; if (!data_filter($listname)) { invalid_data ; exit ; }
my $name = param("name") ;  if (!data_filter($name)) { invalid_data ; exit ; }
my $action = param("action") ;  if (!data_filter($action)) { invalid_data ; exit ; }
my $replyFile = param("replyFile") ;  


open (MAIL, "|$mailprog $recipient") || bail "Unable to send request\nPlease send e-mail to webed\@itsa.ucsf.edu, Thank you\n";
print MAIL "From: $email\n";
print MAIL "Reply-to: $email\n";

if ( $action eq "SUBSCRIBE" )

	{ print MAIL "SUBSCRIBE $listname $name\n"; }

else
	{ print MAIL "$action $listname \n"; }


close (MAIL);


if ( $replyFile && check_replyFile($replyFile) )
	{
		print "Location: $replyFile \n\n" ; exit ; 
	}
else
	{
		print header, start_html("Request submitted") ;
		print p("Your request has been sent.") ;
		print p("You will be notified by email.") ;
		print end_html ;
	}