Access denied

#!/usr/bin/perl

# (c) 2001-2008 Alexander Thomas
# Simple e-mail form script.
# This script is free to use. It may not be sold.
# Use of this script is at your own risk. There is no guarantee
# or liability whatsoever for fitness for any purpose.
#
# INSTRUCTIONS:
# Fill in the correct values in the Parameter section below.
# Make a form on your website with method "POST" and as action the
#   URL of this script on your server. (Of course this script must
#   have execute permissions.)
# The form can contain the following fields (case sensitive). You can
#   easily fix the values for certain fields by making them hidden:
#   -from: the e-mail address of the sender
#   -sendername: the name of the sender
#   -carboncopy (checkbox): if this is checked, a copy of the message
#     will be sent to the address in 'from'.
#   -subject: subject of the mail
#   -nextpage: the page to be loaded after sending the mail. If empty,
#     the message itself will be displayed instead.
#   -message: the message itself
# You can add custom fields by modifying the mail_it subroutine below.

##################################################################
#
# PARAMETER SECTION

# Your system's e-mail program, typically either /usr/sbin/sendmail or
# /usr/lib/sendmail
  $MAIL_PROGRAM='/usr/sbin/sendmail';

# The e-mail address to send the mails to.
  $RECIPIENT='YOUR@E-MAIL.HERE';

# If set, is where the script can be called from. You'll want to put
# your domain name in here so that only you can run this script.
# Leave off http:// and anything that may be omitted, like 'www.'.
# Use () for no restrictions (not recommended!)
  @VALID_DOMAINS = ('YOUR-DOMAIN-HERE.com');

# Put a list here of IPs that should be blocked. You can also omit the
# last parts, like '12.34.56.' or even '12.34.' to block domains.
  @BLOCKED_IPS = ();

##################################################################
#
# MAIL LAY-OUT
#
# You can tailor this to your own needs, e.g. add headers or markers.
# Make sure not to remove essential headers like From, To and Subject,
# and make sure the header section ends with \n\n.

sub mail_it
{
  $theMail  = "To: $RECIPIENT\n";
  $tmp = $fields{'from'};
  if ($fields{'sendername'} ne "") {
    $tmp = "\"$fields{'sendername'}\" <$tmp>";
  }
  $theMail .= "From: $tmp\n";
  if($fields{'carboncopy'} eq 'on') {
    $theMail .= "Cc: $tmp\n";
  }
  $theMail .= "Subject: $fields{'subject'}\n";
  $theMail .= "Return-Path: <$fields{'from'}>\n";

  $theMail .= "X-Http-Remote-Addr: $ENV{'REMOTE_ADDR'}\n";
  $theMail .= "X-Http-Forwarded-For: $ENV{'HTTP_X_FORWARDED_FOR'}\n";
  $theMail .= "X-Http-User-Agent: $ENV{'HTTP_USER_AGENT'}\n";
  $theMail .= "X-Http-Referer: $ENV{'HTTP_REFERER'}\n\n";
  
  $theMail .= "$fields{'message'}";

  open(MZT,"|$MAIL_PROGRAM -t") || die "Unable to send mail: $^E";
  print MZT $theMail;
  close(MZT);
}


# MAIN ###########################################################
# This is where the script starts execution from
  &valid_page;
  &decode_vars;
  &test_required;
  
  &mail_it;

  if ($fields{'nextpage'} ne "") {
    print "Location: $fields{'nextpage'}\n\n";
  }
  else {
    $theMail =~ s/</&lt;/g;
    $theMail =~ s/>/&gt;/g;
    print "Content-type: text/html\n\n<HTML>\n<PRE>$theMail</PRE>\n</HTML>";
  }
  exit;


##################################################################
# You can extend this function to test for a mandatory answer on
# a simple question, to thwart spambots. You could also use a
# 'mouse trap' field, which must be empty, and reject messages
# where this field is not empty.
sub valid_page
{
  $DN = $ENV{'HTTP_REFERER'};
  if ($#VALID_DOMAINS + 1 eq 0 || $DN eq "") {
    return;
  }
  foreach $referer (@VALID_DOMAINS) {
    if ($DN =~ m|https?://([^/]*)$referer|i) {
      $referer_ok = 1;
      last;
    }
  }
  if ($referer_ok != 1) {
    $errmesg ="<B>Sorry! You can't run this script from your server. Please use your own script.</B><br>";
    &error_exit;
  }
  
  $RA = $ENV{'REMOTE_ADDR'};
  if ($#BLOCKED_IPS + 1 eq 0 || $RA eq "") {
    return;
  }
  foreach $ip (@BLOCKED_IPS) {
    if ("X$RA" =~ "X$ip") {
      $errmesg ="<H1>Access denied</H1><br>";
      $errmesg .="You are not allowed to send mail because there has been a case of abuse originating from your address. There are two possibilities:<br>1. Your internet connection uses a shared access point (e.g. proxy server) and an other user of the same network is responsible. In this case we're sorry, but we really can't block users on a finer grain than this.<br>2. You are the offender. No further explanation necessary.";
      &send_blocked_notice;
      &error_exit;
    }
  }
}

##################################################################
sub decode_vars
{
  $i=0;
  if ( $ENV{'REQUEST_METHOD'} eq "GET") {
    $temp=$ENV{'QUERY_STRING'};
  }
  else {
    read(STDIN,$temp,$ENV{'CONTENT_LENGTH'});
  }
  @pairs=split(/&/,$temp);
  foreach $item(@pairs) {
    ($key,$content)=split(/=/,$item,2);
    $content=~tr/+/ /;
    $content=~s/%(..)/pack("c",hex($1))/ge;
    
    # Nuke filthy windoze newline junk!
    $content =~ s/\r\n/\n/g;
    $fields{$key}=$content;
  }
}

##################################################################
sub test_required
{
  $testmail = $fields{'from'};
  if ($testmail ne "" && &bad_address eq 'YES') {
    $testmail =~ s/</&lt;/g;
    $testmail =~ s/>/&gt;/g;
    $errmesg = "<B>Bad e-mail format: \"$testmail\"</B><br>";
    $errmesg .= "<br>Press your BACK BUTTON to return to the entry form.";
    &error_exit;
  }
}

##################################################################
sub bad_address 
{
  $BAD_EMAIL='NO';
  if ($testmail eq "") {
    $BAD_EMAIL='YES';
  }
  if ($testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||
   $testmail =~ / / ||
   $testmail !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/)
  {
    $BAD_EMAIL='YES';
  }
  return $BAD_EMAIL;
}

##################################################################
sub error_exit
{
  print "Content-type: text/html\n\n";
  print <<__END_OF_ERROR__;
<BLOCKQUOTE>
$errmesg
</BLOCKQUOTE>
__END_OF_ERROR__
  exit;
}

##################################################################
sub send_blocked_notice
{
  $theMail  = "To: $RECIPIENT\n";
  $theMail .= "From: blocked\@YOUR-DOMAIN-HERE.com\n";
  $theMail .= "Subject: \@Blocked IP deflected\n\n";
  
  $theMail .= "$ENV{'REMOTE_ADDR'} ($ENV{'HTTP_X_FORWARDED_FOR'}) was denied access to sendmail!\n";
  $theMail .= "User-Agent: $ENV{'HTTP_USER_AGENT'}\n";
  $theMail .= "Http-Referer: $ENV{'HTTP_REFERER'}\n";

  open(MZT,"|$MAIL_PROGRAM -t") || die "Unable to send mail: $^E";
  print MZT $theMail;
  close(MZT);
}