#!/usr/bin/perl

###
#
#       A significant rewrite of the fairly stardard formmail.pl script, 
#       which can be found here:
#
#	    http://www.scriptarchive.com/formmail.html
#	
#	formmail.pl originally Copyright 1995-2002 Matthew M. Wright
#
#	contact.pl is copyright 01999-02004, and beyond, Neil Verplank
#
###################################################################
#
#       This script can be used across multiple domains, and relies on 
#	templates and style sheets to format its response (rather than 
#	passed-in form variables).
#
#       You may use it under the standard GPL license, in the LICENSE file.
#
# 	The recipient must be specified on the form this way:
#
#		<input type=hidden name=TO value=somename>
#
#	Thus, you do not specify an email on the web page, but through a
#	combination of username and servername
#
#		$TO@$callingserver.com
#
#	If no recipient is specified, the default email is specified
# 	in the user variables section (e.g. neil@callingserver.com)
#	You can specifiy a different address below.    The purpose of this is 
#	to prevent spam from being relayed.  Only mail to known addresses on 
#	the hosting server will get through.  No remote messages will be delivered.
#
#	If "<input type=hidden name=redirect>" is on the form, the script
#	will redirect to that page, otherwise it will use the 
#	contactResults.htm template.
# 
#       You will also need the contact.htm page, the contactResults.htm (the
#       output template), and a style sheet "style.css". 
#	Input variables (eg TO, directory, redirect)
#       are specified in the former, output variables in the latter.
#
#	Note that the referring page name is required for mail to get through.
#
#	Latest versions of this script and attending pages can be found here:
#
#	http://neil.verplank.org/opensource/formmail/
#
###


##### INIT --  DO NOT CHANGE *****
#
#
#
	use HTML::Template;

	# Parse Form Contents, init environment

	&parse_form;

	$subd	 = $FORM{'directory'};

	#       Grab the domain name from the environment

	$server	 = $ENV{'SERVER_NAME'};
	#  e.g. $server = "www.area41.com";
	$server	 =~ s/www\.//;
#
#
#
##### END INIT -- DO NOT CHANGE *****


#####
#
#       USER Variables
#


#	location of mail program
	$mailprog 	= '/usr/sbin/sendmail';

#	recipients as specified on the referring page
	$TO	 = $FORM{'TO'};
	
# 	default mail recipient
	$TO	 ||= "neil";

#	valid referring hosts
	@referers = ('64.81.145.64','neil.verplank.org','verplank.org','www.verplank.org',
		'www.area41.com','area41.com','www.johntunger.com','johntunger.com','www.painterspants.org',
		'painterspants.org');

#	referring page name.  This is enforced, since the referer can be spoofed.
	$contactPage = "contact.htm";


#       Absolute path to the root web directory
	$webRoot	= "/home/httpd/vhosts/$server";


#       Template to use for results.  Should be located in:
#       ~webRoot/$directory/$OutTemplate
	$resultsFile    = $webRoot . $subd . "/contactResults.htm";
	$OutTemplate    = TMPL( $resultsFile );
#
#
#       end of USER Variables
#
#####


# main body

$recip 		= $TO . '@' . $server;	
&check_url;
&stop_spam;
&send_mail;
&return_html;

# end main



sub check_url {

   $check_referer = 0;

    # If a referring URL was specified, for each valid referer, make sure    #
    # that a valid referring URL was passed to FormMail.                     #

    if ($ENV{'HTTP_REFERER'}) {
        foreach $referer (@referers) {
            if ($ENV{'HTTP_REFERER'} =~ m|https?://([^/]*)$referer|i) {

		# now we know it's a valid url.  But also enforce that the referer
		# was my contact page. 
		
		if($ENV{'HTTP_REFERER'} =~ $contactPage ) {
                    $check_referer = 1;
                    last;
		}
            }
        }
    }

    # If the HTTP_REFERER was invalid, just die.
    # this produces an error (in httpd logs), rather than 
    # successful execution. 
    # Only a spammer is going to create this situation, so quit now!
    if ($check_referer != 1) { exit; }
}



sub stop_spam {
   
    # The following insures that there were no newlines in any fields which  #
    # will be used in the header.                                            #
    if ($FORM{'subject'} =~ /(\n|\r)/m || $FORM{'email'} =~ /(\n|\r)/m ||
        $FORM{'realname'} =~ /(\n|\r)/m || $FORM{'recipient'} =~ /(\n|\r)/m) {
        # Only a spammer is going to create this situation, so quit now!
        exit;
    }

    # Yet another spammer technique to squelch - email should be an email, not to/bcc etc.
    if ($FORM{'email'} =~ 'TO:' || $FORM{'email'} =~ 'bcc:' ) {
        exit;
    }

    # !@#$!@#$ spam
    if ($FORM{'bcc'} || $FORM{'BCC'}) { exit; }
    if ($TO =~ '@')   { exit; }

    if ($FORM{'email'}) {
        # If the e-mail address contains:                                        #
        if ($FORM{'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.                                #

   #         $FORM{'email'} !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z0-9]+)(\]?)$/) {
	     # Note that the above line requires a valid email address be entered, or
	     # the program will just exit (as opposed to a more graceful error response).
	     # Thus it is commented out - the goal is not to enfore entry of an email,
	     # but prevent bad things from evil formatting.

            # 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]   #

            exit; 
        }
    }


}

sub parse_form {

	if ($ENV{'REQUEST_METHOD'} eq 'GET') {
		# Split the name-value pairs
		@pairs = split(/&/, $ENV{'QUERY_STRING'});
	}
	elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
		# Get the input
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
 
		# Split the name-value pairs
		@pairs = split(/&/, $buffer);
	}
	else {
		&err('request_method');
	}
	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		$name =~ tr/+/ /;
		$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

		# If they try to include server side includes, erase them, so they
		# arent a security risk if the html gets returned.  Another 
		# security hole plugged up.

		$value =~ s/<!--(.|\n)*-->//g;
		# Put all form variables into an associative array. 

		if ($FORM{$name} && ($value)) {
		 	$FORM{$name} = "$FORM{$name}, $value";
	 	} elsif ($value) {
			$FORM{$name} = $value;
		}
	}

	
}


sub return_html {

	$red = $FORM{'redirect'};

	if ($red ne "") {

		# If the redirect option of the form contains a valid url,
		# print the redirectional location header.
		
		if ($red =~ /http\:\/\/.*\..*/)	 {		
			$link = "";
		} else {
			$link = "http\:\/\/$server";
		}
		
		$link = $link . $red;

		print "HTTP/1.0 301 See Other\r\n" if $ENV{PERLXS} eq "PerlIS";

print <<"END";
Content-Type: text/html
END
print "Location: $link\n\n";
				
	} else {

		# otherwise, use the results template



		foreach $pair (@pairs) {
			($name, $value) = split(/=/, $pair);
			if (($name ne 'server') && ($name ne 'recipient') && ($value ne "")) {
				$nameF = $name;
				$nameF =~ s/_/ /g;
				$valueF = $value;
				$valueF =~ s/_/ /g;
				$valueF =~ tr/+/ /;
				$valueF =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

				push(@ContactLoop, {
					ContactName => $nameF,
					ContactValue => $valueF
				});
			}
		}

		print "Content-type: text/html\n\n";


		$OutTemplate->param(
			ContactLoop	=> \@ContactLoop,
			ContactError	=> ""
		);

		print $OutTemplate->output;

	}
} #end sub return html





sub send_mail {
	# Open The Mail Program

    if ($FORM{'body'} ne "") {

	open(MAIL,"|$mailprog -t") || &err('mail bombed');

	# Send to $FORM{'TO'}@servername	
	print MAIL "To: $recip\n";	
	
	# Check for Message Sender
	if ($FORM{'email'}) {
		print MAIL "From: $FORM{'email'}\n";
	} else {
		print MAIL "From: \n";
	}

  

	# Check for Message Subject
	if ($FORM{'subject'}) {
		print MAIL "Subject: $FORM{'subject'}\n\n";
	} else {
		print MAIL "Subject: no subject specified\n\n";
	}


	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		if (($name ne 'recipient') && ($name ne 'subject') && ($value ne "")) {
			$nameF 	= $name;
			$nameF 	=~ s/_/ /g;
			$valueF = $value;
			$valueF =~ s/_/ /g;
			$valueF =~ tr/+/ /;
			$valueF =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

			print MAIL "$nameF: $valueF\n\n";
		}
	}

	print MAIL "$server: form mail\n\n" || &err('mail bombed');
	
	close (MAIL);

    }
}



sub TMPL( $ )
{
	my ( $FileName ) = @_;
	my $TMPL = HTML::Template->new(
                filename => $FileName,
                die_on_bad_params => 0,
                cache => 1,
        );

	return( $TMPL );
} #end sub TMPL







sub err {
        print "Content-type: text/html\n\n";
        print "<html><body>oops - you must either GET or POST data.  What did *you* do?</body></html>\n";
} # end sub error