smtp authentication in perl script for contact form

[Anonymous Monk]

Hello Monks,
I am using a perl script for some time now on several of my websites and until last month it worked perfect.
But then the provider had to implicate some security measures and the SEND_MAIL option does not work any more and they told me I have to use SMTP_SERVER.
However the script works, I do not receive the e-mail with the form data.
The provider told me that the script should provide a ‘from’ field and the solution has to be found there, but I can not find it.
As security of providers will increase more and more, this can be a problem for more users in the future and maybe this will be the issue for more forms.
Mayby someone can me tell me where to look or what to do?
Sofar I have made some alterations that made the script work

$SMTP_SERVER="smtp.mail.xxxxxxx.com";
$SMTP_PORT="587";
$SSL="OFF";
$SMTP_Auth="true";               
$Set_From="[e-mail]";
$username = "????@????.com";
$password = "??????????";

result in a: MAIL NOT SENT. SMTP ERROR: And if I use:

$host = "smtp.mail.xxxxxxxxxxxx.com";
$SMTP_PORT="587";
$SSL="OFF";
$SMTP_Auth="true";               
$Set_From="[e-mail]";
$username = "????@????.nl";
$password = "??????????";

it results in a ok_url notification, but I will not receive an email, so it is not send. (same as SEND_MAIL by the way).
I think it is a simple alteration but after several day searching, I cannot find the solution and hope you can shine some light on this.
Many thanks in advance and i hope some one can solve the problem.
best regards
Olaf

Complete script:

#!/usr/bin/perl

use Socket;


############ 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 addr
+ess
#             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
# name if you wish to make is so the script can only be called
# from your site.

@okaydomains=("http://xxxxx.com", "http://www.xxxxx.com");   

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

$smtp_path = "mail.xxxxxx.com";
$SMTP_SERVER="smtp.mail.xxxxxxxx.com";
#$SMTP_SERVER="localhost";
$defaultSender = "[e-mail]"; 

$SMTP_PORT="587";
$SSL="OFF";
$SMTP_Auth="true";               
$Set_From="[e-mail]";
$auth_username="[e-mail]";
$auth_password="xxxxxxxxxxxx";

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

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


#$host = "smtp.mail.xxxxxxx.com";
#$SMTP_PORT="587";
#$SSL="OFF";
#$SMTP_Debug="0";
#$SMTP_Auth="true";               
#$Set_From="xxxxx\@xxxxxx.com";
#$auth_username="[e-mail]";
#$auth_password="xxxxxxxxxxx";

$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}, $t
+o_get, $SMTP_SERVER, $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}, $t
+o_cc, $SMTP_SERVER, $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_to") {
       $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 1
+st 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}, $S
+MTP_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 
###################################################################
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 i
+nputs - if you
#  are hard coding things from a library file, so of those are unneces
+ssary
#

    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;
}

[Corion]

Perl provides many ways to help you if you let it.

If you put the line use warnings; near the top of your script, Perl will tell you what goes wrong. In your case, Perl sees a variable, @xxxx in the string "[e-mail]" in your code.

If you want to turn such instances of misspelled or misidentified variable names into errors, add the line use strict; near the top of your program as well. This is considered good programming practice.

The easiest fix in your case is to use single quotes instead of double quotes, because strings in single quotes are never examined by Perl for containing variable names:

$Set_From='[e-mail]';
$username = '????@????.com';

But note that your script is a huge open gate for spammers. You never check whether $fromaddr contains what you think it should. For example, a malicious user could sent MAIL TO: [e-mail]\nSubject: Buy Viagra\n\nBuy cheap viagra into $fromaddr and your script would then blast out an email in your name to the spammers mail list. Please take a look at the nms formmail script, which does not contain such security holes.

[Anonymous Monk]

Hello Corion,

Thanks for your input!
I have repaced the double quotes for the single quotes as you recommended aswell as the use strict; and use warnings; to get to the quick fix, but then I get a 500 internal server error.

But I think it is better to concentrate on a good script as you suggested then to continue using current script with a huge open gate.

Therefore I followed your link and used TFMail Autoinstall to install the script onto the server.
When I run the script I get the error:

Application Error

An error has occurred in the program

SMTP command RCPT TO:<[e-mail]> gave response [554 5.7.1 <firewall.vhosting.namehost.com11.222.68.68>: Client host rejected: Access denied ] at /home/vhosting/z/vhost0028581/domains/xxxx.com/htdocs/www/cgi-bin/websiteformulier.cgi line 967, <GEN1> line 4.

I think the error occurs because the host needs SMTP Authentication? E.g. I did not give SMTP_PORT, SSL="OFF", username / password.

Would that not be necessary?br>
BR
Olaf

[Corion]

I don't know about the vhost and firewall setup of your hosting provider.

Most likely, a fix is to set up the mail program correctly:

  $mailprog          = '/usr/lib/sendmail -oi -t';

If you set the variable to smtp:xxx, this error is your ISP telling you that they don't allow direct SMTP connections, most likely for spam reasons.