Coding Domain: CGI Perl Programs: X-Mailfrom Listing

CGI Programming: Perl

Downloads
X-Mailform
Mailform Script Listing

The X-Mailform.cgi script can be used to submit the results of an input field via e-mail.
This page includes the entire listing
#!/usr/bin/perl -w ## -T? ## Put your perl path here ##


##################################################################################################
##################################################################################################
##                                                                                 Version 1.01 ##
##                                                                            14 September 2001 ##
##    X-MailForm.cgi                                                                            ##
##                                                                                              ##
##                 Copyright (c) 2001 Diederik van der Boor - All Rights Reserved.              ##
##                                                                                              ##
##                 Originally published and documented at http://www.codingdomain.com           ##
##                 License to use is granted if and only if this                                ##
##                 entire copyright notice is included.                                         ##
##                                                                                              ##
##                 I like to maintain a list of implementations around the world,               ##
##                 and I'll properly let you know if something has changed, or bugs show up.    ##
p
##                 So just mail me at vdboor-REMOVE_THIS-@codingdomain.com                      ##
##                                                                                              ##
##                                                                                              ##
##################################################################################################
##################################################################################################


# Load modules.
use strict;
use CGI qw(:cgi);

# Change this IF you have the Coding Domain Modules installed.
#use CGI::ErrorTrap;
use CGI::Carp qw(fatalsToBrowser);


##
# Usage:
# 1 Change the settings below
#
# 2 Write this HTML code in your website.
#
# <FORM method="POST" action="/cgi-bin/x-mailform.cgi">
#    <INPUT type="hidden" name="to"        value="admin">                <!-- alias for e-mail address -->
#
#    <INPUT type="hidden" name="pageok"    value="/mail/pageok.html">    <!-- OK -->
#    <INPUT type="hidden" name="failfrom"  value="/mail/failfrom.html">  <!-- e-mail invalid -->
#    <INPUT type="hidden" name="failparam" value="/mail/failparam.html"> <!-- parameter missing -->
#    <INPUT type="hidden" name="failsend"  value="/mail/failsend.html">  <!-- network error -->
#
#    <INPUT type="text" name="name">
#    <INPUT type="text" name="from">
#    <TEXTAREA name="message"></TEXTAREA>
#  </FORM>
##



##################################################################################################
##################################################################################################



# Lot's of 'constants'
use constant SHOW_DEBUG => 0;
use constant POST_ONLY => 1;


# Settings

my $PARAM_SENDMAIL             = '/usr/sbin/sendmail';      ## default = /usr/bin/sendmail
my $PARAM_RELAYHOST            = 'mail.codingdomain.com';   ## default = current virtual host name.



# hashes who link synonims to real e-mail addresses.
# Don't include the real address in html code,
# You would become a spam server, and it's all your fault...

my %sendto                     =   (
                                     admin    => 'demo@somesite.com',
                                     other    => 'demo@somesite.com',  # this is picked as default
                                    );
my %subjects                   =   (
                                     admin    => 'Coding Domain Messsage - ADMIN',
                                     other    => 'Message from X-MailForm.cgi'
                                   );

my @OKDomains                  =   (
                                     'http://www.codingdomain.com',
                                     'http://jp0013',          # My test server... ;-)
                                   );






#################################################################################################


# Read and process the data.
my $PARAM_MESSAGE              = param( 'message'     )     || '';

my $PARAM_SENDTO               = param( 'to'          )     || '';

my $PARAM_SENDNAME             = param( 'name'        )     || '';
my $PARAM_SENDFROM             = param( 'from'        )     || '';

my $PARAM_RESULTOK             = param( 'pageok'      )     || '';

my $PARAM_RESULTFAILFROM       = param( 'failfrom'    )     || '';
my $PARAM_RESULTFAILPARAM      = param( 'failparam'   )     || '';
my $PARAM_RESULTFAILSEND       = param( 'failsend'    )     || '';


if( @OKDomains )
{
  my $CallerDomain = referer;
  my $OK = 0;

  if(defined $CallerDomain)
  {
    check:foreach my $Domain (@OKDomains)
    {
      if( $CallerDomain =~ m[^\Q$Domain])
      {
        $OK = 1;
        last check;
      }
    }
  }

  if(! $OK)
  {
    GoReply('', "You can't use an external server to send e-mail using this script.");
  }
}



#################################################################################################
# The regexp strips the line after the newline character.
# We're sure now that they don't contain other SMTP header tags!

for($PARAM_SENDTO, $PARAM_SENDNAME, $PARAM_SENDFROM, $PARAM_RESULTOK, $PARAM_RESULTFAILFROM, $PARAM_RESULTFAILPARAM, $PARAM_RESULTFAILSEND)
{
  if(defined && /^(.*)\n/)
  {
    $_ = $1;
  }
}


#################################################################################################
# Redirect to correct page, and send mail if everything looks ok

if( POST_ONLY && (request_method || '') ne 'POST')
{
  GoReply('', "This page can only be send from POST requests.");
}

if ($PARAM_SENDFROM eq '')                    { GoReply($PARAM_RESULTFAILFROM,  "Message could not be sent, because you didn't fill in your e-mail address!"); }
if ($PARAM_SENDNAME eq '')                    { GoReply($PARAM_RESULTFAILPARAM, "Message could not be sent, because you didn't fill in your name!"); }
if ($PARAM_SENDFROM !~ /^(.+)\@(.+)\.(.+)$/)  { GoReply($PARAM_RESULTFAILFROM,  "Message could not be sent, because your e-mail address is not filled in correctly. It should look like: \'you\@domain.com\'"); }
if ($PARAM_MESSAGE  eq '')                    { GoReply($PARAM_RESULTFAILPARAM, "Message could not be sent, because you didn't enter one!"); }



#################################################################################################
# Send the e-mail

if (!SendMailForm()) { GoReply($PARAM_RESULTFAILSEND, "Failed to deliver the message via e-mail! " . ($! || $? || $@)); }
                     { GoReply($PARAM_RESULTOK, "Your message has been send, but the standard confirmation page is missing!"); }



##################################################################################################
# Mail senders

##################################################################################################
# use sendmail pipe

sub SendMail
{ my ($sendmailpath, $from, $to, $subject, @body) = @_;

  my $sendmail = ($sendmailpath || '/usr/lib/sendmail');

  if (! -e $sendmail) { return 0; }

  open(MAIL, "|$sendmail -t -oi -odq") or return 0;
  {
    print MAIL "To: $to\n";
    print MAIL "From: $from\n";
    print MAIL "Subject: $subject\n";
    print MAIL "\n";
    print MAIL "\n";
    foreach my $line (@body)
    {
      print MAIL ($line || "") . "\n";
    }
  }
  close(MAIL);

  return 1;
}

##################################################################################################
# use Net::SMTP

sub SendPerlMail
{ my ($relayhost, $from, $to, $subject, @body) = @_;
  eval('$relayhost = ($relayhost || virtual_host);');

  return 0 if !   eval('use Net::SMTP;');

  my $SMTPObj = eval('Net::SMTP->new($relayhost, Timeout => 60);');

  return 0 if !   defined $SMTPObj;
  return 0 if !   $SMTPObj->mail($from);                     ## Real from-address.
  return 0 if !   $SMTPObj->recipient($to);                  ## Real to-address.
  return 0 if !   $SMTPObj->data();                          ## begin data and SMTP header
  return 0 if !   $SMTPObj->datasend("To: $to\n");           ## The user will see this address
  return 0 if !   $SMTPObj->datasend("From: $from\n");       ## The user will see this address
  return 0 if !   $SMTPObj->datasend("Subject: $subject\n"); ## Subject that will be displayed.
  return 0 if !   $SMTPObj->datasend("\n");                  ## Empty line: End of header.
  return 0 if !   $SMTPObj->datasend("\n");                  ## Empty line: End of header.
  foreach my $line (@body)                                   ## Send Message
  {
    return 0 if ! $SMTPObj->datasend(($line || "") . "\n");
  }
  return 0 if !   $SMTPObj->dataend();                       ## End of email data
  return 0 if !   $SMTPObj->quit();                          ## Close connection
  return 1;
}


##################################################################################################
# Mail the e-mail message


sub SendMailForm
{
  my $body = "";
  my $PARAM_EMAILTO   = ($sendto{$PARAM_SENDTO}   || $sendto{'other'});
  my $PARAM_SUBJECT   = ($subjects{$PARAM_SENDTO} || $subjects{'other'});

  $body .= "<< POSTED MESSAGE AT: " . virtual_host . " >>\n";
  $body .= "\n";
  $body .= "From:              " . $PARAM_SENDNAME . "\n";
  $body .= "\n";
  $body .= "\n";
  $body .= "_MESSAGE___________________________________\n";
  $body .= "$PARAM_MESSAGE\n";
  $body .= "\n";
  $body .= "___________________________________________\n";
  $body .= "Server name:       " . (server_name || "<anonymous>") . "\n";
  $body .= "Send by CGI:       " . (url || script_name || "<undefined>") . " -> $0\n";
  $body .= "Document:          " . (referer || "<direct connect>") . "\n";   ## spelling error: the standard has been misspelled
  $body .= "Request type:      " . (request_method || "<undefined>") . "\n";
  $body .= "Request User:      " . $PARAM_SENDTO . "\n";
  $body .= "Request Email:     " . $PARAM_EMAILTO . "\n";
  $body .= "\n";
  $body .= "_USER INFO_________________________________\n";
  $body .= "Browser:           " . (user_agent || "<unknown>") . "\n";
  $body .= "Accept Type:       " . (join(' / ', Accept) || "<undefined>") . "\n";
  $body .= "Remote host:       " . (remote_host || "<anonymous>") . "\n";
  $body .= "Remote user:       " . (remote_user || "<anonymous>") . "\n";
  $body .= "Remote ID:         " . (remote_ident || "<anonymous>") . "\n";
  $body .= "Cookies:           " . (join(' / ', raw_cookie) || "<none>") . "\n";
  $body .= "\n";
  if(SHOW_DEBUG)
  {
    $body .= "\n";
    $body .= "\n";
    $body .= "_SERVER INFO_______________________________" . "\n";
    $body .= "Server runs:       $^O / " . (server_software || "<undefined>") . "\n";
    $body .= "Upload disabled:   " . ($CGI::DISABLE_UPLOADS || "<undefined>") . "\n";
    $body .= "Upload max:        " . ($CGI::POST_MAX || "<undefined>") . "\n";
    $body .= "\n";
    $body .= "_SERVER ENVIRONMENT VARIABELS______________" . "\n";
    foreach my $var (sort keys %ENV) { $body .= "$var = $ENV{$var}<BR>\n"; }
    $body .= "\n";
  }
  $body .= "\n";

  if(! SendPerlMail($PARAM_RELAYHOST, $PARAM_SENDFROM, $PARAM_EMAILTO, $PARAM_SUBJECT, $body))
  {
    return SendMail($PARAM_SENDMAIL, $PARAM_SENDFROM, $PARAM_EMAILTO, $PARAM_SUBJECT, $body);
  }
  else
  {
    return 1;
  }
}




##################################################################################################
# Redirection.


sub GoReply
{ my ($URL, $Action) = @_;

  if ( defined($URL) && $URL)
  {
    print redirect($URL);
  }
  else
  {
    print header;
    print <<HTML;
<HTML>
  <HEAD>
    <TITLE> Auto reply page for Submission form </TITLE>
    <META name="generator" content="X-mailform CGI script">
    <META name="robots" content="none">
    <META name="cache" content="no">
  </HEAD>
  <BODY text="#000000" bgcolor="#FFFFFF"><FONT size="-1">
    <H1> <FONT face="Arial, Times new Roman, times, sans-serif" color="#0000CC"> Auto reply page. </FONT> </H1>
    <FONT size="+1"> $Action </FONT> <BR>
    <BR>
    <BR>
    <FONT face="Verdana, Arial, Times new Roman, times, sans-serif">
      Your form has been processed by this mailform script, <BR>
      but that doesn't guarantee that your message has been send. <BR>
      Otherwise, you shouldn't see this page now. <BR>
      However, the administrator/webmaster of the site you are from <BR>
      didn't set a valid reply page for the result of your submission. <BR>
      <BR>
      <EM>
        If you're not the administrator of the website, please send an e-mail to this <BR>
        site's administrator/webmaster, giving this error message and the time and date of the error.
      </EM>
    </FONT>
    <BR>
  </FONT></BODY>
</HTML>
HTML
  }
  exit;
}


##################################################################################################
##################################################################################################
# EOF.
CGI Programming: Perl

Mailform Script Listing

Author
