perl script update

woody2010 has asked for the wisdom of the Perl Monks concerning the following question:

With help, I wrote a script about 10 years ago that let us send emails from a webpage to selected groups or individuals. Its always worked great. It uses sendmail from our webhost, but as of late, certain domains are blocking the messages. Probably because they aren't origination from the name we use to send them. The only thing I can think of is it update the script to send them from gmail since our email domain is now hosted on google. Is this possible to do with my current script>


#!/usr/bin/perl

$status_message = '<h1>Your message has been sent!</h1><p><input type=
+"button" onclick="javascript:self.close()" value="Close Window"><p>';
$debug = '0'; # 1 is on 0 is off
#$url_to_this_script = 'www.mydomain.com/cgi-bin/paging.cgi';
$default_email_from = 'paging@mydomain.com';

# if your html has single quotes you'll need to backslash them -> ' be
+comes \' or else you'll get an error
# add your html here between the single quotes

$html_head = '
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http:/
+/www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1
+" />
<meta http-equiv="Cache-Control" content="no-cache" /> 
<title> Fire District :: Paging</title>
<link href="../styles/reports.css" rel="stylesheet" type="text/css" />
<script src="../scripts/paging.js" language="JavaScript" type="text/ja
+vascript"></script>
</head>
<body>
';

$html_foot = '
</body></html>
';

############## do not edit below this line ##########

require '/home/mydomain/mydomaincontact.lib';

use CGI;

my $cgi=new CGI;

$a = $cgi->param('a');
$f = $cgi->param('f');
$b = $cgi->param('b');
$z = $cgi->param('z');
$x = $cgi->param('x');
$g = $cgi->param('g');
@t = $cgi->param('t');




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

if($x eq 'all') {
        @t = '';
        foreach $key(keys %name_email) {
                if($key) {
                        push(@t, $name_email{$key});
                }
        }
}
if($x eq 'group') {
    if(exists($groups{$g})) {
        $email_list = $groups{$g};
        $email_list =~ s/^\,|\,$//;
        @t = split(/,/, $email_list);
    }
    else {
        print "<p><strong>ERROR : Send to group selected but no group 
+specified!</strong></p> \n $html_foot";exit;
    }
}

if($a eq 'send') { &send; } else { &main; }

print $html_foot;

exit;

sub main {

        foreach $key(sort keys %name_email) {
                $mo = "$mo <option value=\"$name_email{$key}\"> $key <
+/option> \n";
        }

@gp_name = keys %groups;
if(@gp_name) {

    $group_menu_code = "All Members<br /> <input type=\"radio\" name=\
+"x\" value=\"group\" /> Specific Group <select name=\"g\"> <option va
+lue=\"\"> Select Group </option> \n";

    foreach $grp(@gp_name) {

        $group_menu_code = "$group_menu_code <option value=\"$grp\"> $
+grp </option> \n";

    }
    $group_menu_code = "$group_menu_code </select> \n";

}
        print <<FORM;
<table width="95%" align="center">
  <tr>
    <td><h1>Paging</h1></td>
  </tr>
  <tr>
    <td><form action="paging.cgi" method="get" name="paging" id="pagin
+g">
        <table border="0">
          <tr>
            <td colspan="2">&nbsp;</td>
          </tr>
          <tr>
            <td colspan="2"><select name="t" multiple="multiple"  size
+="20">
            $mo
              </select>
              <br />
              <span class="xsmallRed">Hold down the Ctrl or Shift key 
+to select multiple addresses</span></td>
          </tr>
          <tr>
            <td colspan="2">&nbsp;</td>
          </tr>
          <tr>
            <td colspan="2"><strong> Send Page To: </strong></td>
          </tr>
          <tr>
            <td colspan="2"><input checked="checked" type="radio" name
+="x" value="menu" />
              Member(s) selected above<br />
              <input type="radio" name="x" value="all" />
              $group_menu_code  </td>
          </tr>
          <tr>
            <td colspan="2">&nbsp;</td>
          </tr>
          <tr>
            <td><strong>Message &#8211; Part 1:</strong><br />
              <span class="xsmallRed">If your message exceeds 130 char
+acters, type the rest of your message in the Part 2 box below</span><
+br />
              <textarea name="b" cols="40" rows="3" id="b" onkeydown="
+textCounter(this.form.b,this.form.remLen1,130);" onkeyup="textCounter
+(this.form.b,this.form.remLen1,130);"></textarea>
            </td>
            <td>&nbsp;</td>
          </tr>
          <tr>
            <td><input readonly="readonly" name="remLen1" type="text" 
+id="remLen1" value="130" size="3" maxlength="3" />
              characters remaining </td>
            <td>&nbsp;</td>
          </tr>
          <tr>
            <td>&nbsp;</td>
            <td>&nbsp;</td>
          </tr>
          <tr>
            <td colspan="2"><p><strong>Message &#8211; Part 2:</strong
+><br />
                <span class="xsmallRed">you may enter up to 130 charac
+ters</span><br />
                <textarea name="z" cols="40" rows="3" id="z" onkeydown
+="textCounter(this.form.z,this.form.remLen2,130);" onkeyup="textCount
+er(this.form.z,this.form.remLen2,130);"></textarea>
                </p>
            </td>
          </tr>
          <tr>
            <td colspan="2"><input readonly="readonly" name="remLen2" 
+type="text" id="remLen2" value="130" size="3" maxlength="3" />
characters remaining</td>
          </tr>
          <tr>
            <td colspan="2">&nbsp;</td>
          </tr>
          <tr>
            <td colspan="2"><input type="hidden" name="a" value="send"
+ />
              <input type="submit" value="Send Page" />
            </td>
          </tr>
          <tr>
            <td colspan="2">&nbsp;</td>
          </tr>
        </table>
      </form></td>
  </tr>
</table>
FORM

}

sub send {
    if(!$b) { $error .= "Enter a message"; }
    if($error) { print "<p><strong>Use the back button and fill in the
+ missing items:</strong></p> \n <p>$error</p>$html_foot";exit; }


        if($debug == 1) {
                print "<pre>Info sent to be processed : \nA-$a \nX-$x 
+\nTo - @t \nFrom-$f \nBody-$b \n </pre>$html_foot";
        }
        else {
        #       if($f =~ /^(\w+).*\@(\w+).*\..*(\w+)$/) {
                        $date = `date`;
                        foreach $ad(@t) {
                                $ad =~ s/([^\x20-\x7E])//ge;
                                $ad =~ s/\n|\ |\r//g;
                                if($ad =~ /^(\w+).*\@(\w+).*\..*(\w+)$
+/) {
                                        open (MAIL,"|/usr/sbin/sendmai
+l -i -t -f $default_email_from")||&status("$f could not send the emai
l \"$s\" to $ad <br /> \n");
                                        print MAIL "To: $ad \nFrom: $d
+efault_email_from \n";
                                        print MAIL "$b \n";
                                        close(MAIL);

                                if(length($z) > 0) {

                                        open (MAIL,"|/usr/sbin/sendmai
+l -i -t -f $default_email_from")||&status("$f could not send the emai
+l \"$s\" to $ad <br> \n");
                                        print MAIL "To: $ad \nFrom: $d
+efault_email_from \n";
                                        print MAIL "$z \n";
                                        close(MAIL);

}
&status("-$ad- sent ok </p> \n");

                                }
                        }
                print "$status_message";

        #       } else { print "ERROR : from email address bad format 
+<br /> \n$html_foot \n";exit; }
        }
}

sub status {

        $status_message = "$status_message $_[0]";
}
[download]

Comment on perl script update Download Code

Replies are listed 'Best First'.
Re: perl script update by Don Coyote (Hermit) on Apr 16, 2013 at 06:44 UTC
Hello woody2010 and welcome to the monastery. A quick sanity check on a ten year old script is your best starting point, you will have a better understanding of perl now, and will more easily be able to spot errors preventing successful transmission. `$mo = "$mo <option value=\"$name_email{$key}\"> $key < +/option> \n"; # my $mo ?` [download] Will have flagged straight away with the `use warnings` & `use strict` pragmas. `open(MAIL, "\|usr/bin/sendmail") \|\|&staus('update status message');` Does not exit gracefully on failure. What the code appears to do is update the status message to 'could not send' and then continue to attempt to send the message, returning a succesfully sent headed page to the user with a message declaring the message 'could not send'. A further and probably the most important sanity check would be to run the script in Taint mode. `#!usr/bin/perl -T` The pipe open on 'user submitted'(?) email addresses, re where does `$mo` originate from? Is a priority concern. Taint mode will hold the fort for you, while you convert this into a fork(exec sendmail) routine. Form action should generally be post rather than get, `$mo` again. It would not be inconceivable that a savvy hacker could supply their own list for `$cgi->param('t')`, resulting in spam reports on emails from your domain, leading to your domain being blocked. So a number of things to look at really, try those. When the script is operating properly, you may better be able to identify the cause of the problem.	[reply] [d/l] [select]
Re: perl script update by educated_foo (Vicar) on Apr 16, 2013 at 14:11 UTC
This is an SMTP question rather than a Perl one. The first step would be to try just changing the "-f" address (the envelope sender) to something gmail, to see if that works. If not, you'll want to find out why your message is being rejected, either by looking at the logs, or by talking a bit of SMTP by hand. Basic SMTP is actually pretty easy -- look at RFC 822 for details, then telnet from your server to port 25 on the recipient's mail server and play around. Just another Perler interested in Algol Programming.	[reply]