mcgmark
08-02-2006, 09:41 PM
Hey I am using a script I downloaded off the internet everything works great except the script fails to send the sender's e-mail variable with $EMAIL it reads the $EMAIL variable no problem because it emails me the data but it won't send a Reply-To address with it.
#!/usr/bin/perl
# A form to mail perl script
# Copyright (C) 2004 by James Freeman. This script is based on Matt's Formmail. Matt Did most of the work and I add to it.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
#
#
# Configuration
#
# In the referers array you *need* to specify all the host referer address'
# which you want to allow the script to let through, ie from commondrops.com,
# I would specify ('commondrops.com', 'www.commondrops.com') to make
# sure that somebody from another address is not using your form.
#
#
# recipient = address to send the mail to (can be a comma seperated list,eg "name1@host.com,name2@host.com" etc)
# sender = the "From: ..." (or Reply-To:) section of the sent email
# subject = subject of the email
# redirect = web page to redirect the client to after the email has been sent succesfully
# incomplete = web page to redirect the client to if he/she has not completed the form (see below)
# required = a comma seperated list of required values/variables, if the user does not fill all of these
# fields in then they will be redirected to the "incomplete" config variable (see above), if
# the "incomplete" config variable is not set then a page will be shown explaining the error.
# An example can be seen just below of this field;
# <input type=hidden name=required value="email,name,phone">
# fileuploads = this option is used to handle fileuploads, within this field specify a comma seperated list
# of the fields within your form that contain file uploads, see below for an example.
# ---- CUT HERE ----
# <form enctype="multipart/form-data" action="mail.cgi" method=post>
# <input type=hidden name=fileuploads value="file1,file2,file3">
# <input type=file name=file1>
# <input type=file name=file2>
# <input type=file name=file3>
# <input type=submit>
# </form>
# ---- CUT HERE ----
#
# this is one of the most important variables in the script, this formats the
# email that you receive! Variables are placed within "<" and ">" markers.
# The variable name is placed within them and is case sensitive. POST and GET
# variables are checked first, if they don't exist the script turns to
# cookies, and finally environment variables.
# A list of script defined variables is below
#
# senttime => Time at which the Email was sent
# all_vars => Displays a list of all variables past to the script (not environment vars)
#
my $email_format = q(
The following is a inquiry from sent specifically to you, sent @ <$senttime>
Name: <$NAME>
Company: <$COMPANY>
E-Mail: <$EMAIL>
Phone: <$PHONE>
Inquiry:
<$CONTENT>
); ######## THIS LINE IS THE END OF THE EMAIL ########
# what email type should we use?
#my $email_type = 'html';
my $email_type = 'plain'; # default to text, but you can use HTML
# this is to specify the recipient in here rather than the form
my $recipient = ''; # eg. $recipient = 'email@yourdomain.com'
# this tells the script to use `sendmail' (1) or an SMTP server (0)
my $useapp = 1;
# this is the app to use (works with sendmail atm)
my $mailapp = '/usr/sbin/sendmail';
# set this to your SMTP server (send mail server)
my $smtp = 'pmail.easyhosting.com';
# should we watch what the data returns and check it against values? (try 0 if
# you get an error about the SMTP returning incorrect values)
my $strict_smtp = 1;
# this represents a list of any variables that should be forwarded to the
# redirect page; $redirect?var1=data&var2=data...
# leave empty not to forward any
my @forward = ();
# this is a comma seperated list of hosts that are allowed to post to this
# script, best to make sure
my @referers = ('www. ', ' ',);
# this option decides how to check the referer of the form
# 0 = don't check it (let all through)
# 1 = check it if the variable exists ($HTTP_REFERER)
# 2 = always check it, if the variable isn't there then tough
my $referer_check = 2;
# when finished, this variable will tell the script whether or not to store any
# uploaded files on the server or whether to BASE64 encode them and attach them
# to the e-mail sent to "recipient" (use 1 file attachment - this is the only
# mode supported at the moment)
my $upload_files = 0;
# if you answered 1 to the above variable then you need to use this in order to
# tell the script where it can safely upload the files (full path name
# preferably, but not needed - ensure the trailing slash!)
my $upload_dir = '';
######## GPG encryption config ########
# use it? (1/0 = yes/no)
my $gpg_use = 0;
# the binary path (full path)
my $gpg_bin = '/usr/bin/gpg';
# any extra options? ascii coding and encryption are likely :)
my $gpg_extra_options = '-a -e --always-trust --no-tty';
# key of the recipient
my $gpg_recipient = 'you@your-site.com';
# a temp directory, somewhere we have write access to (with the trailing slash)
my $gpg_temp = '/tmp/';
# the GPG config directory
my $gpg_config = '/home/mail/.gnupg';
# OK, that's all. You are done unless you want to use the extra options below
# =============
use CGI qw/:standard/;
use Socket;
my $message = '';
my @fileuploads;
my $numfileattachments = 0;
my $attachments = '';
my $senttime = &senttime;
my $required = '';
my $sender = $EMAIL;
my $subject = 'Inquiry from ';
my $redirect = '';
&get_details;
&check_details;
&message_construct;
# make sure we've got a valid email type
if(!defined $email_type or ($email_type ne 'html' and $email_type ne 'plain')) { $email_type = 'plain'; }
# we need to generate a random boundary, so let's
my $boundary = '';
my @rands = qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0 9 8 7 6 5 4 3 2 1);
do {
foreach (1..32) { $boundary .= $rands[rand()*(int @rands)]; }
} while($message =~ m/$boundary/g or $attachments =~ m/$boundary/g);
if($upload_files == 0){ &handle_uploads; }
if($useapp == 1) {
&sendmail_app;
} else {
&sendmail_smtp;
}
if(!length $redirect){
&sentok;
} else {
if((int @forward) > 0) {
$redirect .= '?'.join("&", (map urlencode($_)."=".urlencode(param($_)), @forward));
}
print redirect($redirect);
}
exit;
sub urlencode {
# converts all non alpha-numeric characters except -_. to %XX where XX is their hexadecimal numerical value
my ($str) = @_;
my $retstr = '';
my $l;
for($l=0; $l<length $str; ++$l) {
my $c = substr($str, $l, 1);
if($c !~ m/[0-9]|[a-z]|_|\-|\./gi) {
# it's a char to encode
$retstr .= sprintf("%%%02X", ord($c));
} else {
# whack it on the end
$retstr .= $c;
}
}
return $retstr;
}
sub senttime {
my @months = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
my @dow = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
my (undef,undef,$ghour,$gmday,$gmon,$gyear,undef,undef) = gmtime(time);
my ($lsec,$lmin,$lhour,$lmday,$lmon,$lyear,$lwday,undef,undef) = localtime(time);
$gyear += 1900;
$lyear += 1900;
my $ftd = $dow[$lwday].', '.$lmday.' '.$months[$lmon].' '.$lyear.' ';
if(length $lhour == 1) { $ftd .= '0'; }
$ftd .= $lhour.':';
if(length $lmin == 1) { $ftd .= '0'; }
$ftd .= $lmin.':';
if(length $lsec == 1) { $ftd .= '0'; }
$ftd .= $lsec.' ';
my $tdif = $lhour-$ghour;
if($gmday != $lmday) {
if($gmday < $lmday and $gmon == $lmon) {
$tdif += 24;
} else {
$tdif -= 24;
}
}
if($tdif < 0) {
$ftd .= '-';
} else {
$ftd .= '+';
}
if(length abs($tdif) == 1) {
$ftd .= '0';
}
$ftd .= abs($tdif).'00';
return $ftd;
}
sub bad_recipient {
print header,
qq(
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=ISO-8859-1">
<title>Bad recipient supplied</title>
</head>
<body>
<h3 align="center">Unable to send email because one or more of the recipient e-mail address supplied was invalid.</h3>
<font face="verdana" size="3"><div align="center">Please contact the webmaster and report this error.</div></font>
</body>
</html>
);
exit;
}
sub no_recipient {
print header,
qq(
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=ISO-8859-1">
<title>No recipient supplied</title>
</head>
<body>
<h3 align="center">Unable to send email because no recipient address was supplied.</h3>
<font face="verdana" size="3"><div align="center">Please contact the webmaster and report this error.</div></font>
</body>
</html>
);
exit;
}
sub gpg_encrypt {
my ($mes) = @_;
my $l=0;
while(-e $gpg_temp.'mail.'.$l) { $l++; }
my $tmp_file = $gpg_temp.'mail.'.$l;
open GPG, '|'.$gpg_bin.' --homedir '.$gpg_config.' '.$gpg_extra_options.' -r "'.$gpg_recipient.'" -o '.$tmp_file;
print GPG $mes;
close GPG;
open TF, $tmp_file;
my $buf = join '', <TF>;
close TF;
unlink $tmp_file;
return $buf;
}
sub sendmail_app {
if(!$recipient){ &no_recipient; }
if(!$subject){ $subject = "Inquiry from "; }
my $host = $ENV{'HTTP_HOST'};
if($host eq '') {
$host = $recipient;
$host =~ s/^.*\@//g;
$host =~ s/,.*$//g;
} else {
$host =~ s/^www\.//i;
}
# make sure the sender is set and that it's a valid email address
if(!$sender or $sender !~ /^[[0-9]|[a-z]|\-|\_|\.]{2,}\@[[0-9]|[a-z]|\-]+\.[[0-9]|[a-z]|\-|\.]+$/gs){
$sender = "noreply\@".$host;
}
my $popen_str = '|'.$mailapp.' -f "'.$sender.'" ';
my @recipients = split ',', $recipient;
my $r;
foreach $r (@recipients){
# make sure it's not a fake recipient e-mail address, if so then
# we may as well bomb...
if($r !~ /^[[0-9]|[a-z]|\-|\_|\.]{2,}\@[[0-9]|[a-z]|\-]+\.[[0-9]|[a-z]|\-|\.]+$/gis) { &bad_recipient; }
$r =~ s/(^\s)|(\s$)//g;
if($r =~ m/\`/) { next; }
$popen_str .= ' "'.$r.'"';
}
open OPIP, $popen_str
or &cant_send('viaapp');
my $buf = "From: ".$sender."\n".
"Subject: ".$subject."\n".
"Date: ".$senttime."\n".
"To: ".$recipient."\n".
"MIME-Version: 1.0\n".
"Content-type: multipart/mixed; charset=US-ASCII; boundary=".$boundary."\n\n".
"--".$boundary."\n".
"Content-Type: text/".$email_type."; charset=US-ASCII\n\n".
$message;
if($numfileattachments) { $buf .= $attachments; }
#$buf .= "\n".$boundary."\n\n";
$buf =~ s/\n\.\n/\n\n/g;
$buf .= "\n\.\n";
print OPIP $buf;
close OPIP;
}
sub sendmail_smtp {
if(!$recipient){ &no_recipient; }
if(!$subject){ $subject = "Inquiry from "; }
my $host = $ENV{'HTTP_HOST'};
if($host eq '') {
$host = $recipient;
$host =~ s/^.*\@//g;
$host =~ s/,.*$//g;
} else {
$host =~ s/^www\.//i;
}
if(!$sender){ $sender = "noreply\@".$host; }
my $osock;
my $tmp;
my $dat = '';
my $proto = getprotobyname('tcp');
socket($osock, PF_INET, SOCK_STREAM, $proto)
or &cant_send('viasmtp');
my $sin = sockaddr_in(25, inet_aton($smtp));
connect($osock,$sin)
or &cant_send('viasmtp');
sysread $osock, $tmp, 2048;
# 220 xxxx.xxx ESMTP Sendmail x.x.x/x.x.x; Time/Date
if($tmp !~ m/^220/ and $strict_smtp == 1){ &smtp_error; }
$dat .= $tmp;
# $buf = "helo ".$host."\nmail from: ".$sender."\n";
syswrite $osock, "HELO ".$host."\r\n", length("HELO ".$host."\r\n");
sysread $osock, $tmp, 2048;
# 250 xxxx.xxx Hello <hostname> [xxx.xxx.xxx.xxx], pleased to meet you
if($tmp !~ m/^250/ and $strict_smtp == 1){ &smtp_error; }
$dat .= $tmp;
syswrite $osock, "MAIL FROM: ".$sender."\r\n", length("MAIL FROM: ".$sender."\r\n");
sysread $osock, $tmp, 2048;
# 250 xxx@xxxxxxxxxx... Sender ok
if($tmp !~ m/^250/ and $strict_smtp == 1){ &smtp_error; }
$dat .= $tmp;
my @recipients = split ',', $recipient;
foreach $recipient (@recipients){
$recipient =~ s/(^\s)|(\s$)//g;
syswrite $osock, "RCPT TO: ".$recipient."\r\n", length("RCPT TO: ".$recipient."\r\n");
sysread $osock, $tmp, 2048;
# 250 xxx@xxxxxxx... Recipient ok
if($tmp !~ m/^250/ and $strict_smtp == 1){ &smtp_error; }
$dat .= $tmp;
# $buf .= "rcpt to: ".$recipient."\n";
}
syswrite $osock, "DATA\r\n", 5;
sysread $osock, $tmp, 2048;
# 354 Enter mail, end with "." on a line by itself
if($tmp !~ m/^354/ and $strict_smtp == 1){ &smtp_error; }
$dat .= $tmp;
# $buf .= "data\n".
my $buf = "Subject: ".$subject."\n".
"Date: ".$senttime."\n".
"To: ".$recipient."\n".
"MIME-Version: 1.0\n".
"Content-type: multipart/mixed; charset=US-ASCII; boundary=".$boundary."\n\n".
"--".$boundary."\n".
"Content-Type: text/".$email_type."; charset=US-ASCII\n\n".
$message;
if($numfileattachments) { $buf .= $attachments; }
#$buf .= "\n".$boundary."\n";
$buf =~ s/\n\.\n/\n\n/g;
$buf .= "\n\.\n";
my $off = 0;
my $len = length $buf;
while($len){
my $w = syswrite $osock, $buf, $len, $off;
$len -= $w;
$off += $w;
}
sysread $osock, $tmp, 2048;
if($tmp !~ m/^250/ and $strict_smtp == 1){ &smtp_error; }
$dat .= $tmp;
syswrite $osock, "QUIT\r\n", 5;
close($osock);
}
sub check_details {
if($referer_check > 0) {
if(!$ENV{'HTTP_REFERER'} and $referer_check == 1) { return; }
# perform the check
my $referer = $ENV{'HTTP_REFERER'};
my $ref;
foreach $ref (@referers){ if($referer =~ m/^(http:\/\/)?($ref)/i or $referer =~ m/^(https:\/\/)?($ref)/i) { return; } }
&unauth_ref;
}
}
sub get_details {
if($recipient eq '') { $recipient = param('recipient'); }
$required = param('required');
$sender = param('sender');
$subject = param('subject');
$redirect = param('redirect');
my @required_fields = split ",", $required;
foreach (@required_fields){
$_ =~ s/(^\s)|(\s$)//g;
if(!param($_)){ &incomplete; }
}
my $fu = param("fileuploads");
if($fu =~ m/\,/){
@fileuploads = split ",", $fu;
} else {
$fileuploads[0] = $fu;
}
}
sub exists_in_array {
my ($scalar, @array) = @_;
foreach (@array){
if($_ eq $scalar) {
return 1;
}
}
return 0;
}
sub return_filename {
my ($fn) = @_;
if($fn =~ m/^\//){
$fn =~ s/^(.+)\///g;
} else {
$fn =~ s/^(.+)\\//g;
}
return $fn;
}
sub base64_encode {
my ($data) = @_;
my @base64_alpha = ('A','B','C','D','E','F','G','H','I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z','0','1', '2','3','4','5','6','7','8','9','+','/' );
my $out = '';
my $ldata = 0;
my $rem = 0;
$ldata = length $data;
$rem = $ldata % 3;
if($rem > 0){
$data .= chr(0) x (3-$rem);
$ldata = length $data;
}
my $tl = $ldata / 3;
my $p;
for($p=0; $p<$tl; $p++){
my $tri1 = ord(substr($data,0,1));
my $tri2 = ord(substr($data,1,1));
my $tri3 = ord(substr($data,2,1));
$data = substr($data, 3);
$out .= $base64_alpha[($tri1&0xfc)>>2];
$out .= $base64_alpha[(($tri1&0x03)<<4) | (($tri2&0xf0)>>4)];
$out .= $base64_alpha[(($tri2&0x0f)<<2) | (($tri3&0xc0)>>6)];
$out .= $base64_alpha[$tri3&0x3f];
}
if($rem > 0){
$rem = 3 - $rem;
$out =~ s/A{$rem}$//;
$out .= '=' x $rem;
}
my $l;
my $sout = '';
for($l=0; $l<length $out; $l+=76) { $sout .= substr($out, $l, 76)."\n"; }
$sout .= substr($out, $l-76, 76-$l);
return $sout;
}
sub handle_uploads {
if($upload_files == 0){
foreach (@fileuploads){
if(length param($_)) {
my $fileh = param($_);
my $fd = join '', <$fileh>;
my $filename = return_filename($fileh);
$numfileattachments++;
if($gpg_use == 1) {
$fd = gpg_encrypt $fd;
$filename .= '.gpg';
}
$filename =~ s/\s/_/g;
$attachments .= "\n--".$boundary."\n".
"Content-Type: octet/stream; name=".$filename."\n".
"Content-Transfer-Encoding: BASE64\n".
"Content-Description:\n".
"Content-Disposition: attachment; filename=".$filename."\n\n".
base64_encode($fd)."\n";
}
}
} else {
foreach (@fileuploads){
if(length param($_)) {
my $fileh = param($_);
my $fd = join '', <$fileh>;
my $filename = return_filename($fileh);
my $time = &time;
while(mkdir($upload_dir.'mail'.$time, '755') == 0) {
$message .= "\n(tried to create a directory for files called ${upload_dir}mail${time} but couldn't! \$! = $!\n";
$time = &time;
}
my $savepath = $upload_dir.'mail'.$time.substr($upload_dir, -1).$filename;
open SAVETO, '>'.$savepath or $message .= "\ntried to upload file ".$filename.", but couldn't !!!\n"; &continue;
syswrite SAVETO, $fd;
close SAVETO;
$message .= "Uploaded file to : ".$savepath."\n";
}
}
}
}
sub message_construct {
my @params = param;
$message = $email_format;
# make all necessary variable exchanges
while($message =~ m/<\$([0-9]|[a-z]|[A-Z]|_|\-|!>)+>/gc) {
my $var = $&;
$var =~ s/^(<\$)|>$//g;
my $val = '['.$var.' - undefined]';
# firstly, is it an internal variable?
if($var eq 'senttime') {
$val = &senttime;
} elsif ($var eq 'all_vars') {
$val = '';
my $key;
foreach $key (@params) { $val .= "\"$key\" => \"".param($key)."\"\n"; }
} else {
# the variable is POST or GET, swap it
if(defined param($var)) {
$val = param($var);
} else {
# hrm, is it an environment variable?
if(defined $ENV{$var}) {
# yup, make the change
$val = $ENV{$var};
} else {
# is it a cookie?
if(defined cookie($var)) {
# yay
$val = cookie($var);
}
}
}
}
$message =~ s/<\$$var>/$val/g;
}
$message =~ s/\n/\r\n/g;
if($gpg_use == 1) { $message = gpg_encrypt $message; }
}
#!/usr/bin/perl
# A form to mail perl script
# Copyright (C) 2004 by James Freeman. This script is based on Matt's Formmail. Matt Did most of the work and I add to it.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
#
#
# Configuration
#
# In the referers array you *need* to specify all the host referer address'
# which you want to allow the script to let through, ie from commondrops.com,
# I would specify ('commondrops.com', 'www.commondrops.com') to make
# sure that somebody from another address is not using your form.
#
#
# recipient = address to send the mail to (can be a comma seperated list,eg "name1@host.com,name2@host.com" etc)
# sender = the "From: ..." (or Reply-To:) section of the sent email
# subject = subject of the email
# redirect = web page to redirect the client to after the email has been sent succesfully
# incomplete = web page to redirect the client to if he/she has not completed the form (see below)
# required = a comma seperated list of required values/variables, if the user does not fill all of these
# fields in then they will be redirected to the "incomplete" config variable (see above), if
# the "incomplete" config variable is not set then a page will be shown explaining the error.
# An example can be seen just below of this field;
# <input type=hidden name=required value="email,name,phone">
# fileuploads = this option is used to handle fileuploads, within this field specify a comma seperated list
# of the fields within your form that contain file uploads, see below for an example.
# ---- CUT HERE ----
# <form enctype="multipart/form-data" action="mail.cgi" method=post>
# <input type=hidden name=fileuploads value="file1,file2,file3">
# <input type=file name=file1>
# <input type=file name=file2>
# <input type=file name=file3>
# <input type=submit>
# </form>
# ---- CUT HERE ----
#
# this is one of the most important variables in the script, this formats the
# email that you receive! Variables are placed within "<" and ">" markers.
# The variable name is placed within them and is case sensitive. POST and GET
# variables are checked first, if they don't exist the script turns to
# cookies, and finally environment variables.
# A list of script defined variables is below
#
# senttime => Time at which the Email was sent
# all_vars => Displays a list of all variables past to the script (not environment vars)
#
my $email_format = q(
The following is a inquiry from sent specifically to you, sent @ <$senttime>
Name: <$NAME>
Company: <$COMPANY>
E-Mail: <$EMAIL>
Phone: <$PHONE>
Inquiry:
<$CONTENT>
); ######## THIS LINE IS THE END OF THE EMAIL ########
# what email type should we use?
#my $email_type = 'html';
my $email_type = 'plain'; # default to text, but you can use HTML
# this is to specify the recipient in here rather than the form
my $recipient = ''; # eg. $recipient = 'email@yourdomain.com'
# this tells the script to use `sendmail' (1) or an SMTP server (0)
my $useapp = 1;
# this is the app to use (works with sendmail atm)
my $mailapp = '/usr/sbin/sendmail';
# set this to your SMTP server (send mail server)
my $smtp = 'pmail.easyhosting.com';
# should we watch what the data returns and check it against values? (try 0 if
# you get an error about the SMTP returning incorrect values)
my $strict_smtp = 1;
# this represents a list of any variables that should be forwarded to the
# redirect page; $redirect?var1=data&var2=data...
# leave empty not to forward any
my @forward = ();
# this is a comma seperated list of hosts that are allowed to post to this
# script, best to make sure
my @referers = ('www. ', ' ',);
# this option decides how to check the referer of the form
# 0 = don't check it (let all through)
# 1 = check it if the variable exists ($HTTP_REFERER)
# 2 = always check it, if the variable isn't there then tough
my $referer_check = 2;
# when finished, this variable will tell the script whether or not to store any
# uploaded files on the server or whether to BASE64 encode them and attach them
# to the e-mail sent to "recipient" (use 1 file attachment - this is the only
# mode supported at the moment)
my $upload_files = 0;
# if you answered 1 to the above variable then you need to use this in order to
# tell the script where it can safely upload the files (full path name
# preferably, but not needed - ensure the trailing slash!)
my $upload_dir = '';
######## GPG encryption config ########
# use it? (1/0 = yes/no)
my $gpg_use = 0;
# the binary path (full path)
my $gpg_bin = '/usr/bin/gpg';
# any extra options? ascii coding and encryption are likely :)
my $gpg_extra_options = '-a -e --always-trust --no-tty';
# key of the recipient
my $gpg_recipient = 'you@your-site.com';
# a temp directory, somewhere we have write access to (with the trailing slash)
my $gpg_temp = '/tmp/';
# the GPG config directory
my $gpg_config = '/home/mail/.gnupg';
# OK, that's all. You are done unless you want to use the extra options below
# =============
use CGI qw/:standard/;
use Socket;
my $message = '';
my @fileuploads;
my $numfileattachments = 0;
my $attachments = '';
my $senttime = &senttime;
my $required = '';
my $sender = $EMAIL;
my $subject = 'Inquiry from ';
my $redirect = '';
&get_details;
&check_details;
&message_construct;
# make sure we've got a valid email type
if(!defined $email_type or ($email_type ne 'html' and $email_type ne 'plain')) { $email_type = 'plain'; }
# we need to generate a random boundary, so let's
my $boundary = '';
my @rands = qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0 9 8 7 6 5 4 3 2 1);
do {
foreach (1..32) { $boundary .= $rands[rand()*(int @rands)]; }
} while($message =~ m/$boundary/g or $attachments =~ m/$boundary/g);
if($upload_files == 0){ &handle_uploads; }
if($useapp == 1) {
&sendmail_app;
} else {
&sendmail_smtp;
}
if(!length $redirect){
&sentok;
} else {
if((int @forward) > 0) {
$redirect .= '?'.join("&", (map urlencode($_)."=".urlencode(param($_)), @forward));
}
print redirect($redirect);
}
exit;
sub urlencode {
# converts all non alpha-numeric characters except -_. to %XX where XX is their hexadecimal numerical value
my ($str) = @_;
my $retstr = '';
my $l;
for($l=0; $l<length $str; ++$l) {
my $c = substr($str, $l, 1);
if($c !~ m/[0-9]|[a-z]|_|\-|\./gi) {
# it's a char to encode
$retstr .= sprintf("%%%02X", ord($c));
} else {
# whack it on the end
$retstr .= $c;
}
}
return $retstr;
}
sub senttime {
my @months = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
my @dow = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
my (undef,undef,$ghour,$gmday,$gmon,$gyear,undef,undef) = gmtime(time);
my ($lsec,$lmin,$lhour,$lmday,$lmon,$lyear,$lwday,undef,undef) = localtime(time);
$gyear += 1900;
$lyear += 1900;
my $ftd = $dow[$lwday].', '.$lmday.' '.$months[$lmon].' '.$lyear.' ';
if(length $lhour == 1) { $ftd .= '0'; }
$ftd .= $lhour.':';
if(length $lmin == 1) { $ftd .= '0'; }
$ftd .= $lmin.':';
if(length $lsec == 1) { $ftd .= '0'; }
$ftd .= $lsec.' ';
my $tdif = $lhour-$ghour;
if($gmday != $lmday) {
if($gmday < $lmday and $gmon == $lmon) {
$tdif += 24;
} else {
$tdif -= 24;
}
}
if($tdif < 0) {
$ftd .= '-';
} else {
$ftd .= '+';
}
if(length abs($tdif) == 1) {
$ftd .= '0';
}
$ftd .= abs($tdif).'00';
return $ftd;
}
sub bad_recipient {
print header,
qq(
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=ISO-8859-1">
<title>Bad recipient supplied</title>
</head>
<body>
<h3 align="center">Unable to send email because one or more of the recipient e-mail address supplied was invalid.</h3>
<font face="verdana" size="3"><div align="center">Please contact the webmaster and report this error.</div></font>
</body>
</html>
);
exit;
}
sub no_recipient {
print header,
qq(
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=ISO-8859-1">
<title>No recipient supplied</title>
</head>
<body>
<h3 align="center">Unable to send email because no recipient address was supplied.</h3>
<font face="verdana" size="3"><div align="center">Please contact the webmaster and report this error.</div></font>
</body>
</html>
);
exit;
}
sub gpg_encrypt {
my ($mes) = @_;
my $l=0;
while(-e $gpg_temp.'mail.'.$l) { $l++; }
my $tmp_file = $gpg_temp.'mail.'.$l;
open GPG, '|'.$gpg_bin.' --homedir '.$gpg_config.' '.$gpg_extra_options.' -r "'.$gpg_recipient.'" -o '.$tmp_file;
print GPG $mes;
close GPG;
open TF, $tmp_file;
my $buf = join '', <TF>;
close TF;
unlink $tmp_file;
return $buf;
}
sub sendmail_app {
if(!$recipient){ &no_recipient; }
if(!$subject){ $subject = "Inquiry from "; }
my $host = $ENV{'HTTP_HOST'};
if($host eq '') {
$host = $recipient;
$host =~ s/^.*\@//g;
$host =~ s/,.*$//g;
} else {
$host =~ s/^www\.//i;
}
# make sure the sender is set and that it's a valid email address
if(!$sender or $sender !~ /^[[0-9]|[a-z]|\-|\_|\.]{2,}\@[[0-9]|[a-z]|\-]+\.[[0-9]|[a-z]|\-|\.]+$/gs){
$sender = "noreply\@".$host;
}
my $popen_str = '|'.$mailapp.' -f "'.$sender.'" ';
my @recipients = split ',', $recipient;
my $r;
foreach $r (@recipients){
# make sure it's not a fake recipient e-mail address, if so then
# we may as well bomb...
if($r !~ /^[[0-9]|[a-z]|\-|\_|\.]{2,}\@[[0-9]|[a-z]|\-]+\.[[0-9]|[a-z]|\-|\.]+$/gis) { &bad_recipient; }
$r =~ s/(^\s)|(\s$)//g;
if($r =~ m/\`/) { next; }
$popen_str .= ' "'.$r.'"';
}
open OPIP, $popen_str
or &cant_send('viaapp');
my $buf = "From: ".$sender."\n".
"Subject: ".$subject."\n".
"Date: ".$senttime."\n".
"To: ".$recipient."\n".
"MIME-Version: 1.0\n".
"Content-type: multipart/mixed; charset=US-ASCII; boundary=".$boundary."\n\n".
"--".$boundary."\n".
"Content-Type: text/".$email_type."; charset=US-ASCII\n\n".
$message;
if($numfileattachments) { $buf .= $attachments; }
#$buf .= "\n".$boundary."\n\n";
$buf =~ s/\n\.\n/\n\n/g;
$buf .= "\n\.\n";
print OPIP $buf;
close OPIP;
}
sub sendmail_smtp {
if(!$recipient){ &no_recipient; }
if(!$subject){ $subject = "Inquiry from "; }
my $host = $ENV{'HTTP_HOST'};
if($host eq '') {
$host = $recipient;
$host =~ s/^.*\@//g;
$host =~ s/,.*$//g;
} else {
$host =~ s/^www\.//i;
}
if(!$sender){ $sender = "noreply\@".$host; }
my $osock;
my $tmp;
my $dat = '';
my $proto = getprotobyname('tcp');
socket($osock, PF_INET, SOCK_STREAM, $proto)
or &cant_send('viasmtp');
my $sin = sockaddr_in(25, inet_aton($smtp));
connect($osock,$sin)
or &cant_send('viasmtp');
sysread $osock, $tmp, 2048;
# 220 xxxx.xxx ESMTP Sendmail x.x.x/x.x.x; Time/Date
if($tmp !~ m/^220/ and $strict_smtp == 1){ &smtp_error; }
$dat .= $tmp;
# $buf = "helo ".$host."\nmail from: ".$sender."\n";
syswrite $osock, "HELO ".$host."\r\n", length("HELO ".$host."\r\n");
sysread $osock, $tmp, 2048;
# 250 xxxx.xxx Hello <hostname> [xxx.xxx.xxx.xxx], pleased to meet you
if($tmp !~ m/^250/ and $strict_smtp == 1){ &smtp_error; }
$dat .= $tmp;
syswrite $osock, "MAIL FROM: ".$sender."\r\n", length("MAIL FROM: ".$sender."\r\n");
sysread $osock, $tmp, 2048;
# 250 xxx@xxxxxxxxxx... Sender ok
if($tmp !~ m/^250/ and $strict_smtp == 1){ &smtp_error; }
$dat .= $tmp;
my @recipients = split ',', $recipient;
foreach $recipient (@recipients){
$recipient =~ s/(^\s)|(\s$)//g;
syswrite $osock, "RCPT TO: ".$recipient."\r\n", length("RCPT TO: ".$recipient."\r\n");
sysread $osock, $tmp, 2048;
# 250 xxx@xxxxxxx... Recipient ok
if($tmp !~ m/^250/ and $strict_smtp == 1){ &smtp_error; }
$dat .= $tmp;
# $buf .= "rcpt to: ".$recipient."\n";
}
syswrite $osock, "DATA\r\n", 5;
sysread $osock, $tmp, 2048;
# 354 Enter mail, end with "." on a line by itself
if($tmp !~ m/^354/ and $strict_smtp == 1){ &smtp_error; }
$dat .= $tmp;
# $buf .= "data\n".
my $buf = "Subject: ".$subject."\n".
"Date: ".$senttime."\n".
"To: ".$recipient."\n".
"MIME-Version: 1.0\n".
"Content-type: multipart/mixed; charset=US-ASCII; boundary=".$boundary."\n\n".
"--".$boundary."\n".
"Content-Type: text/".$email_type."; charset=US-ASCII\n\n".
$message;
if($numfileattachments) { $buf .= $attachments; }
#$buf .= "\n".$boundary."\n";
$buf =~ s/\n\.\n/\n\n/g;
$buf .= "\n\.\n";
my $off = 0;
my $len = length $buf;
while($len){
my $w = syswrite $osock, $buf, $len, $off;
$len -= $w;
$off += $w;
}
sysread $osock, $tmp, 2048;
if($tmp !~ m/^250/ and $strict_smtp == 1){ &smtp_error; }
$dat .= $tmp;
syswrite $osock, "QUIT\r\n", 5;
close($osock);
}
sub check_details {
if($referer_check > 0) {
if(!$ENV{'HTTP_REFERER'} and $referer_check == 1) { return; }
# perform the check
my $referer = $ENV{'HTTP_REFERER'};
my $ref;
foreach $ref (@referers){ if($referer =~ m/^(http:\/\/)?($ref)/i or $referer =~ m/^(https:\/\/)?($ref)/i) { return; } }
&unauth_ref;
}
}
sub get_details {
if($recipient eq '') { $recipient = param('recipient'); }
$required = param('required');
$sender = param('sender');
$subject = param('subject');
$redirect = param('redirect');
my @required_fields = split ",", $required;
foreach (@required_fields){
$_ =~ s/(^\s)|(\s$)//g;
if(!param($_)){ &incomplete; }
}
my $fu = param("fileuploads");
if($fu =~ m/\,/){
@fileuploads = split ",", $fu;
} else {
$fileuploads[0] = $fu;
}
}
sub exists_in_array {
my ($scalar, @array) = @_;
foreach (@array){
if($_ eq $scalar) {
return 1;
}
}
return 0;
}
sub return_filename {
my ($fn) = @_;
if($fn =~ m/^\//){
$fn =~ s/^(.+)\///g;
} else {
$fn =~ s/^(.+)\\//g;
}
return $fn;
}
sub base64_encode {
my ($data) = @_;
my @base64_alpha = ('A','B','C','D','E','F','G','H','I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z','0','1', '2','3','4','5','6','7','8','9','+','/' );
my $out = '';
my $ldata = 0;
my $rem = 0;
$ldata = length $data;
$rem = $ldata % 3;
if($rem > 0){
$data .= chr(0) x (3-$rem);
$ldata = length $data;
}
my $tl = $ldata / 3;
my $p;
for($p=0; $p<$tl; $p++){
my $tri1 = ord(substr($data,0,1));
my $tri2 = ord(substr($data,1,1));
my $tri3 = ord(substr($data,2,1));
$data = substr($data, 3);
$out .= $base64_alpha[($tri1&0xfc)>>2];
$out .= $base64_alpha[(($tri1&0x03)<<4) | (($tri2&0xf0)>>4)];
$out .= $base64_alpha[(($tri2&0x0f)<<2) | (($tri3&0xc0)>>6)];
$out .= $base64_alpha[$tri3&0x3f];
}
if($rem > 0){
$rem = 3 - $rem;
$out =~ s/A{$rem}$//;
$out .= '=' x $rem;
}
my $l;
my $sout = '';
for($l=0; $l<length $out; $l+=76) { $sout .= substr($out, $l, 76)."\n"; }
$sout .= substr($out, $l-76, 76-$l);
return $sout;
}
sub handle_uploads {
if($upload_files == 0){
foreach (@fileuploads){
if(length param($_)) {
my $fileh = param($_);
my $fd = join '', <$fileh>;
my $filename = return_filename($fileh);
$numfileattachments++;
if($gpg_use == 1) {
$fd = gpg_encrypt $fd;
$filename .= '.gpg';
}
$filename =~ s/\s/_/g;
$attachments .= "\n--".$boundary."\n".
"Content-Type: octet/stream; name=".$filename."\n".
"Content-Transfer-Encoding: BASE64\n".
"Content-Description:\n".
"Content-Disposition: attachment; filename=".$filename."\n\n".
base64_encode($fd)."\n";
}
}
} else {
foreach (@fileuploads){
if(length param($_)) {
my $fileh = param($_);
my $fd = join '', <$fileh>;
my $filename = return_filename($fileh);
my $time = &time;
while(mkdir($upload_dir.'mail'.$time, '755') == 0) {
$message .= "\n(tried to create a directory for files called ${upload_dir}mail${time} but couldn't! \$! = $!\n";
$time = &time;
}
my $savepath = $upload_dir.'mail'.$time.substr($upload_dir, -1).$filename;
open SAVETO, '>'.$savepath or $message .= "\ntried to upload file ".$filename.", but couldn't !!!\n"; &continue;
syswrite SAVETO, $fd;
close SAVETO;
$message .= "Uploaded file to : ".$savepath."\n";
}
}
}
}
sub message_construct {
my @params = param;
$message = $email_format;
# make all necessary variable exchanges
while($message =~ m/<\$([0-9]|[a-z]|[A-Z]|_|\-|!>)+>/gc) {
my $var = $&;
$var =~ s/^(<\$)|>$//g;
my $val = '['.$var.' - undefined]';
# firstly, is it an internal variable?
if($var eq 'senttime') {
$val = &senttime;
} elsif ($var eq 'all_vars') {
$val = '';
my $key;
foreach $key (@params) { $val .= "\"$key\" => \"".param($key)."\"\n"; }
} else {
# the variable is POST or GET, swap it
if(defined param($var)) {
$val = param($var);
} else {
# hrm, is it an environment variable?
if(defined $ENV{$var}) {
# yup, make the change
$val = $ENV{$var};
} else {
# is it a cookie?
if(defined cookie($var)) {
# yay
$val = cookie($var);
}
}
}
}
$message =~ s/<\$$var>/$val/g;
}
$message =~ s/\n/\r\n/g;
if($gpg_use == 1) { $message = gpg_encrypt $message; }
}