Solved

Weird...formmail won't work with perl 5???

Posted on 2002-07-22
5
270 Views
Last Modified: 2012-06-27
Ok first granted this is the old formmail, but I am working with legacy stuff and bringing it up to date.

I have a formmail script which runs just fine with perl4 as seen below (SAMPLE 1).

however, when I change to perl 5 (#!/usr/bin/perl5)
I can not for the life of me get it to work.  It will not send email and shows absolutely no errors on the web or at the command line.  All I do is change the perl4 to perl5 and then alter test@test.com to test\@test.com

It all makes perfect sense and shows no errors.  However no mail ever comes through this way??  All I can think it that something else has to be altered if you use perl5?  Any thoughts?

----------
(SAMPLE 1)

#!/usr/bin/perl4

$mailprog = '/usr/sbin/sendmail';

@referers = ('www.pair.com','pair.com','207.86.128.11','peakware.com');

# Done
#############################################################################

# Check Referring URL
# &check_url;

# Retrieve Date
&get_date;

# Parse Form Contents
&parse_form;

# Check Required Fields
&check_required;

# Return HTML Page or Redirect User
&return_html;

# Send E-Mail
&send_mail;

sub check_url {

   if ($ENV{'HTTP_REFERER'}) {
      foreach $referer (@referers) {
         if ($ENV{'HTTP_REFERER'} =~ /$referer/i) {
            $check_referer = '1';
          last;
        }
      }
   }
   else {
      $check_referer = '1';
   }

   if ($check_referer != 1) {
      &error('bad_referer');
   }

}

sub get_date {

   @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
   @months = ('January','February','March','April','May','June','July',
            'August','September','October','November','December');

   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
   if ($hour < 10) { $hour = "0$hour"; }
   if ($min < 10) { $min = "0$min"; }
   if ($sec < 10) { $sec = "0$sec"; }

   $date = "$days[$wday], $months[$mon] $mday, 19$year at $hour\:$min\:$sec";

}

sub parse_form {

   if ($ENV{'REQUEST_METHOD'} eq 'GET') {
      # Split the name-value pairs
      @pairs = split(/&/, $ENV{'QUERY_STRING'});
   }
   elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
      # Get the input
      read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
 
      # Split the name-value pairs
      @pairs = split(/&/, $buffer);
   }
   else {
      &error('request_method');
   }

   foreach $pair (@pairs) {
      ($name, $value) = split(/=/, $pair);
 
      $name =~ tr/+/ /;
      $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

      $value =~ tr/+/ /;
      $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

      # If they try to include server side includes, erase them, so they
      # arent a security risk if the html gets returned.  Another
      # security hole plugged up.

      $value =~ s/<!--(.|\n)*-->//g;

      # Create two associative arrays here.  One is a configuration array
      # which includes all fields that this form recognizes.  The other
      # is for fields which the form does not recognize and will report
      # back to the user in the html return page and the e-mail message.
      # Also determine required fields.

      if ($name eq 'recipient' ||
        $name eq 'subject' ||
        $name eq 'email' ||
        $name eq 'realname' ||
        $name eq 'redirect' ||
        $name eq 'bgcolor' ||
        $name eq 'background' ||
        $name eq 'link_color' ||
        $name eq 'vlink_color' ||
          $name eq 'text_color' ||
           $name eq 'alink_color' ||
        $name eq 'title' ||
        $name eq 'sort' ||
        $name eq 'print_config' ||
        $name eq 'return_link_title' ||
        $name eq 'return_link_url' && ($value)) {
         
       $CONFIG{$name} = $value;
      }
      elsif ($name eq 'required') {
         @required = split(/,/,$value);
      }
      elsif ($name eq 'env_report') {
         @env_report = split(/,/,$value);
      }
      else {
         if ($FORM{$name} && ($value)) {
          $FORM{$name} = "$FORM{$name}, $value";
       }
         elsif ($value) {
            $FORM{$name} = $value;
         }
      }
   }
}

sub check_required {

   foreach $require (@required) {
      if ($require eq 'recipient' ||
          $require eq 'subject' ||
          $require eq 'email' ||
          $require eq 'realname' ||
          $require eq 'redirect' ||
          $require eq 'bgcolor' ||
          $require eq 'background' ||
          $require eq 'link_color' ||
          $require eq 'vlink_color' ||
          $require eq 'alink_color' ||
          $require eq 'text_color' ||
        $require eq 'sort' ||
          $require eq 'title' ||
          $require eq 'print_config' ||
          $require eq 'return_link_title' ||
          $require eq 'return_link_url') {

         if (!($CONFIG{$require}) || $CONFIG{$require} eq ' ') {
            push(@ERROR,$require);
         }
      }
      elsif (!($FORM{$require}) || $FORM{$require} eq ' ') {
         push(@ERROR,$require);
      }
   }

   if (@ERROR) {
      &error('missing_fields', @ERROR);
   }

}

sub return_html {

   if ($CONFIG{'redirect'} =~ /http\:\/\/.*\..*/) {

      # If the redirect option of the form contains a valid url,
      # print the redirectional location header.

      print "Location: $CONFIG{'redirect'}\n\n";
   }
   else {

      print "Content-type: text/html\n\n";
      print "<html>\n <head>\n";

      # Print out title of page
      if ($CONFIG{'title'}) {
       print "  <title>$CONFIG{'title'}</title>\n";
      }
      else {
         print "  <title>Thank You</title>\n";
      }

      print " </head>\n <body";

      # Get Body Tag Attributes
      &body_attributes;

      # Close Body Tag
      print ">\n  <center>\n";

      if ($CONFIG{'title'}) {
         print "   <h1>$CONFIG{'title'}</h1>\n";
      }
      else {
         print "   <h1>Thank You For Filling Out This Form</h1>\n";
      }
      print "</center>\n";

      print "Below is what you submitted to $CONFIG{'recipient'} on ";
      print "$date<p><hr size=7 width=75\%><p>\n";

      if ($CONFIG{'sort'} eq 'alphabetic') {
         foreach $key (sort keys %FORM) {
            # Print the name and value pairs in FORM array to html.
            print "<b>$key:</b> $FORM{$key}<p>\n";
         }
      }
      elsif ($CONFIG{'sort'} =~ /^order:.*,.*/) {
         $sort_order = $CONFIG{'sort'};
         $sort_order =~ s/order://;
         @sorted_fields = split(/,/, $sort_order);
         foreach $sorted_field (@sorted_fields) {
            # Print the name and value pairs in FORM array to html.
            if ($FORM{$sorted_field}) {
               print "<b>$sorted_field:</b> $FORM{$sorted_field}<p>\n";
           }
         }
      }
      else {
         foreach $key (keys %FORM) {
            # Print the name and value pairs in FORM array to html.
            print "<b>$key:</b> $FORM{$key}<p>\n";
         }
      }

      print "<p><hr size=7 width=75%><p>\n";

      # Check for a Return Link
      if ($CONFIG{'return_link_url'} =~ /http\:\/\/.*\..*/ && $CONFIG{'return_link_title'}) {
         print "<ul>\n";
         print "<li><a href=\"$CONFIG{'return_link_url'}\">$CONFIG{'return_link_title'}</a>\n";
         print "</ul>\n";
      }
#      print "<a href=\"http://www.worldwidemart.com/scripts/formmail.shtml\">FormMail</a> Created by Matt Wright and can be found at <a href=\"http://www.worldwidemart.com/scripts/\">Matt's Script Archive</a>.\n";
      print "</body>\n</html>";
   }
}

sub send_mail {
   # Open The Mail Program

   $address2send = "test@test.com";

   open(MAIL,"|$mailprog -t");

   print MAIL "To: $address2send \n";
   print MAIL "From: $CONFIG{'email'} ($CONFIG{'realname'})\n";

   # Check for Message Subject
   if ($CONFIG{'subject'}) {
      print MAIL "Subject: $CONFIG{'subject'}\n\n";
   }
   else {
      print MAIL "Subject: WWW Form Submission\n\n";
   }

   print MAIL "Below is the result of your feedback form.  It was ";
   print MAIL "submitted by $CONFIG{'realname'} ($CONFIG{'email'}) on ";
   print MAIL "$date\n";
   print MAIL "---------------------------------------------------------------------------\n\n";

   if ($CONFIG{'print_config'}) {
      @print_config = split(/,/,$CONFIG{'print_config'});
      foreach $print_config (@print_config) {
         if ($CONFIG{$print_config}) {
            print MAIL "$print_config: $CONFIG{$print_config}\n\n";
         }
      }
   }

   if ($CONFIG{'sort'} eq 'alphabetic') {
      foreach $key (sort keys %FORM) {
         # Print the name and value pairs in FORM array to mail.
         print MAIL "$key: $FORM{$key}\n\n";
      }
   }
   elsif ($CONFIG{'sort'} =~ /^order:.*,.*/) {
      $CONFIG{'sort'} =~ s/order://;
      @sorted_fields = split(/,/, $CONFIG{'sort'});
      foreach $sorted_field (@sorted_fields) {
         # Print the name and value pairs in FORM array to mail.
         if ($FORM{$sorted_field}) {
            print MAIL "$sorted_field: $FORM{$sorted_field}\n\n";
         }
      }
   }
   else {
      foreach $key (keys %FORM) {
         # Print the name and value pairs in FORM array to html.
            print MAIL "$key: $FORM{$key}\n\n";
      }
   }

   print MAIL "---------------------------------------------------------------------------\n";

   # Send Any Environment Variables To Recipient.
   foreach $env_report (@env_report) {
      print MAIL "$env_report: $ENV{$env_report}\n";
   }

   close (MAIL);
}

sub error {

   ($error,@error_fields) = @_;

   print "Content-type: text/html\n\n";

   if ($error eq 'bad_referer') {
      print "<html>\n <head>\n  <title>Bad Referrer - Access Denied</title>\n </head>\n";
      print " <body>\n  <center>\n   <h1>Bad Referrer - Access Denied</h1>\n  </center>\n";
      print "The form that is trying to use this FormMail Program\n";
      print "resides at: $ENV{'HTTP_REFERER'}, which is not allowed to access this cgi script.<p>\n";
      print "Sorry!\n";
      print "</body></html>\n";
   }

   elsif ($error eq 'request_method') {
      print "<html>\n <head>\n  <title>Error: Request Method</title>\n </head>\n";
      print "</head>\n <body";

      # Get Body Tag Attributes
      &body_attributes;

      # Close Body Tag
      print ">\n <center>\n\n";

      print "   <h1>Error: Request Method</h1>\n  </center>\n\n";
      print "The Request Method of the Form you submitted did not match\n";
      print "either GET or POST.  Please check the form, and make sure the\n";
      print "method= statement is in upper case and matches GET or POST.\n";
      print "<p><hr size=7 width=75%><p>\n";
      print "<ul>\n";
      print "<li><a href=\"$ENV{'HTTP_REFERER'}\">Back to the Submission Form</a>\n";
      print "</ul>\n";
      print "</body></html>\n";
   }

   elsif ($error eq 'missing_fields') {

      print "<html>\n <head>\n  <title>Error: Blank Fields</title>\n </head>\n";
      print " </head>\n <body";
     
      # Get Body Tag Attributes
      &body_attributes;
         
      # Close Body Tag
      print ">\n  <center>\n";

      print "   <h1>Error: Blank Fields</h1>\n\n";
      print "The following fields were left blank in your submission form:<p>\n";

      # Print Out Missing Fields in a List.
      print "<ul>\n";
      foreach $missing_field (@error_fields) {
         print "<li>$missing_field\n";
      }
      print "</ul>\n";

      # Provide Explanation for Error and Offer Link Back to Form.
      print "<p><hr size=7 width=75\%><p>\n";
      print "These fields must be filled out before you can successfully submit\n";
      print "the form.  Please return to the <a href=\"$ENV{'HTTP_REFERER'}\">Fill Out Form</a> and try again.\n";
      print "</body></html>\n";
   }
   exit;
}

sub body_attributes {
   # Check for Background Color
   if ($CONFIG{'bgcolor'}) {
      print " bgcolor=\"$CONFIG{'bgcolor'}\"";
   }

   # Check for Background Image
   if ($CONFIG{'background'} =~ /http\:\/\/.*\..*/) {
      print " background=\"$CONFIG{'background'}\"";
   }

   # Check for Link Color
   if ($CONFIG{'link_color'}) {
      print " link=\"$CONFIG{'link_color'}\"";
   }

   # Check for Visited Link Color
   if ($CONFIG{'vlink_color'}) {  
      print " vlink=\"$CONFIG{'vlink_color'}\"";
   }

   # Check for Active Link Color
   if ($CONFIG{'alink_color'}) {
      print " alink=\"$CONFIG{'alink_color'}\"";
   }

   # Check for Body Text Color
   if ($CONFIG{'text_color'}) {
      print " text=\"$CONFIG{'text_color'}\"";
   }
}
0
Comment
Question by:webcs
5 Comments
 
LVL 25

Expert Comment

by:clockwatcher
ID: 7170869
As a start,

perl -cw gives:

Possible unintended interpolation of @test in string at testdb.pl line 253.
Name "main::test" used only once: possible typo at testdb.pl line 253.
Name "main::yday" used only once: possible typo at testdb.pl line 54.
Name "main::isdst" used only once: possible typo at testdb.pl line 54.
 
escape the '@' symbol in your email address.  Change:

     $address2send = "test@test.com";

To:

     $address2send = "test\@test.com"
0
 
LVL 2

Author Comment

by:webcs
ID: 7171922
I'm not sure if you read the question correctly.

The script works fine on perl fine.  It also runs without error on Perl5, and as said I did escape the @ symbol.

Its not that.
0
 
LVL 2

Author Comment

by:webcs
ID: 7596710
for some reason in perl 5 it accepted the email variable in the array and would not accept the email variable by itself, even if escaped.

Weird...thanks but solved myself, although don't know why.
0
 
LVL 8

Expert Comment

by:davorg
ID: 9484117
No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area that this question is:

PAQ/Refund

Please leave any comments here within the next seven days.

PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!
davorg
EE Cleanup Volunteer
0
 
LVL 5

Accepted Solution

by:
Netminder earned 0 total points
ID: 9537617
PAQed, with points refunded (200)

Netminder
EE Admin
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

I've just discovered very important differences between Windows an Unix formats in Perl,at least 5.xx.. MOST IMPORTANT: Use Unix file format while saving Your script. otherwise it will have ^M s or smth likely weird in the EOL, Then DO NOT use m…
Email validation in proper way is  very important validation required in any web pages. This code is self explainable except that Regular Expression which I used for pattern matching. I originally published as a thread on my website : http://www…
Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now