#!/usr/bin/perl -w
use strict;
use CGI;
use POSIX qw(strftime);
my $pname = $0 =~ m!/([^/]*)$! ? $1 : $0;
# Here is where the email recipients are listed
my @valid_rcpts = (
'nobody@spiritone.com',
'nobody@aracnet.com',
);
my %exclude = ( 'from' => 1, 'to' => 1, 'name' => 1, 'default_from' => 1,
'subject' => 1, 'body' => 1, 'verifyfield' => 1,
'datafields' => 1, 'nexturl' => 1 );
my $SENDMAIL = "/usr/sbin/sendmail -t";
my $virtdir = "/home/http/conf/VirtualHosts";
my %our_domain = ( "spiritone.com" => 1, "aracnet.com" => 1,
"involved.com" => 1, );
my $illegallog = "mailto_illegal";
my $errorlog = "mailto_error";
my $cgi = new CGI;
# Email variables
my $destaddr = lc($cgi->param('to'));
if($destaddr && $destaddr =~ /[\n|\r]/) {
printError("Invalid destination address");
}
my $fromaddr = lc($cgi->param('from'));
if($fromaddr && $fromaddr =~ /[\n|\r]/) {
printError("Invalid sender address");
}
my $fromname = $cgi->param('name');
if($fromname && $fromname =~ /[\n|\r]/) {
printError("Invalid sender name");
}
my $default_from = lc($cgi->param('default_from'));
if($default_from && $default_from =~ /[\n|\r]/) {
printError("Invalid default sender");
}
my $subject = $cgi->param('subject') ? $cgi->param('subject') :
($cgi->param('sub') ? $cgi->param('sub') : "NO SUBJECT");
if($subject && $subject =~ /[\n|\r]/) {
printError("Invalid subject");
}
my $body = $cgi->param('body');
# Data variables
my @verifyfields = $cgi->param('verifyfield');
my @datafields = $cgi->param('datafields') ?
split(/,/, $cgi->param('datafields')) : grep !$exclude{$_}, $cgi->param;
# Other variables
my $nexturl = $cgi->param('nexturl');
# Verify the sender address
$fromaddr = $default_from unless $fromaddr =~ /\@/;
if(!$fromaddr) {
$fromaddr = "nobody\@aracnet.com";
logEntry($errorlog, "Missing both from and default_from parameters");
}
printError("Invalid sender address") unless $fromaddr =~ /\@/;
# Verify the recipient address
unless(grep(/^$destaddr$/, @valid_rcpts)) {
printError("Invalid recipient address");
}
# Verify required information
for (@verifyfields) {
printError("Missing required field: $_")
if $cgi->param("$_") eq "none";
}
# Convert %xx encodings
$body =~ s/%(..)/pack("c",hex($1))/ge;
my $op = $pname eq "mailto.pl" ? "->" : "=";
# Join data variables
my $vars = "";
map { $vars .= "$_ $op " . $cgi->param($_). "\n" if $cgi->param($_) }
@datafields;
# Mail the thing already
open(SM, "|$SENDMAIL");
#print $cgi->header, "Message\n";
print SM "Received: from ", ($ENV{'REMOTE_HOST'} ?
"$ENV{REMOTE_HOST} ($ENV{REMOTE_HOST} [$ENV{REMOTE_ADDR}])" :
"[$ENV{REMOTE_ADDR}]"), " by $ENV{HTTP_HOST} via HTTP; ",
strftime("%a, %d %b %Y %H:%M:%S %z", localtime),
"\nFrom: ", ($fromname ? "$fromname <$fromaddr>" : "$fromaddr"),
"\nTo: $destaddr\nSubject: $subject\n\n$body\n",
($pname eq "mailto.pl" ? "" : "\n"), "$vars\n\n";
#print "\n";
close(SM);
# Done!
if($nexturl) {
print "Location: $nexturl\n\n";
} else {
print $cgi->header, "\n\n\nMailto results\n",
"Mail successfully sent
\n\n",
"\n";
}
exit 0;
# Our generic error routine
sub printError {
print $cgi->header, "\n\n\nError\n\n",
"Error
@_
\n\n",
"\n";
logEntry($errorlog, @_);
exit 0;
}
sub notAuthorized {
print $cgi->header, "\n\n\nNot Authorized\n",
"\nNot Authorized
\n@_",
"
\n",
"\n\n";
logEntry($illegallog, @_);
exit 0;
}
sub logEntry {
my $logfile = shift;
# We're running on an NFS dir, so we make no attempt at file locking.
# We don't fail if we can't open the file, either.
if(open(FH, ">>$logfile")) {
print FH scalar localtime(), " - ", @_, "\nParams:\n",
(map { "\t$_: " . $cgi->param($_) . "\n" } $cgi->param), "Environment:\n",
(map { "\t$_: " . $ENV{$_} . "\n" } sort keys %ENV);
close(FH);
}
}