oliverkazaam41
08-27-2007, 04:37 PM
Hi I have this script for postcard. I can't run it I have edited all the fields that needs to be edited but still it gives me an Internal server error. The permission is 755. Please could somebody help me with this. here are the codes.
#!/usr/bin/perl
#set the line above this to your perl path. Usually fine as is
# or /usr/local/bin/perl /sbin/perl
# make certain that the first line stays the first line!
##################################################################
# (C)1998-2002 Bignosebird.com cardcgi v2.1
# This software is FREEWARE! Do with it as you wish. It is yours
# to share and enjoy. Modify it, improve it, and have fun with it!
# It is distributed strictly as a learning aid and bignosebird.com
# disclaims all warranties- including but not limited to:
# fitness for a particular purpose, merchantability, loss of
# business, harm to your system, etc... ALWAYS BACK UP YOUR
# SYSTEM BEFORE INSTALLING ANY SCRIPT OR PROGRAM FROM ANY
# SOURCE!
use Socket;
$|=1;
#### PROGRAM CONFIGURATION SECTION ############################
#
# Modify each item below to meet your needs.
#
# DAYS: number of days to keep cards before purging
# SMTP_SERVER: the name of the system acting as your sendmail gateway
# localhost should work on most systems.
# IF NOT- SET THE SEND_MAIL VARIABLE!
# BASEDIR is the unix directory that your greeting cards will
# be stored in.
# BASEURL is the URL (http address) of the directory your cards
# will be stored in.
# SITEURL is the home page URL for your site.
# SITENAME is the Name of your site, ie Title
# EXT is the ending name for your card files. NEVER, EVER USE shtml!!
# PROGNAME is the URL of THIS script.
# MAILLOG is a file name that you can capture e-mail addresses in
# FOR SECURITY REASONS: RENAME THIS FILE!!!!!!!!
# okaydomains are (if specified, the ONLY domains that the script
# can be run from. If left empty, anyone could run your script,
# but they wouldn't see any graphics!!! If your site answers to
# both www.domain.com and domain.com, then use both!
#
@okaydomains=("http://thefarm.com.ph", "http://www.thefarm.com.ph");
$DAYS=11;
# USE EITHER SMTP OR SEND_MAIL DEPENDING ON YOUR SYSTEM-
# BUT NOT BOTH!
$SMTP_SERVER="localhost";
#$SEND_MAIL="/usr/sbin/sendmail -t";
$BASEDIR="/home/thefarm/public_html/betasite/cardcgi/cardcgi";
$BASEURL="http://thefarm.com.ph/betasite/cardcgi/cardcgi";
$SITEURL="http://thefarm.com.ph/";
$SITENAME="thefarm.com.ph";
$EXT=".html";
$PROGNAME="/cgi-bin/card.cgi";
$MAILLOG="/cgi-bin/maillog";
$SUBJECT ="You have a virtual card waiting for you!";
###############################################################
&main_driver;
###############################################################
#
# Now go thru the program looking for the string "BNB SAYS!"
# to locate other changes you should make, such as wording of
# the notification e-mail and "plug" for the site.
#
# to keep things simple, the field names are hard coded in.
# you can of course modify what you wish.
###############################################################
sub thank_you
{
if ($MAILLOG ne "")
{
open (ML,">>$BASEDIR/$MAILLOG");
print ML "$fields{'recip_email'}\n";
print ML "$fields{'sender_email'}\n";
close(ML);
}
print "Content-type: text/html\n\n";
print <<__STOP_OF_THANKS__;
<CENTER>
<H1><B>THANKS!</B></H1>
Your card notification has been sent to $fields{'recip_name'}<BR>
The URL of this card is<P>
<A HREF="$URL_NAME">$URL_NAME</A>
<P>
<B><A HREF=$fields{'parent'}>RETURN TO CARD CREATOR</A></B>
<P>
__STOP_OF_THANKS__
}
# BNB SAYS!
# THIS IS WHERE YOU CAN CUSTOMIZE YOUR NOTIFICATION LETTER
# DO NOT TOUCH THE TWO LINES WITH __STOP_OF_MESSAGE__ ON
# THEM!!!!
sub setup_letter
{
$msgtext =<<__STOP_OF_MESSAGE__;
Hi,
$fields{'sender_name'} stopped by my site, $SITENAME
and created a Virtual Card just for you! To pick up your
card, simply point your browser at the page listed below.
$URL_NAME
The card will remain on the server for about one week, so
please print it out or save it as soon as you can.
__STOP_OF_MESSAGE__
}
# BNB SAYS!
# This is what makes up the body of your card. DO NOT REMOVE OR
# MODIFY THE LINES ABOVE THE WORD $param or the $param line
# itself. Doing so will cause the script to fail.
sub make_body
{
$cardbody =<<__END_OF_CARD_BODY__;
<SCRIPT LANGUAGE="JavaScript">
<!--
if(navigator.userAgent.indexOf("MSIE") != -1)
document.writeln ('');
else
document.writeln ('<EMBED SRC="$BASEURL/$fields{'midifile'}" AUTOSTART="true" HIDDEN="true" VOLUME="80%">');
//-->
</SCRIPT>
<style type="text/css">
<!--
body {
margin-left: 0px;
margin-top: 0px;
background-color: #FFFFFF;
}
.style1 {
font-family: "Trebuchet MS";
font-weight: bold;
font-size: 12px;
}
.style4 {
font-family: "Century Gothic";
font-size: 12px;
color: #66CC00;
}
-->
</style>
<BODY>
<TABLE WIDTH=584 BORDER=0 cellpadding="0" cellspacing="0" BGCOLOR="#FFFFF">
<TR>
<TD height="5" colspan="3" ALIGN=CENTER VALIGN=CENTER><img src="spacer.jpg" width="1" height="1"></TD>
<TR>
<TD width="5" ALIGN=CENTER VALIGN=CENTER> </TD>
<TD width="563" ALIGN=CENTER VALIGN=CENTER><IMG SRC=$BASEURL/$fields{'pic_select'} WIDTH=100% HEIGHT=100% BORDER=0></TD>
<TD width="5" ALIGN=CENTER VALIGN=CENTER> </TD>
<TR>
<TD height="5" colspan="3" ALIGN=CENTER VALIGN=CENTER><img src="spacer.jpg" width="1" height="1"></TD>
</TABLE>
<br>
<table width="584" border="0" cellpadding="0" cellspacing="0">
<tr>
<td width="137" valign="top"><span class="style1">From</span></td>
<td width="447"><span class="style4">$fields{'sender_name'}</span></td>
</tr>
<tr>
<td valign="top" class="style1">Email Address</td>
<td class="style4">$fields{'sender_email'}</td>
</tr>
<tr>
<td valign="top" class="style1">Subject</td>
<td class="style4"><div align="justify">$fields{'the_title'}</div></td>
</tr>
<tr>
<td valign="top" class="style1">Message</td>
<td class="style4"><div align="justify">$fields{'the_message'}</div></td>
</tr>
</table>
<p><BR>
<TABLE WIDTH=586 BGCOLOR="#FFFFF" BORDER=0>
</p>
<TR>
<TD> </TD>
<TD>
$fields{'sender_name'}
</TD>
</TR>
<TR>
<TD>
Sender's Email:
</TD>
<TD>
$fields{'sender_email'}
</TD>
</TR>
<TR>
<TD>
Message:
</TD>
<TD>
$fields{'the_message'}
</TD>
</TR>
$params
</BODY>
</HTML>
__END_OF_CARD_BODY__
}
sub pass_params
{
$params=<<__END_OF_PARAMS__;
<CENTER>
<TABLE WIDTH=500>
<TR>
<TD>
<FONT FACE="ARIAL">
<BR>Please press the send button to send the card. <BR> Press back to edit again.
<P>
<CENTER>
<FORM METHOD="POST" ACTION="$PROGNAME">
<INPUT TYPE="HIDDEN" NAME="action_code" VALUE="SENDCARD">
<INPUT TYPE="HIDDEN" VALUE="$fields{'pic_select'}" NAME="pic_select">
<INPUT TYPE="HIDDEN" VALUE="$fields{'sender_name'}" NAME="sender_name">
<INPUT TYPE="HIDDEN" VALUE="$fields{'sender_email'}" NAME="sender_email">
<INPUT TYPE="HIDDEN" VALUE="$fields{'recip_name'}" NAME="recip_name">
<INPUT TYPE="HIDDEN" VALUE="$fields{'recip_email'}" NAME="recip_email">
<INPUT TYPE="HIDDEN" VALUE="$fields{'text_color'}" NAME="text_color">
<INPUT TYPE="HIDDEN" VALUE="$fields{'back_color'}" NAME="back_color">
<INPUT TYPE="HIDDEN" VALUE="$fields{'the_title'}" NAME="the_title">
<INPUT TYPE="HIDDEN" VALUE="$fields{'the_message'}" NAME="the_message">
<INPUT TYPE="HIDDEN" VALUE="$fields{'sig_line'}" NAME="sig_line">
<INPUT TYPE="HIDDEN" VALUE="$fields{'midifile'}" NAME="midifile">
<INPUT TYPE="HIDDEN" VALUE="$fields{'background'}" NAME="background">
<INPUT TYPE="HIDDEN" VALUE="$ENV{'HTTP_REFERER'}" NAME="parent">
<INPUT TYPE="submit" VALUE="SEND-CARD">
</FORM>
</CENTER>
</TD>
</TR>
</TABLE>
__END_OF_PARAMS__
}
###################################################################
###################################################################
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;
if (!$to)
{
return(-8);
}
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 ($SEND_MAIL ne "")
{
open (MAIL,"| $SEND_MAIL");
}
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);
}
sub no_email
{
print <<__STOP_OF_NOMAIL__;
Content-type: text/html
<FONT SIZE="+1">
<B>
SORRY! Your request could not be processed because of missing
e-mail address(es). Please use your browser's back button to
return to the card entry page.
</B>
</FONT>
__STOP_OF_NOMAIL__
}
sub send_mail
{
&setup_letter;
$mailresult=&sendmail($fields{sender_email}, $fields{sender_email}, $fields{recip_email}, $SMTP_SERVER, $SUBJECT, $msgtext);
}
sub card_expire
{
local(@items, $item);
opendir(CARDDIR, "$BASEDIR");
@items = grep(/[0-9]$EXT/,readdir(CARDDIR));
closedir(CARDDIR);
foreach $item (@items)
{
if (-M "$BASEDIR/$item" > $DAYS)
{
unlink("$BASEDIR/$item");
}
}
}
##################################################################
sub valid_address
{
$testmail = $fields{'recip_email'};
if ($testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||
$testmail !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)$/)
{
return 0;
}
else
{
return 1;
}
}
sub bad_email
{
print <<__STOP_OF_BADMAIL__;
Content-type: text/html
<FONT SIZE="+1">
<B>
SORRY! Your request could not be processed because of an improper
recipient's e-mail address. Please use your back button to return
to the card screen and try again!
</B>
</FONT>
__STOP_OF_BADMAIL__
}
sub test_basedir
{
if (not -w $BASEDIR)
{
print <<__STOP_OF_BADBASE__;
Content-type: text/html
<FONT SIZE="+1">
<B>
The script cannot either find or write to the<BR>
$BASEDIR directory. Please check this setting if
the BASEDIR variable, and the permissions of the
directory. If you have them set to 755, please
change them to 777.
</B>
</FONT>
__STOP_OF_BADBASE__
exit;
}
}
##################################################################
sub valid_page
{
if (@okaydomains == 0) {return;}
$DOMAIN_OK=0;
$RF=$ENV{'HTTP_REFERER'};
$RF=~tr/A-Z/a-z/;
foreach $ts (@okaydomains)
{
if ($RF =~ /$ts/)
{ $DOMAIN_OK=1; }
}
if ( $DOMAIN_OK == 0)
{ print "Content-type: text/html\n\n Sorry, cant run it from here....";
exit;
}
}
sub decode_vars
{
#This part of the program splits up our data and gets it
#ready for formatting.
$i=0;
read(STDIN,$temp,$ENV{'CONTENT_LENGTH'});
@pairs=split(/&/,$temp);
foreach $item(@pairs)
{
($key,$content)=split(/=/,$item,2);
$content=~tr/+/ /;
$content=~s/%(..)/pack("c",hex($1))/ge;
$content=~s/\0//g; #strip nulls
$content =~ s/<!--(.|\n)*-->//g;
$fields{$key}=$content;
$i++;
$item{$i}=$key;
$response{$i}=$content;
}
}
sub get_file_name
{
$proc=$$;
$newnum=time;
$newnum=substr($newnum,4,5);
$date=localtime(time);
($day, $month, $num, $time, $year) = split(/\s+/,$date);
$month=~tr/A-Z/a-z/;
$PREF = "$month$num";
$FILE_NAME="$BASEDIR/$PREF$newnum$proc$EXT";
$URL_NAME="$BASEURL/$PREF$newnum$proc$EXT";
}
#Write out our HTML FILE
sub create_file
{
open(OUTFILE,">$FILE_NAME") ;
print OUTFILE "$cardbody\n";
close (OUTFILE);
}
#Set up our HTML Preview Form
sub do_preview
{
$fields{'the_message'} =~s/\"/\'/g;
&pass_params;
&make_body;
print "Content-type: text/html\n\n";
print "$cardbody\n";
}
sub main_driver
{
&valid_page;
&test_basedir;
&decode_vars;
if ($fields{'recip_email'} eq "")
{ &no_email; exit; }
if (&valid_address == 0)
{ &bad_email; exit; }
if ($fields{'sender_email'} eq "")
{ &no_email; exit; }
if ($fields{'background'} ne "")
{ $BODYTAG="<BODY BACKGROUND=\"$BASEURL/$fields{'background'}\">";}
else { $BODYTAG="<BODY BGCOLOR=\"\">"; }
if ($fields{'action_code'} eq "NEW")
{ &do_preview; }
if ($fields{'action_code'} eq "SENDCARD")
{
&make_body;
&get_file_name;
&create_file;
&setup_letter;
$mailresult=&sendmail($fields{sender_email}, $fields{sender_email}, $fields{recip_email}, $SMTP_SERVER, $SUBJECT, $msgtext);
&thank_you;
if ($DAYS > 0)
{&card_expire;}
}
}
#!/usr/bin/perl
#set the line above this to your perl path. Usually fine as is
# or /usr/local/bin/perl /sbin/perl
# make certain that the first line stays the first line!
##################################################################
# (C)1998-2002 Bignosebird.com cardcgi v2.1
# This software is FREEWARE! Do with it as you wish. It is yours
# to share and enjoy. Modify it, improve it, and have fun with it!
# It is distributed strictly as a learning aid and bignosebird.com
# disclaims all warranties- including but not limited to:
# fitness for a particular purpose, merchantability, loss of
# business, harm to your system, etc... ALWAYS BACK UP YOUR
# SYSTEM BEFORE INSTALLING ANY SCRIPT OR PROGRAM FROM ANY
# SOURCE!
use Socket;
$|=1;
#### PROGRAM CONFIGURATION SECTION ############################
#
# Modify each item below to meet your needs.
#
# DAYS: number of days to keep cards before purging
# SMTP_SERVER: the name of the system acting as your sendmail gateway
# localhost should work on most systems.
# IF NOT- SET THE SEND_MAIL VARIABLE!
# BASEDIR is the unix directory that your greeting cards will
# be stored in.
# BASEURL is the URL (http address) of the directory your cards
# will be stored in.
# SITEURL is the home page URL for your site.
# SITENAME is the Name of your site, ie Title
# EXT is the ending name for your card files. NEVER, EVER USE shtml!!
# PROGNAME is the URL of THIS script.
# MAILLOG is a file name that you can capture e-mail addresses in
# FOR SECURITY REASONS: RENAME THIS FILE!!!!!!!!
# okaydomains are (if specified, the ONLY domains that the script
# can be run from. If left empty, anyone could run your script,
# but they wouldn't see any graphics!!! If your site answers to
# both www.domain.com and domain.com, then use both!
#
@okaydomains=("http://thefarm.com.ph", "http://www.thefarm.com.ph");
$DAYS=11;
# USE EITHER SMTP OR SEND_MAIL DEPENDING ON YOUR SYSTEM-
# BUT NOT BOTH!
$SMTP_SERVER="localhost";
#$SEND_MAIL="/usr/sbin/sendmail -t";
$BASEDIR="/home/thefarm/public_html/betasite/cardcgi/cardcgi";
$BASEURL="http://thefarm.com.ph/betasite/cardcgi/cardcgi";
$SITEURL="http://thefarm.com.ph/";
$SITENAME="thefarm.com.ph";
$EXT=".html";
$PROGNAME="/cgi-bin/card.cgi";
$MAILLOG="/cgi-bin/maillog";
$SUBJECT ="You have a virtual card waiting for you!";
###############################################################
&main_driver;
###############################################################
#
# Now go thru the program looking for the string "BNB SAYS!"
# to locate other changes you should make, such as wording of
# the notification e-mail and "plug" for the site.
#
# to keep things simple, the field names are hard coded in.
# you can of course modify what you wish.
###############################################################
sub thank_you
{
if ($MAILLOG ne "")
{
open (ML,">>$BASEDIR/$MAILLOG");
print ML "$fields{'recip_email'}\n";
print ML "$fields{'sender_email'}\n";
close(ML);
}
print "Content-type: text/html\n\n";
print <<__STOP_OF_THANKS__;
<CENTER>
<H1><B>THANKS!</B></H1>
Your card notification has been sent to $fields{'recip_name'}<BR>
The URL of this card is<P>
<A HREF="$URL_NAME">$URL_NAME</A>
<P>
<B><A HREF=$fields{'parent'}>RETURN TO CARD CREATOR</A></B>
<P>
__STOP_OF_THANKS__
}
# BNB SAYS!
# THIS IS WHERE YOU CAN CUSTOMIZE YOUR NOTIFICATION LETTER
# DO NOT TOUCH THE TWO LINES WITH __STOP_OF_MESSAGE__ ON
# THEM!!!!
sub setup_letter
{
$msgtext =<<__STOP_OF_MESSAGE__;
Hi,
$fields{'sender_name'} stopped by my site, $SITENAME
and created a Virtual Card just for you! To pick up your
card, simply point your browser at the page listed below.
$URL_NAME
The card will remain on the server for about one week, so
please print it out or save it as soon as you can.
__STOP_OF_MESSAGE__
}
# BNB SAYS!
# This is what makes up the body of your card. DO NOT REMOVE OR
# MODIFY THE LINES ABOVE THE WORD $param or the $param line
# itself. Doing so will cause the script to fail.
sub make_body
{
$cardbody =<<__END_OF_CARD_BODY__;
<SCRIPT LANGUAGE="JavaScript">
<!--
if(navigator.userAgent.indexOf("MSIE") != -1)
document.writeln ('');
else
document.writeln ('<EMBED SRC="$BASEURL/$fields{'midifile'}" AUTOSTART="true" HIDDEN="true" VOLUME="80%">');
//-->
</SCRIPT>
<style type="text/css">
<!--
body {
margin-left: 0px;
margin-top: 0px;
background-color: #FFFFFF;
}
.style1 {
font-family: "Trebuchet MS";
font-weight: bold;
font-size: 12px;
}
.style4 {
font-family: "Century Gothic";
font-size: 12px;
color: #66CC00;
}
-->
</style>
<BODY>
<TABLE WIDTH=584 BORDER=0 cellpadding="0" cellspacing="0" BGCOLOR="#FFFFF">
<TR>
<TD height="5" colspan="3" ALIGN=CENTER VALIGN=CENTER><img src="spacer.jpg" width="1" height="1"></TD>
<TR>
<TD width="5" ALIGN=CENTER VALIGN=CENTER> </TD>
<TD width="563" ALIGN=CENTER VALIGN=CENTER><IMG SRC=$BASEURL/$fields{'pic_select'} WIDTH=100% HEIGHT=100% BORDER=0></TD>
<TD width="5" ALIGN=CENTER VALIGN=CENTER> </TD>
<TR>
<TD height="5" colspan="3" ALIGN=CENTER VALIGN=CENTER><img src="spacer.jpg" width="1" height="1"></TD>
</TABLE>
<br>
<table width="584" border="0" cellpadding="0" cellspacing="0">
<tr>
<td width="137" valign="top"><span class="style1">From</span></td>
<td width="447"><span class="style4">$fields{'sender_name'}</span></td>
</tr>
<tr>
<td valign="top" class="style1">Email Address</td>
<td class="style4">$fields{'sender_email'}</td>
</tr>
<tr>
<td valign="top" class="style1">Subject</td>
<td class="style4"><div align="justify">$fields{'the_title'}</div></td>
</tr>
<tr>
<td valign="top" class="style1">Message</td>
<td class="style4"><div align="justify">$fields{'the_message'}</div></td>
</tr>
</table>
<p><BR>
<TABLE WIDTH=586 BGCOLOR="#FFFFF" BORDER=0>
</p>
<TR>
<TD> </TD>
<TD>
$fields{'sender_name'}
</TD>
</TR>
<TR>
<TD>
Sender's Email:
</TD>
<TD>
$fields{'sender_email'}
</TD>
</TR>
<TR>
<TD>
Message:
</TD>
<TD>
$fields{'the_message'}
</TD>
</TR>
$params
</BODY>
</HTML>
__END_OF_CARD_BODY__
}
sub pass_params
{
$params=<<__END_OF_PARAMS__;
<CENTER>
<TABLE WIDTH=500>
<TR>
<TD>
<FONT FACE="ARIAL">
<BR>Please press the send button to send the card. <BR> Press back to edit again.
<P>
<CENTER>
<FORM METHOD="POST" ACTION="$PROGNAME">
<INPUT TYPE="HIDDEN" NAME="action_code" VALUE="SENDCARD">
<INPUT TYPE="HIDDEN" VALUE="$fields{'pic_select'}" NAME="pic_select">
<INPUT TYPE="HIDDEN" VALUE="$fields{'sender_name'}" NAME="sender_name">
<INPUT TYPE="HIDDEN" VALUE="$fields{'sender_email'}" NAME="sender_email">
<INPUT TYPE="HIDDEN" VALUE="$fields{'recip_name'}" NAME="recip_name">
<INPUT TYPE="HIDDEN" VALUE="$fields{'recip_email'}" NAME="recip_email">
<INPUT TYPE="HIDDEN" VALUE="$fields{'text_color'}" NAME="text_color">
<INPUT TYPE="HIDDEN" VALUE="$fields{'back_color'}" NAME="back_color">
<INPUT TYPE="HIDDEN" VALUE="$fields{'the_title'}" NAME="the_title">
<INPUT TYPE="HIDDEN" VALUE="$fields{'the_message'}" NAME="the_message">
<INPUT TYPE="HIDDEN" VALUE="$fields{'sig_line'}" NAME="sig_line">
<INPUT TYPE="HIDDEN" VALUE="$fields{'midifile'}" NAME="midifile">
<INPUT TYPE="HIDDEN" VALUE="$fields{'background'}" NAME="background">
<INPUT TYPE="HIDDEN" VALUE="$ENV{'HTTP_REFERER'}" NAME="parent">
<INPUT TYPE="submit" VALUE="SEND-CARD">
</FORM>
</CENTER>
</TD>
</TR>
</TABLE>
__END_OF_PARAMS__
}
###################################################################
###################################################################
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;
if (!$to)
{
return(-8);
}
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 ($SEND_MAIL ne "")
{
open (MAIL,"| $SEND_MAIL");
}
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);
}
sub no_email
{
print <<__STOP_OF_NOMAIL__;
Content-type: text/html
<FONT SIZE="+1">
<B>
SORRY! Your request could not be processed because of missing
e-mail address(es). Please use your browser's back button to
return to the card entry page.
</B>
</FONT>
__STOP_OF_NOMAIL__
}
sub send_mail
{
&setup_letter;
$mailresult=&sendmail($fields{sender_email}, $fields{sender_email}, $fields{recip_email}, $SMTP_SERVER, $SUBJECT, $msgtext);
}
sub card_expire
{
local(@items, $item);
opendir(CARDDIR, "$BASEDIR");
@items = grep(/[0-9]$EXT/,readdir(CARDDIR));
closedir(CARDDIR);
foreach $item (@items)
{
if (-M "$BASEDIR/$item" > $DAYS)
{
unlink("$BASEDIR/$item");
}
}
}
##################################################################
sub valid_address
{
$testmail = $fields{'recip_email'};
if ($testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||
$testmail !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)$/)
{
return 0;
}
else
{
return 1;
}
}
sub bad_email
{
print <<__STOP_OF_BADMAIL__;
Content-type: text/html
<FONT SIZE="+1">
<B>
SORRY! Your request could not be processed because of an improper
recipient's e-mail address. Please use your back button to return
to the card screen and try again!
</B>
</FONT>
__STOP_OF_BADMAIL__
}
sub test_basedir
{
if (not -w $BASEDIR)
{
print <<__STOP_OF_BADBASE__;
Content-type: text/html
<FONT SIZE="+1">
<B>
The script cannot either find or write to the<BR>
$BASEDIR directory. Please check this setting if
the BASEDIR variable, and the permissions of the
directory. If you have them set to 755, please
change them to 777.
</B>
</FONT>
__STOP_OF_BADBASE__
exit;
}
}
##################################################################
sub valid_page
{
if (@okaydomains == 0) {return;}
$DOMAIN_OK=0;
$RF=$ENV{'HTTP_REFERER'};
$RF=~tr/A-Z/a-z/;
foreach $ts (@okaydomains)
{
if ($RF =~ /$ts/)
{ $DOMAIN_OK=1; }
}
if ( $DOMAIN_OK == 0)
{ print "Content-type: text/html\n\n Sorry, cant run it from here....";
exit;
}
}
sub decode_vars
{
#This part of the program splits up our data and gets it
#ready for formatting.
$i=0;
read(STDIN,$temp,$ENV{'CONTENT_LENGTH'});
@pairs=split(/&/,$temp);
foreach $item(@pairs)
{
($key,$content)=split(/=/,$item,2);
$content=~tr/+/ /;
$content=~s/%(..)/pack("c",hex($1))/ge;
$content=~s/\0//g; #strip nulls
$content =~ s/<!--(.|\n)*-->//g;
$fields{$key}=$content;
$i++;
$item{$i}=$key;
$response{$i}=$content;
}
}
sub get_file_name
{
$proc=$$;
$newnum=time;
$newnum=substr($newnum,4,5);
$date=localtime(time);
($day, $month, $num, $time, $year) = split(/\s+/,$date);
$month=~tr/A-Z/a-z/;
$PREF = "$month$num";
$FILE_NAME="$BASEDIR/$PREF$newnum$proc$EXT";
$URL_NAME="$BASEURL/$PREF$newnum$proc$EXT";
}
#Write out our HTML FILE
sub create_file
{
open(OUTFILE,">$FILE_NAME") ;
print OUTFILE "$cardbody\n";
close (OUTFILE);
}
#Set up our HTML Preview Form
sub do_preview
{
$fields{'the_message'} =~s/\"/\'/g;
&pass_params;
&make_body;
print "Content-type: text/html\n\n";
print "$cardbody\n";
}
sub main_driver
{
&valid_page;
&test_basedir;
&decode_vars;
if ($fields{'recip_email'} eq "")
{ &no_email; exit; }
if (&valid_address == 0)
{ &bad_email; exit; }
if ($fields{'sender_email'} eq "")
{ &no_email; exit; }
if ($fields{'background'} ne "")
{ $BODYTAG="<BODY BACKGROUND=\"$BASEURL/$fields{'background'}\">";}
else { $BODYTAG="<BODY BGCOLOR=\"\">"; }
if ($fields{'action_code'} eq "NEW")
{ &do_preview; }
if ($fields{'action_code'} eq "SENDCARD")
{
&make_body;
&get_file_name;
&create_file;
&setup_letter;
$mailresult=&sendmail($fields{sender_email}, $fields{sender_email}, $fields{recip_email}, $SMTP_SERVER, $SUBJECT, $msgtext);
&thank_you;
if ($DAYS > 0)
{&card_expire;}
}
}