Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

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

Posted on 2002-07-22
5
Medium Priority
?
304 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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

Enroll in October's Free Course of the Month

Do you work with and analyze data? Enroll in October's Course of the Month for 7+ hours of SQL training, allowing you to quickly and efficiently store or retrieve data. It's free for Premium Members, Team Accounts, and Qualified Experts!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I have been pestered over the years to produce and distribute regular data extracts, and often the request have explicitly requested the data be emailed as an Excel attachement; specifically Excel, as it appears: CSV files confuse (no Red or Green h…
Checking the Alert Log in AWS RDS Oracle can be a pain through their user interface.  I made a script to download the Alert Log, look for errors, and email me the trace files.  In this article I'll describe what I did and share my script.
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…
Six Sigma Control Plans

609 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