[ back to toc ]

Perl Script won't send email

Date: 2002/01/23 16:02

Q:
" I am trying to implement this form that takes all of the user's input
and then emails it to the owner of the site. The script runs fine -- after
the user presses "submit" then another page comes up that shows the user
all of the information that they just entered. However, the information is
suppose to be emailed to the owner and it is not doing that. Here is the
script -- please let me know if you can help!

#!C:\Perl\bin\perl.exe -w

use Socket;
##################################################################
# (C)1998-2000 Bignosebird.com bnbform v4.0
# Use of this script means that you accept the disclaimer and
# agree to the terms of use located at the bottom of the
# script.
#
# Updated January 31, 2000
#
# This script is provided without support. Please read the
# README.TXT file, as well as following the troubleshooting
# links and information at http://bignosebird.com/cgi.shtml
# Our BBS is located at http://bignosebird.com/bbs.shtml
#
# Socket based e-mail for cross platform capability!
#
# Attention users of earlier versions of BNBFORM# You MUST read the README.TXT file to know how to configure
# your forms for use with this new version. Otherwise your
# logfile, countfile, autorespond, etc... will stop working.
# It was necessary to make these changes for security reasons.
#
#
############## SPECIAL FORM VARIABLES ############################
#required: comma delimited list of required entry fields
#data_order: comma delimited list indicating what fields to actually
# print and in what order.
#outputfile: the name of the file to save the data in if using a file.
# the file will automatically be named ending with .bout
#emailfile: the name of the file to hold only the sender e-mail

address
# the file will automatically be named ending with bemf
#ok_url: URL to go to if successful
#not_ok_url URL to go to if unsuccessful
#submit_to: email address of person to input receive data by mail
# this can be a comma seperated list of e-mail addresses
#cc_to: email address of Cc Recipient
# this can be a comma seperated list of e-mail addresses
#submit_by: email address of person completing form
#autorespond: NO LONGER USED AS OF JAN 31, 2000
#automessage: text to print for autoconfirmation e-mail
# the file will automatically be named ending with .baut
#form_id: name of form for e-mail subject
#countfile: name of file for serial number counter
# the file will automatically be named ending with .bcnt
#okaydomains: prevents calling the script from other sites,
# without restricting e-mail addresses.
# replaces $SECURE_NAME from earlier versions.
# use only lower case letters.
#SMTP_SERVER: the full host name of the server providing e-mail
# gateway service
##################################################################

## MAIN ##########################################################

# uncomment the line below, and change bignosebird to your domain
# name if you wish to make is so the script can only be called
# from your site.

#@okaydomains=("http://localhost", "http://localhost");

#SMTP_SERVER: indicates the name of the host acting as the e-mail
# gateway. "localhost" should work on most systems.

$SMTP_SERVER="localhost";

#OR IF SMTP IS UNAVAILABLE TO YOU, USE SEND_MAIL# BUT NOT BOTH!

#$SEND_MAIL="/usr/lib/sendmail -t";

$lockfile="/tmp/bnbform.lck";

$SD=&sys_date;
$ST=&sys_time;

&decode_vars;

#&valid_page;

if ($fields{'countfile'} ne "") { &get_number; }

&valid_data;

&write_data;

if ($fields{'automessage'} ne "") { &answer_back; }

if ($fields{'ok_url'} ne
{
print "Location: $fields{'ok_url'}\n\n"; exit;
}
else { &thank_you; }

##################################################################
sub write_data
{

if ($fields{'submit_by'} ne "") {
if (&valid_address == 0) {
&bad_email;
exit;
}

}

if ($fields{'submit_by'} ne "" && $fields{'emailfile'} ne "")

open (EMF,">>$fields{'emailfile'}");
print EMF "$fields{'submit_by'}\n";
close (EMF);
}

if ($fields{'submit_to'} ne "")

$msgtext="";
$msgtext .= "On $SD at $ST,\n";
$msgtext .= "The following information was submitted:\n";
$msgtext .= "From Host: $ENV{'REMOTE_ADDR'}\n";
}

if ($fields{'outputfile'} ne "")

&get_the_lock;
open(OUT_FILE,">>$fields{'outputfile'}");
}

foreach $to_print (@sortlist)

if ($fields{'outputfile'} ne "")
{ print OUT_FILE "$fields{$to_print}\|"; }
if ($fields{'submit_to'} ne "")
{ $msgtext .= "$to_print = $fields{$to_print}\n"; }
}
if ($fields{'outputfile'} ne "")

print OUT_FILE "$SD\|$ST\|\n";
close(OUT_FILE);
&drop_the_lock;
}

foreach $to_get (@recipients)

$mailresult=&sendmail($fields{submit_by}, $fields{submit_by},

$to_get, $SEND_MAIL, $fields{form_id}, $msgtext);
if ($mailresult ne "1")

print "Content-type: text/html\n\n";
print "MAIL NOT SENT. SMTP ERROR: $mailcodes{'$mailresult'}\n";
exit
}
}
foreach $to_cc (@cc_tos)

$mailresult=&sendmail($fields{submit_by}, $fields{submit_by},

$to_cc, $SEND_MAIL, $fields{form_id}, $msgtext);
if ($mailresult ne "1")

print "Content-type: text/html\n\n";
print "MAIL NOT SENT. SMTP ERROR: $mailcodes{'$mailresult'}\n";
exit
}
}

}

##################################################################
sub decode_vars
{
$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/\t/ /g;
$fields{$key}=$content;
if ($key eq "data_order") {
$content=~s/\012//g;
$content=~s/\015//g;
$content=~s/ //g;
$content=~s/ //g;
@sortlist=split(/,/,$content);
}
if ($key eq "required") {
$content=~s/\012//g;
$content=~s/\015//g;
$content=~s/ //g;
@mandatory=split(/,/,$content);
}
if ($key eq "submit_t
o")

$content=~s/\012//g;
$content=~s/\015//g;
$content=~s/ //g;
@recipients=split(/,/,$content);
}
if ($key eq "cc_to")

$content=~s/\012//g;
$content=~s/\015//g;
$content=~s/ //g;
@cc_tos=split(/,/,$content);
}

}
if

( ($fields{automessage}=~ /^([-\/\w.]+)$/ || $fields{automessage}

eq "") &&
($fields{countfile}=~ /^([-\/\w.]+)$/ || $fields{countfile} eq

"") &&
($fields{emailfile}=~ /^([-\/\w.]+)$/ || $fields{emailfile} eq

"") &&
($fields{outputfile}=~ /^([-\/\w.]+)$/ || $fields{outputfile} eq

"") )
) {$donothing=0;}
else

print "Content-type: text/html\n\n sorry, invalid

characters...\n";
exit;
}
if ($fields{automessage} ne "") {$fields{automessage} .= ".baut";}
if ($fields{countfile} ne "") {$fields{countfile} .= ".bcnt";}
if ($fields{emailfile} ne "") {$fields{emailfile} .= ".bemf";}
if ($fields{outputfile} ne "") {$fields{outputfile} .= ".bout";}
}

##################################################################
sub valid_data
{
if ($fields{'data_order'} eq "") #make sure we have work to do!
{
print "Content-type: text/html\n\n";
print <<__W1__;

<H1>NO data_order list SPECIFIED!</H1>

__W1__
exit;
}

foreach $to_check (@mandatory) #test all required fields, bail on

1st bad
{
if ($fields{$to_check} eq "") {
if ($fields{'not_ok_url'} ne "") {
print "Location: $fields{'not_ok_url'}\n\n";
exit;
}
else { &try_again; }
}
}

}

##################################################################
sub thank_you
{
print "Content-type: text/html\n\n";
print <<__W2__;
<BODY BGCOLOR="#FFFFFF">
<CENTER>
<TABLE WIDTH=550 BORDER=1>
<TR>
<TD>
<H1>Thank you!</H1>
Your information has been sent and I will be in touch
with you as soon as I can
<P>
Here is the information you provided:
<P>
__W2__

foreach $itm (@sortlist) {
print <<__W2A__;
$itm: $fields{$itm}
<BR>
__W2A__
}

print <<__W2B__;
</TD>
</TR>
</TABLE>

__W2B__

exit;
}

##################################################################
sub try_again
{
print "Content-type: text/html\n\n";
print <<__W3__;

<H1>Missing Data!</H1>
<B>Please press the back button and fill in
all required fields!<P></B>

__W3__
exit;
}

##################################################################
sub answer_back
{

$subject = "Thank you";
$msgtext="";
if ($fields{'automessage'} ne "") {
open (AM,"< $fields{'automessage'}");
while (<AM>) {
chop $_;
$msgtext .= "$_\n";
}
close(AM);
}
else {
$msgtext =<<__W4__;

Thank you for your submission. I will be
getting in touch with you soon.

__W4__
}
$replyaddr=$recipients[0];
$mailresult=&sendmail($replyaddr, $replyaddr, $fields{submit_by},

$SMTP_SERVER, $subject, $msgtext);
}

##################################################################

sub get_number
{
$newnum=0;
open(COUNTER,"<$fields{'countfile'}");
while($thisnum=<COUNTER>) {
if ($thisnum eq "") { $thisnum = 0;}
$newnum = $thisnum + 1;
}
close(COUNTER);
open(COUNTER,">$fields{'countfile'}");
print COUNTER "$newnum";
close (COUNTER);
$fields{'counter'}=$newnum
}

##################################################################
sub valid_address
{
$testmail = $fields{'submit_by'};
if ($testmail =~/ /)
{ return 0; }
if ($testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||
$testmail !~

/^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[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
improperly formatted e-mail address. Please use your browser's
back button to return to the form entry page.
</B>
</FONT>
__STOP_OF_BADMAIL__
}

sub get_the_lock
{
local ($endtime);
$endtime = 60;
$endtime = time + $endtime;
while
(-e $lockfile && time < $endtime)
{
# Do Nothing
}
open(LOCK_FILE, ">$lockfile");
}

sub drop_the_lock
{
close($lockfile);
unlink($lockfile);
}

##################################################################
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 from here!";
exit;
}
}

###################################################################
#Sendmail.pm routine below by Milivoj Ivkovic (modified by bnb)
###################################################################
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 sys_date
{
%mn = ('Jan','01', 'Feb','02', 'Mar','03', 'Apr','04',
'May','05', 'Jun','06', 'Jul','07', 'Aug','08',
'Sep','09', 'Oct','10', 'Nov','11', 'Dec','12' );
$sydate=localtime(time);
($day, $month, $num, $time, $year) = split(/\s+/,$sydate);
$zl=length($num);
if ($zl == 1)
{ $num = "0$num";}
$yyyymmdd="$year\-$mn{$month}\-$num";
return $yyyymmdd;
}

sub sys_time
{
$sydate=localtime(time);
($day, $month, $num, $time, $year) = split(/\s+/,$sydate);
return $time;
}

A:
The program is configured to use the SMTP mail delivery. I assume that you did not
alter main part of the script, therefore it is some configuration issue.

You can try the following methods:

- specify the real name of the machine instead of 'localhost' to be the
SMTP_SERVER

- comment out the SMTP_SERVER variable and use the sendmail program to
send a mail

Regards,
Peter

[ back to toc ]