#!/usr/bin/perl
use strict;
use warnings;
use Fcntl qw(:flock);
use Encode qw(encode decode);
my %fields;
# (c) 2001-2025/03 Alexander Thomas
# Simple e-mail form script.
# This script is free to use. It may not be sold.
# Use of this script is at your own risk. There is no guarantee
# or liability whatsoever for fitness for any purpose.
#
# INSTRUCTIONS:
# Fill in the correct values in the Parameter section below.
# Make a form on your website with method "POST" and as action the
# URL of this script on your server. (Of course this script must
# have execute permissions.)
# You can easily set fixed values for certain fields by making them hidden.
# The form can contain the following fields (case sensitive!):
# -"from": the e-mail address of the sender
# -"sendername": the name of the sender
# -"carboncopy" (checkbox): if this is checked, a copy of the message
# will be sent to the address in 'from'.
# -"subject": subject of the mail
# -"nextpage": the page to be loaded after sending the mail. If empty,
# the message itself will be displayed instead.
# -"message": the message itself.
# You can add custom fields by modifying the mail_it subroutine below.
##################################################################
#
# PARAMETER SECTION
# Memo: all @list values must be comma-separated ('like', 'this');
# Your system's e-mail program, typically either /usr/sbin/sendmail or
# /usr/lib/sendmail
my $MAIL_PROGRAM = '/usr/sbin/sendmail';
# The e-mail address to send the mails to.
my $RECIPIENT = 'YOUR@E-MAIL.HERE';
# If not empty, will be used as the "From:" address, and the form's "from" field
# will be used for "Reply-To:" instead. By using an address from the same domain
# as the server this script runs on, you can avoid that mails get filtered out
# by mail servers that do not allow mails coming from a different domain than
# the From: address.
my $SENDFROM = '';
# If not empty, will be forced as Return-Path header. This may help prevent
# messages from being marked as suspicious when used in combination with an SPF
# DNS record.
my $RETURN_PATH = '';
# If set, is where the script can be called from. You'll want to put
# your domain name in here so that only you can run this script.
# Leave off http:// and anything that may be omitted, like 'www.'.
# Use () for no restrictions (not recommended!)
my @VALID_DOMAINS = ('YOUR-DOMAIN-HERE.com');
# Put a list here of IPs that should be blocked. You can also omit the
# last parts, like '12.34.56.' or even '12.34.' to block domains.
my @BLOCKED_IPS = ();
# Enter keywords here for user-agents that should be blocked. If any
# of these strings is found in HTTP_USER_AGENT, the message is rejected.
# Even though this may seem obsolete because most spambots now use fake
# identifiers, some still use a fixed string.
my @BLOCKED_UAS = ('WebaltBot');
# If you specify any of the following parameters, they must point to either an
# existing file that has read & write permissions for the user under which this
# script will run, or a yet to be created file in an existing directory with
# 'rwx' permissions for that user.
# Optional: give the path to a log file to report unusual stuff to.
# (Use '' to disable.)
my $LOGFILE = '';
# Optional: if not empty, dump the last message sent by one of the BLOCKED_UAS
# here, should you be curious what they're trying to send.
my $LOGBLOCK = '';
# Optional: give the path to a file where some status info can be stored, to
# detect and temporarily block people hammering the 'send' button.
my $STATFILE = '';
##################################################################
#
# MAIL LAY-OUT
#
# Makes the message, sends it, and returns what has been sent.
# You can tailor this to your own needs, e.g. add headers or markers.
# Make sure not to remove essential headers like From, To and Subject,
# and make sure the header section ends with \n\n.
sub mail_it
{
my ($fromLine, $replyToLine) = ('', '');
if($SENDFROM) {
$fromLine = 'From: '. getMailAddress($SENDFROM, $fields{'sendername'});
$replyToLine = safeHeader('Reply-To: '. getMailAddress($fields{'from'}, $fields{'sendername'})) ."\n";
}
else {
$fromLine = 'From: '. getMailAddress($fields{'from'}, $fields{'sendername'});
}
my $mailHeaders = safeHeader($fromLine) ."\n";
$mailHeaders .= "To: ${RECIPIENT}\n";
if(defined($fields{'carboncopy'}) && $fields{'carboncopy'} eq 'on') {
$mailHeaders .= safeHeader('Cc: '. getMailAddress($fields{'from'}, $fields{'sendername'}));
}
$mailHeaders .= $replyToLine;
$mailHeaders .= safeHeader("Subject: $fields{'subject'}") ."\n";
$mailHeaders .= xHeaders();
my $theMail = $mailHeaders ."\n". $fields{'message'} ."\n\n";
sendMail($theMail);
return $theMail;
}
# Output from this method should still be sent through safeHeader, as it may be
# based on form input.
sub getMailAddress
{
my ($address, $name) = @_;
my $from = '';
$from = $address if defined($address);
return $from if(! defined($name) || $name eq '');
$name = encode('MIME-Header', decode('UTF-8', $name));
return "\"${name}\" <${from}>";
}
# This is only intended for logging. Use getMailAddress for headers.
sub getFromAddress
{
return safeHeader(getMailAddress($fields{'from'}, $fields{'sendername'}));
}
sub sendMail
{
my ($theMail, $noReturnPath) = @_;
my $xtra = '';
$xtra = " -f ${RETURN_PATH}" if($RETURN_PATH ne '' && !$noReturnPath);
open(MZT, '|-', "${MAIL_PROGRAM} -t${xtra}") || die "Unable to send mail: $^E";
print MZT $theMail;
close(MZT);
}
##################################################################
# You can extend this function to test for a mandatory answer on
# a simple question, to thwart spambots. You could also use a
# 'mouse trap' field, which must be empty, and reject messages
# where this field is not empty.
sub test_required
{
my $testmail = '';
$testmail = $fields{'from'} if(defined $fields{'from'});
if($testmail ne '' && bad_address($testmail)) {
$testmail =~ s/</g;
$testmail =~ s/>/>/g;
error_exit('Invalid address', "Bad e-mail format: ${testmail}
Press your browser's 'BACK' button to return to the entry form.", '400 Bad Request');
}
# Example spambot detection: a 'bait' field called "mail" must be left empty.
# if( defined($fields{'mail'}) && $fields{'mail'} ne '' ) {
# error_exit("Access denied", "You triggered the spambot detection. If you are human, go back and do not enter anything into fields that must be left empty.", '400 Bad Request');
# }
}
##################################################################
##### No user serviceable parts below! #####
##################################################################
# MAIN ###########################################################
# This is where the script starts execution from
decode_vars();
valid_page();
test_required();
test_spamming();
my $theMail = mail_it();
if($fields{'nextpage'}) {
# 303 is the most appropriate response, 307 would cause the client
# to re-POST the whole thing, which makes no sense.
print <<__END__;
Status: 303 See Other
Location: $fields{'nextpage'}
__END__
}
else {
$theMail =~ s/&/&/g;
$theMail =~ s/</g;
$theMail =~ s/>/>/g;
print_html('Message sent', 'Message sent', "
${theMail}"); } exit; # SUBROUTINES #################################################### ################################################################## # Decodes form variables into hash %fields sub decode_vars { my $temp = ''; if($ENV{'REQUEST_METHOD'} eq 'GET' || $ENV{'REQUEST_METHOD'} eq 'HEAD') { $temp = $ENV{'QUERY_STRING'}; } elsif($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN, $temp, $ENV{'CONTENT_LENGTH'}) if(defined $ENV{'CONTENT_LENGTH'}); } else { error_exit('Method Not Allowed', 'What the title says.', '405 Method Not Allowed'); } my @pairs = split(/&/, $temp); foreach my $item (@pairs) { my ($key, $content) = split(/=/, $item, 2); if(! defined $key) { error_exit('Malformed form data', 'Form data is malformed, which most likely means you are a bot. Bots are requested to go to /dev/null.', '400 Bad Request'); } $content = '' if(! defined $content); $content =~ tr/+/ /; $content =~ s/%(..)/pack('U',hex($1))/ge; # We are not interested in typewriter compatibility. $content =~ s/\r\n/\n/g; $fields{$key} = $content; } } ################################################################## # Basic tests on whether access is allowed sub valid_page { my $check = $ENV{'HTTP_REFERER'}; if(@VALID_DOMAINS && $check) { my $referer_ok = 0; foreach my $ref (@VALID_DOMAINS) { $ref = "\Q${ref}\E"; if($check =~ m|https?://([^/]*)$ref|i) { $referer_ok = 1; last; } } if($referer_ok != 1) { error_exit('Access denied', "Sorry! You can't run this script from your server. Please use your own script.
${errmesg}
", $status); exit; } ################################################################## sub write_log { return if(! $LOGFILE); my $logData = shift; # Open file in append mode. This also creates the file if it doesn't exist. open(my $logFD, '>>', $LOGFILE) || die "Can't open '${LOGFILE}': $^E"; flock($logFD, LOCK_EX); # (test for success intentionally left out) my $date = localtime(); print $logFD "[lexmail] ${date} ${logData}; $ENV{'REMOTE_ADDR'}"; print $logFD " ($ENV{'HTTP_X_FORWARDED_FOR'})" if($ENV{'HTTP_X_FORWARDED_FOR'}); my $logAgent = $ENV{'HTTP_USER_AGENT'}; $logAgent = '(agent undefined)' if(! defined $logAgent); $logAgent =~ s/\n/ /g; print $logFD ", ${logAgent}\n"; close($logFD); }