#!/usr/bin/perl -w
use strict;
use Socket;
use vars qw/
$SENDMAIL $SMTP_SERVER
$ENDLINE $MAXNUM $LOGDIR
$JUMP_TO %FIELDS /;
=CONFIGURATION NOTES
$END_LINE is the very last line printed in the e-mail.
$LOGDIR is the directory where the program's logs will be written.
It must be a directory path on your server (not a url).
ex-
$LOGDIR = '.'; (save the log in the same directory as this script)
$LOGDIR = '..'; (save the log one directory up)
$LOGDIR = 'some/directory';
If you would like to navigate to the log page from your web browser,
use your www directory for the $LOGDIR, so you can point your
browser to the directory and look at your logs. !!!REMEMBER - If
the directory isn't chmod'ed to the correct permissions level,
this program won't be able to create and maintain its logs and
they won't be saved there.
$MAXNUM is the number of possible people a person can refer
your URL to at one time. If you call the script using the
GET method, then this is also the number of entry blanks
created for recipient names and addresses.
$SMTP_SERVER is the name of your e-mail gateway server, or
SMTP host. On most systems, "localhost" will work just fine.
If not, change "localhost" to whatever your ISP's SMTP
server name is, ie, smtp.isp.net or mail.isp.net
$SENDMAIL is the full path to your server's sendmail program
If you do not wish to use Sockets for some reason and need
to use sendmail, uncomment the $SENDMAIL line and comment
the $SMTP_SERVER line.
Use either $SMTP_SERVER="localhost"; -OR- $SENDMAIL="/usr/lib/sendmail -t";
BUT NEVER BOTH!!!!!! Use the setting you need and leave the other one blank
by using an empty set of quotation marks followed by a semicolon (eg- "";)
Single quotes are fine too (eg- '';)
=cut
# -------/ CONFIGURATION SETTINGS /---------------------------------------------
# $LOGDIR = 'some/directory/on/your/server/';
$LOGDIR = '';
$ENDLINE = '';
$MAXNUM = 3;
$SMTP_SERVER = 'localhost';
$SENDMAIL = '';
# --------------------------------------------/ DONE WITH CONFIGURATION /-------
my ($self) = [ split(/\/|\\|\:/,__FILE__) ]->[-1];
my ($host) = $ENV{'HTTP_HOST'} || 'localhost';
my ($site) = qq[http://$host];
my ($prev) = $ENV{'HTTP_REFERER'} || $site;
&test_sendmail if $SENDMAIL;
&decode_vars;
if ($ENV{'REQUEST_METHOD'} || '' ne 'POST') { &draw_request and exit }
&process_mail;
&do_log;
print "Location: $JUMP_TO\n\n";
sub process_mail
{
for (my ($i) = 1 ; $i <= $MAXNUM ; $i++)
{
my ($recipname) = "recipname_$i";
my ($recipemail) = "recipemail_$i";
next
unless $FIELDS{ $recipemail }
&& &valid_address($FIELDS{ $recipemail });
my ($subject) =
qq[website referal from ${\ $FIELDS{'send_name'} || 'your friend' }];
my ($msgtxt) = <<__END_OF_EMAIL__;
Hi ${\ $FIELDS{ 'recipname_' . $i } || 'there' },
${\ $FIELDS{'send_name'} || 'one of your friends' } stopped by
$host and suggested that you visit the following URL:
$JUMP_TO
__END_OF_EMAIL__
$msgtxt .= "Here is their message....\n$FIELDS{'message'}\n\n"
if $FIELDS{'message'};
$msgtxt .= "$host\n$ENDLINE\n$site\n\n";
my ($mailresult) =
&sendmail($FIELDS{send_email}, $FIELDS{send_email},
$FIELDS{'recipemail_' . $i},
$SMTP_SERVER, $subject, $msgtxt);
if ($mailresult ne "1")
{
print "Content-type: text/html\n\n";
print "MAIL NOT SENT. SMTP ERROR: $mailresult\n";
exit;
}
}
}
sub draw_request
{
print "Content-type: text/html\n\n";
# BNB SAYS! Here is the part that draws the page that asks the
# reader to enter e-mail addresses and names. Tailor it to meet
# your needs if necessary. DO NOT disturb the lines with
# __REQUEST__ on them.
print <<__REQUEST__;
<BODY BGCOLOR="#FFFFFF">
<CENTER>
<P>
<TABLE WIDTH=550 BGCOLOR="CCE6FF">
<TR>
<TD>
<FONT FACE="ARIAL" SIZE=4 COLOR="#009999">
<B>
<CENTER>
SUGGEST THIS PAGE TO A FRIEND...<P>
<A HREF="$prev">$prev</A>
</CENTER>
</B>
</FONT>
<BLOCKQUOTE>
<FONT FACE="ARIAL" SIZE=2 COLOR="#000000">
If you have a friend that you would like to recommend this page to,
or if you just want to send yourself a reminder, here is the easy
way to do it!
<P>
Simply fill in the e-mail address of the person(s) you wish to tell
about $host, your name and e-mail address (so they do
not think it is spam or reply to us with gracious thanks),
and click the <B>SEND</B> button.
If you want to, you can also enter a message that will be included
on the e-mail.
<P>
After sending the e-mail, you will be transported back to the
page you recommended!
</FONT>
<FORM METHOD="POST" ACTION="$self">
<INPUT TYPE="HIDDEN" NAME="call_by" VALUE=$prev>
<TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 >
<TR>
<TD> </TD>
<TD ALIGN=CENTER><B>Name</B></TD>
<TD ALIGN=CENTER><B>E-Mail Address</B><TD>
</TR>
<TR>
<TD><B>You</B></TD>
<TD><INPUT TYPE="TEXT" NAME="send_name"></TD>
<TD><INPUT TYPE="TEXT" NAME="send_email"></TD>
</TR>
__REQUEST__
for (my ($i) = 1 ; $i <= $MAXNUM ; $i++)
{
print <<__STOP_OF_ROW__;
<TR>
<TD><B>Friend $i</B></TD>
<TD><INPUT TYPE="TEXT" NAME="recipname_$i"></TD>
<TD><INPUT TYPE="TEXT" NAME="recipemail_$i"></TD>
</TR>
__STOP_OF_ROW__
}
print <<__REQUEST2__;
<TR>
<TD> </TD>
<TD ALIGN=CENTER COLSPAN=2>
<B>Your Message</B><BR>
<textarea name="message" wrap=virtual rows=5 cols=35></textarea>
<BR>
<INPUT TYPE="submit" VALUE="SEND">
</TD>
</TR>
</TABLE>
</FORM>
</BLOCKQUOTE>
<CENTER>
<FONT SIZE="-1">
Free recommendation script created by<BR>
</FONT>
<A HREF="http://bignosebird.com/"><B>BigNoseBird.Com</B></A><BR>
<FONT SIZE="-1">
<I>The Strangest Name in Free Web Authoring Resources<I><BR>
</FONT>
<P>
</CENTER>
</TD>
</TR>
</TABLE>
__REQUEST2__
}
sub decode_vars
{
my ($i) = 0;
my ($temp) = '';
if ($ENV{'REQUEST_METHOD'} || '' eq "GET") { $temp = $ENV{'QUERY_STRING'} }
else { read(STDIN, $temp, $ENV{'CONTENT_LENGTH'} || 0) }
my (@pairs) = split (/&/, $temp);
foreach (@pairs)
{
my ($item) = $_;
my ($key, $content) = split (/=/, $item, 2);
$content =~ tr/+/ /;
$content =~ s/%(..)/pack("c",hex($1))/ge;
$content =~ s/\012//gs;
$content =~ s/\015/ /gs;
$FIELDS{$key} = $content;
}
$JUMP_TO = $FIELDS{'call_by'};
$JUMP_TO ||= $prev;
}
sub valid_address
{
my ($testmail) = shift (@_);
if ( $testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/
|| $testmail !~
/^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/)
{
return 0;
}
1;
}
sub test_sendmail
{
return if -e $SENDMAIL;
print "Content-type: text/html\n\n";
print "<H2>SENDMAIL NOT FOUND. PLEASE CHECK YOUR PROGRAM SETTINS</H2>";
exit;
}
sub do_log
{
my ($date) = scalar localtime;
my ($year) = (localtime)[5] + 1900;
my ($month) = {qw/
1 January
2 February
3 March
4 April
5 May
6 June
7 July
8 August
9 September
10 October
11 November
12 December
/}->{ (localtime)[4] + 1 };
$LOGDIR =~ s/(?:\/|\\)+\z//;
my ($totals) = qq[$LOGDIR/$month-$year-totals.txt];
my ($log) = qq[$LOGDIR/tell-a-friend-log.txt];
local(*LOG); open(LOG, ">$totals") unless -e $totals; open(LOG, "<$totals");
my ($count) = [ <LOG> ]->[1] || 0;
my ($initial) = $count;
for (my ($i) = 1 ; $i <= $MAXNUM ; $i++)
{
my ($recipname) = "recipname_$i";
my ($recipemail) = "recipemail_$i";
next unless $FIELDS{ $recipemail }
&& &valid_address($FIELDS{ $recipemail });
++$count;
}
if ($count > $initial) { open(LOG, ">$totals"); print LOG <<__TOTALS__ }
Total "tell-a-friend" emails sent in $month of $year:
$count
-----
__TOTALS__
# close(ZL); # old style
close(LOG);
`cat $LOGDIR/*-totals.txt >$log`;
}
sub sendmail
{
# error codes below for those who bother to check result codes <gr>
# 1 success
# -1 $smtphost unknown
# -2 socket() failed
# -3 connect() failed
# -4 service not available
# -5 unspecified communication error
# -6 local user $to unknown on host $smtp
# -7 transmission of message failed
# -8 argument $to empty
#
# Sample call:
# &sendmail($from, $reply, $to, $smtp, $subject, $message );
#
# Note that there are several commands for cleaning up possible bad inputs -
# if you are hard coding things from a library file, so of those are
# unnecesssary
my ($fromaddr, $replyaddr, $to, $smtp, $subject, $message) = @_;
$to =~ s/[ \t]+/, /g; # pack spaces and add comma
$fromaddr =~ s/.*<([^\s]*?)>/$1/; # get from email address
$replyaddr =~ s/.*<([^\s]*?)>/$1/; # get reply email address
$replyaddr =~ s/^([^\s]+).*/$1/; # use first address
$message =~ s/^\./\.\./gm; # handle . as first character
$message =~ s/\r\n/\n/g; # handle line ending
$message =~ s/\n/\r\n/g;
$smtp =~ s/^\s+//g; # remove spaces around $smtp
$smtp =~ s/\s+$//g;
return (-8) unless $to;
if ($SMTP_SERVER ne "")
{
my ($proto) = (getprotobyname('tcp'))[2];
my ($port) = (getservbyname('smtp', 'tcp'))[2];
my ($smtpaddr) =
($smtp =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
? pack('C4', $1, $2, $3, $4)
: (gethostbyname($smtp))[4];
if (!defined($smtpaddr))
{
return (-1);
}
if (!socket(MAIL, AF_INET, SOCK_STREAM, $proto))
{
return (-2);
}
if (!connect(MAIL, pack('Sna4x8', AF_INET, $port, $smtpaddr)))
{
return (-3);
}
my ($oldfh) = select(MAIL);
$| = 1;
select($oldfh);
$_ = <MAIL>;
if (/^[45]/)
{
close(MAIL);
return (-4);
}
print MAIL "helo $SMTP_SERVER\r\n";
$_ = <MAIL>;
if (/^[45]/)
{
close(MAIL);
return (-5);
}
print MAIL "mail from: <$fromaddr>\r\n";
$_ = <MAIL>;
if (/^[45]/)
{
close(MAIL);
return (-5);
}
foreach (split (/, /, $to))
{
print MAIL "rcpt to: <$_>\r\n";
$_ = <MAIL>;
if (/^[45]/)
{
close(MAIL);
return (-6);
}
}
print MAIL "data\r\n";
$_ = <MAIL>;
if (/^[45]/)
{
close MAIL;
return (-5);
}
}
if ($SENDMAIL ne "")
{
open(MAIL, "| $SENDMAIL");
}
print MAIL "To: $to\n";
print MAIL "From: $fromaddr\n";
print MAIL "Reply-to: $replyaddr\n" if $replyaddr;
print MAIL "X-Mailer: Perl Powered Socket Mailer\n";
print MAIL "Subject: $subject\n\n";
print MAIL "$message";
print MAIL "\n.\n";
if ($SMTP_SERVER ne "")
{
$_ = <MAIL>;
if (/^[45]/)
{
close(MAIL);
return (-7);
}
print MAIL "quit\r\n";
$_ = <MAIL>;
}
close(MAIL);
return (1);
}