Monks,
I'm using an upgraded version of FormMail.pl with various checks added for spam. We check a database of bad words, and present a question on the form like "What month does Santa come?" just for basic security. Somehow, hackers are getting past all of it. Even if I hard code the address the form can send to they get around it. Even if a word is on the bad words list they get around it. I'm baffled. Perhaps someone can point me in the right direction.
#!/usr/local/bin/perl
# $Id: formmail.pl,v 1.15 2007/12/14 12:04:37 pjmclaug Exp $
### Updated by pair Networks for added security and spam protection
### See: http://www.pair.com/pair/support/library/systemcgi/formmail.h
+tml
### Last Modified 06/03/02
######################################################################
+########
# FormMail Version 1.5
+ #
# Copyright 1996 Matt Wright mattw@misha.net
+ #
# Created 6/9/95 Last Modified 04/04/2001
+ #
# Additional security and bug fixes added for use on pair Networks' se
+rvers #
# See: http://www.pair.com/pair/support/library/systemcgi/formmail.htm
+l #
# Scripts Archive at: http://www.worldwidemart.com/scripts/
+ #
######################################################################
+########
# COPYRIGHT NOTICE
+ #
# Copyright 1996 Matthew M. Wright All Rights Reserved.
+ #
#
+ #
# FormMail may be used and modified free of charge by anyone so long a
+s this #
# copyright notice and the comments above remain intact. By using thi
+s #
# code you agree to indemnify Matthew M. Wright from any liability tha
+t #
# might arise from it's use.
+ #
#
+ #
# Selling the code for this program without prior written consent is
+ #
# expressly forbidden. In other words, please ask first before you tr
+y and #
# make money off of my program.
+ #
######################################################################
+########
#use strict;
use CGI qw(param);
#####
#SDO custom fields that you want to specify must be listed here...
#####
my @CONFIG_FIELDS = qw(question subject email realname redirect backgr
+ound
bgcolor link_color vlink_color print_blank_fields
text_color alink_color title print_config return_l
+ink_title
required sort return_link_url env_report username
missing_fields_redirect print_config_to_html messa
+ge organization Url);
my @DAYS = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturd
+ay);
my @MONTHS = qw(January February March April May June July
August September October November December);
my $userfile = '.formmail';
my $query = new CGI;
# Retrieve Date
my $date = &get_date;
#build config hash
my %CONFIG = &hash_config_data;
########### REQUIRED SETTINGS ##########
$CONFIG{'recipient'} = 'me@me.com';
$CONFIG{'site'} = 'me.com';
$CONFIG{'required'} = 'email,realname,message,question';
$CONFIG{'redirect'} = 'https://www.me.com/sent/';
$CONFIG{'env_report'} = 'REMOTE_HOST,HTTP_USER_AGENT';
$CONFIG{'subject'} = 'Me.com Feedback';
my $site_domain = "me.com";
my @referers = ('www.me.com','me.com');
########### END REQUIRED SETTINGS ##########
$CONFIG{'realname'} =~ s/\r/ /g;
$CONFIG{'realname'} =~ s/\n/ /g;
$CONFIG{'email'} =~ s/\r/ /g;
$CONFIG{'email'} =~ s/\n/ /g;
#make sure method=post
&error('request_method')
if $ENV{'REQUEST_METHOD'} !~ /^POST$/i;
# Check Required Fields
&check_required;
# Check the Question Field
&check_question;
# Check Recipient of mail
&check_recipient;
&check_url;
&log_entry;
# Send E-Mail
&send_mail;
# Return HTML Page or Redirect User
&return_html;
###################
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');
print "Content-type: text/html\n\n";
#&Print_Page_Top;
print qq~
<br><br>
<center><p><font face=arial><h1><b><font color=red>Error</font>: Y
+our message seems like spam!</b></h1></font></p></center><br><br><br>
+<br>
~;
die
}
}
#######################################
# Sub to check for spam and log entry
sub log_entry {
$regtype = $CONFIG{'regtype'};
$username = $CONFIG{'reguser'};
$ID = $CONFIG{'ID'};
$message = $CONFIG{'message'};
$URL = $CONFIG{'Url'};
$IP = $ENV{'REMOTE_HOST'};
require "/usr/home/account/public_html/mysite/cgi-bin/db-common.sub" |
+| die "Error loading db-common.sub";
&Conn_to_DB;
##### CHECK FOR SPAM #####
$SQL3 = "SELECT badwords FROM badwords";
&Do_SQL3;
$pointer3 = $sth3->fetchrow_hashref;
$badword = $pointer3->{'badwords'};
@badwords = split /\n/,$badword;
foreach $badword (@badwords) {
# Strip any extra CR/LF's
$badword =~ s/\n//g;
$badword =~ s/\r//g;
if ($message =~ /$badword/i){
$badword_found = 1;
$bad_entered =($badword);
}
} # end foreach $badword (@badwords)
if (($badword_found == 1)) {
print "Content-type: text/html\n\n";
&Print_Page_Top;
print qq~
<br><br>
<center><p font size=+1><b><font color=red>Error</font>: Your mess
+age seems like spam!</b></p></center><br><br><br><br>
~;
$log = "$username tried to submit spam email";
$notes = "$message<br><br>URL Reporting: $URL";
&log_it;
exit;
}
}
####### END CHECK FOR SPAM #######
sub get_date {
my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime();
return sprintf ("%s, %s, %d, %d at %02d:%02d:%02d",
$DAYS[$wday],
$MONTHS[$mon],
$mday,
$year + 1900,
$hour,
$min,
$sec);
}
sub hash_config_data {
my %hash;
foreach (@CONFIG_FIELDS) {
$hash{$_} = $query->param($_) if $query->param($_);
}
return %hash;
} #end sub hash_config_data
sub check_required {
my @required = split(/,/,$CONFIG{'required'});
my @error_fields;
foreach (@required) {
(my $field = $_) =~ s/(^\s+|\s+$)//g;
if (!$query->param($field)) { push(@error_fields, $field); }
}
&error('missing_fields',@error_fields) if @error_fields;
}
sub check_recipient {
my $user;
($user) = ($ENV{'DOCUMENT_ROOT'} =~ m#/usr/wwws?/users/([a-z0-9_\-
+]+)#i);
if (!$user) { $user = $CONFIG{'username'}; }
$CONFIG{'recipient'} =~ s/\s+//g;
my @recipient = split(/,/,$CONFIG{'recipient'});
foreach my $address (@recipient) {
my ($domain) = ($address =~ /^[^@%!]+\@([A-Za-z0-9\.\-]+)$/)
or &error('invalid_recipient');
&error('bad_recipient') unless ($domain =~ /^$site_domain$/i)
+||
&in_rcpt($domain) || &in_userfile($address,$user);
}
} #end sub check_recipient
sub in_rcpt {
my $domain = shift;
open(FILE,'/var/qmail/control/morercpthosts') || &error('file_unope
+ned');
while (<FILE>) { chomp; return 1 if /(^\Q$domain\E$)|(\@\Q$domain\E
+$)/i; }
close(FILE);
return 0;
} #end sub in_rcpt
sub in_userfile {
my $address = shift;
my $user = lc(shift);
return 0 if $user !~ /^[a-z0-9]{2,8}$/;
open(FILE,"/usr/home/$user/$userfile") || return 0;
while (<FILE>) { chomp; if (/^\s*\Q$address\E\s*$/i) { close(FILE)
+; return 1; } }
close(FILE);
return 0;
}
sub return_html {
if ($CONFIG{'redirect'} =~ m#https?://.+\..+#) {
# print the redirectional location header.
print "Location: $CONFIG{'redirect'}\n\n";
} else {
$CONFIG{'title'} ||= 'Thank You';
my $body = &body_attributes;
print "Content-type: text/html\n\n";
print <<" %%%";
<html>
<head>
<title>$CONFIG{'title'}</title>
</head>
<body $body>
<center>
<h1>$CONFIG{'title'}</h1>
</center>
Below is what you submitted to $CONFIG{'site'} on $date
<p><hr><p>
%%%
my @list = &get_fields;
foreach (@list) { print "$_<p>"; }
print "<p><hr><p>";
if ($CONFIG{print_config_to_html}) {
print "Config Fields:<br><br>";
$CONFIG{print_config_to_html} =~ s/\s//g;
my @print_config = split(/,/,$CONFIG{print_config_to_html});
foreach (@print_config) {
print " $_: $CONFIG{$_}<br>" if $CONFIG{
+$_};
}
print "<p><hr><p>";
}
# Check for a Return Link
if ($CONFIG{'return_link_url'} =~ m#https?://.+\..+# && $CONFIG{
+'return_link_title'}) {
print <<" %%%";
<center>
<a href=\"$CONFIG{'return_link_url'}\">$CONFIG{'return_lin
+k_title'}</a>
</center>
%%%
}
print "</body></html>";
} #end else
} #end sub
sub send_mail {
$CONFIG{'subject'} ||= 'WWW form submission';
$CONFIG{realname} and $CONFIG{realname} = "($CONFIG{realname})";
#####
#SDO you must add fields that you want to place in the email here...
# They must also be included at the top of this script
####
#filter NULL characters and new line
#foreach (qw(subject email realname recipient message organization
+Url)) {
# $CONFIG{$_} =~ s/\0|\r|\n//g;
#}
if ($CONFIG{'email'}) {
($ENV{'QMAILUSER'},$ENV{'QMAILHOST'}) = split(/@/,$CONFIG{'email'
+});
}
open(MAIL,"|/var/qmail/bin/qmail-inject") || &error('mail_error');
print MAIL <<"%%%";
From: $CONFIG{'email'} $CONFIG{'realname'}
To: $CONFIG{'recipient'}
Subject: $CONFIG{'subject'}
X-Posted-From: $ENV{'REMOTE_ADDR'}
============================
| F E E D B A C K
============================
| FROM: $CONFIG{'realname'} ($CONFIG{'email'})
| USERNAME:$CONFIG{'username'}
============================
$CONFIG{'message'}
%%%
#SDO commented this stuff out so I could customize this myself
# if ($CONFIG{'print_config'}) {
# $CONFIG{'print_config'} =~ s/\s//g;
# my @print_config = split(/,/,$CONFIG{'print_config'});
# foreach (@print_config) { print MAIL "$_: $CONFIG{$_}\n\n" unl
+ess !$CONFIG{$_}; }
# print MAIL "------------------------- end config fields ------
+----------------------\n\n";
# }
my @list = &get_fields;
#SDO commented this stuff out so I could customize this myself
#foreach (@list) { print MAIL "$_\n"; }
#print MAIL "------------------------------------------------------
+---------------------\n";
print MAIL "======================================\n";
# Send Any Environment Variables To Recipient.
$CONFIG{'env_report'} =~ s/\s//g;
my @env_report = split(/,/,$CONFIG{'env_report'});
foreach (@env_report) { print MAIL "$_: $ENV{$_}\n"; }
close(MAIL);
}
sub get_fields {
my @list;
my @sort_order;
$_ = $CONFIG{'sort'};
if (/alphabetic/) { #sort fields and push them
@sort_order = sort $query->param;
} elsif (s/^order://) {
my %done;
my @order = split (/,/, $_);
foreach (@order) {
(my $field = $_) =~ s/(^\s+|\s+$)//g;
push(@sort_order,$field);
}
@done{@sort_order} = @sort_order;
push @sort_order, grep {!$done{$_}} $query->param;
} else {
@sort_order = $query->param;
}
foreach my $field (@sort_order) {
my $val;
foreach my $value ($query->param($field)) {
$val .= " $value";
}
next if (!$CONFIG{'print_blank_fields'} && (!$val || $val =~ /
+^\s+$/));
push(@list, "$field: $val") unless ($CONFIG{$field} or
($field eq 'print_blank_fie
+lds'));
} #in case someone sets p_b_f
+ = 0
return @list;
} #end sub sort_list
sub error {
my ($error,@error_fields) = @_;
my %titles = ('bad_recipient' => 'Bad Recipient',
'file_unopened' => 'Unable to open file',
'request_method' => 'Request Method',
'missing_fields' => 'Missing Fields',
'mail_error' => 'Error sending mail',
'invalid_recipient' => 'Invalid Recipient'
);
my $body = &body_attributes;
if (($error eq 'missing_fields') &&
($CONFIG{'missing_fields_redirect'} =~ m#https?://.+\..+#)) {
# print the redirectional location header.
print "Location: $CONFIG{'missing_fields_redirect'}\n\n";
} else {
print "Content-type: text/html\n\n";
print <<" %%%";
<html>
<head>
<title>$titles{$error}</title>
</head>
<body $body>
<center><table width=700><tr><td align=center>
<h1>Error: $titles{$error}</h1>
</td></tr><tr><td>
%%%
if ($error eq 'bad_recipient') {
print <<" %%%";
One of the recipients of the information on this form is
not a customer of pair Networks or is not currently config
+ured
as a valid recipient. Sorry.
%%%
} elsif ($error eq 'invalid_recipient') {
print <<" %%%";
One of the recipients of the information on this
form is not valid.
%%%
} elsif ($error eq 'file_unopened') {
print "No way to determine if recipient is valid. \n";
} elsif ($error eq 'request_method') {
print <<" %%%";
The Request Method of the Form you submitted did not match
POST. Please check the form, and make sure that method=POS
+T.
<p><hr><p>
<center>
<a href=\"$ENV{'HTTP_REFERER'}\">Back to the Submission
+Form</a>
</center>
%%%
} elsif ($error eq 'missing_fields') {
print <<" %%%";
The following fields were left blank in your submission fo
+rm:<p>
<ul>
%%%
foreach my $missing_field (@error_fields) {
print "<li>$missing_field\n";
}
print <<" %%%";
</ul>
<p><hr><p>
These fields must be filled out before you can successfull
+y submit
the form. Please return to the
<a href=\"$ENV{'HTTP_REFERER'}\">Fill Out Form</a> and try
+ again.
%%%
} elsif ($error eq 'bad_question') {
print <<" %%%";
<center>Sorry! You did not answer the question correctly.
+ Please go back and try again.<p></center>
%%%
}
print "</td></tr></table></center></body></html>";
}
exit;
}
sub body_attributes {
my $body;
# Check for Background Color
$body .= qq/ bgcolor="$CONFIG{'bgcolor'}"/
if $CONFIG{'bgcolor'};
# Check for Background Image
$body .= qq/ background="$CONFIG{'background'}"/
if $CONFIG{'background'} =~ /http\:\/\/.*\..*/;
# Check for Link Color
$body .= qq/ link="$CONFIG{'link_color'}"/
if $CONFIG{'link_color'};
# Check for Visited Link Color
$body .= qq/ vlink="$CONFIG{'vlink_color'}"/
if $CONFIG{'vlink_color'};
# Check for Active Link Color
$body .= qq/ alink="$CONFIG{'alink_color'}"/
if $CONFIG{'alink_color'};
# Check for Body Text Color
$body .= qq/ text="$CONFIG{'text_color'}"/
if $CONFIG{'text_color'};
return $body;
}
sub check_question {
require "/usr/home/account/public_html/mysite/cgi-bin/db-common.sub" |
+| die "Error loading db-common.sub";
&Conn_to_DB;
$SQL3 = "SELECT answer FROM badwords";
&Do_SQL3;
$pointer3 = $sth3->fetchrow_hashref;
$answer = $pointer3->{'answer'};
#unless ($CONFIG{'question'} =~ /(d|D)ecember/) {
unless ($CONFIG{'question'} =~ /$answer/i) {
&error('bad_question')
}
}
