Perl Script for Email Demonstration

#!/usr/local/bin/perl
###################################################################
#                                                                 #
# All my scripts are based almost entirely on work done by Daniel #
# Calhoun and modified by me to fit the purpose of the particular #
# script.  My work has been primarily in "tweaking" the scripts.  #
#                                                                 #
###################################################################

&set_var;
&get_web_info;
&html_header;
&check_info;
if ("".@errors > 0)
  {
  &print_errors;
  }
else
  {
  &send_mail;
  &output_html;
  }

#######################################################################
sub print_errors
{
print "<HEAD><TITLE>Errors Detected</TITLE>\n";
print "<STYLE><!--{font-family: Verdana, sans-serif}--></STYLE>\n";
print "</HEAD>\n";
print "<BODY BGCOLOR=\"#FFF9EF\" TEXT=\"#000080\">\n";
print "<CENTER><H1>Errors</H1></CENTER>\n";

print "The following error(s) were detected:";
print "<UL>\n";
foreach (@errors)
  {
  print " <LI>$_: <B>$CODES[$_]</B>\n";
  }
print "</UL>\n";

print "To correct your request, use your browser's <B>BACK</B> button to modify ";
print "the data, and the press the SUBMIT button again.<BR>\n";
print "If you have any problems with this script, please contact ";
print "<A HREF=\"mailto:pauls\@utdallas.edu\">Paul Schmehl</A>.\n\n";
}
#######################################################################
sub html_header
{
print "Content-type: text/html\n\n";
}
#######################################################################
sub check_info
{
$CODES[1] = "You must choose to either receive or not receive email.";
$CODES[2] = "Email address missing.";
$CODES[3] = "Email address appears to be invalid";
$CODES[4] = "Domain name appears to be invalid.";

@errors = ();
if ($FORM{'email'} eq undef)
  { push(@errors, 1); }
if (($FORM{'email'} eq 'Yes') && ($FORM{'address'} eq undef))
  { push(@errors, 2); }
if (($FORM{'email'} eq 'Yes') && ($FORM{'address'} ne undef))
  {
  unless (($FORM{'email'} eq 'Yes') && ($FORM{'address'} =~ /^[\w.\-_%]+@[\w.\-_%]+\.\w{2,3}$/))
    { push(@errors, 3); }
  }
if (($FORM{'email'} eq 'Yes') && ($FORM{'address'} =~ /[\w.\-_%]+@[\w.\-_%]+\.\w{2,3}/))
  {
  $email = ($FORM{'address'});
  $valid = 0;
    if ($email =~ /^[\w.\-%]+@([\w.\-%]+\.\w+)$/)
      {
      $domain = $1;
      }
    elsif ($email =~ /^[\w.\-%]+@([\w.\-%]+)\.([\w.\-%]+\.\w{3})$/)
      {     
      $domain = $2;    
      }
    elsif ($email =~ /^[\w.\-%]+@([\w.\-%]+\.[\w.\-%]+\.\w{2})$/)
      { 
      $domain = $1;    
      }
    elsif ($email =~ /^[\w.\-%]+@([\w.\-%]+\.[\w.\-%]+\.[\w.\-%]+\.\w+)$/)
      {
      $domain = $1;
      }
    elsif ($email =~ /^[\w.\-%]+@([\w.\-%]+\.[\w.\-%]+\.[\w.\-%]+\.[\w.\-%]+\.\w+)$/)
      {
      $domain = $1;
      }
      $cmdstr = "/usr/sbin/nslookup -query=cname $domain";
      open (CMD, "$cmdstr|");
      while ()
        {
        if (/mail/)
           { $valid = 1; }
        }
        if ( $valid == 0 )
           { push(@errors, 4); }
  }
}
#######################################################################
sub set_var
{
# SET THESE VARIABLES................

$mailprog = '/usr/lib/sendmail';
$recipient = 'pauls@utdallas.edu';
}
#######################################################################
sub get_web_info
{
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
foreach $pair (@pairs)
    {
    ($name, $value) = split(/=/, $pair);
    $value =~ tr/+/ /;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $FORM{$name} = $value;
    }
}
#######################################################################
sub send_mail
{
open (MAIL, "|$mailprog $recipient") || die "Can't open $mailprog!\n";

print MAIL "To: $recipient\n\n";

print MAIL "Email: $FORM{'email'}\n";
print MAIL "Address: $FORM{'address'}\n";
print MAIL "Comments: $FORM{'comments'}\n\n";
print MAIL "--------------------------------------------------------\n";
print MAIL "Remote host: $ENV{'REMOTE_HOST'}\n";
print MAIL "Remote IP address: $ENV{'REMOTE_ADDR'}\n";
print MAIL "--------------------------------------------------------\n";
close (MAIL);
}
###########################################################################
# The Web Page result goes here
# Print out a content-type for HTTP/1.0 compatibility

sub output_html
{
print "<STYLE><!--{font-family: Verdana, sans-serif}--></STYLE>\n";
print "<TITLE>Thank You</TITLE>\n";
print "<BODY BGCOLOR=\"#FFF9EF\" TEXT=\"#000080\">\n";
print "<FONT SIZE=+1><B><I>Thank You!</I></B></FONT>\n";
if ($FORM{'email'} eq 'Yes')
  {
  print " A confirmation of your request will be sent to: <B>$email</B>.<BR><BR>\n";
  print " The confirmation email will include a token which you must return\n";
  print " within 24 hours,<BR>or your subscription will fail.<BR><BR>Please read\n";
  print " the instructions carefully, and respond in a timely manner.<BR>\n";
  print " \(And don't forget to save the list instructions when you subscribe.\)<BR><BR>\n";
  print " Thank you very much for your subscription!\n";  
  }
else
  {
  print " We respect your privacy, and you will not receive email from us.<BR><BR>\n";
  print " Should you change your mind in the future, please revisit our web site<BR>\n";
  print " and fill out this form to request addition to our mailing list.<BR><BR>\n";
  print " All our lists are opt-in with confirmation.  If you are forge-subscribed<BR>\n";
  print " to one of our lists, examine the confirmation message.  It will include<BR>\n";
  print " the hostname and IP address of the person who forge-subscribed you.<BR><BR>\n";
  print " You can use that information to report that person to their provider for\n";
  print " appropriate action.<BR><BR>\n";
  }
print "Please return to my <A HREF=\"http://www.utdallas.edu/~pauls/\">Home Page</A>\n";
print "</BODY>\n";
}
Last revised: Tuesday, 04-Apr-2006 01:11:12 CDT