@badwords expert badly needed

Hi all.

Can you believe I've been at this for 4-days! I grabbed this simple little subroutine to add to my form based email handler, which is supposed to block bad words, due to some problems we've been having. After 56 variations of adding this routine to the script, it STILL won't work properly!

It either doesn't work at all, or it displays the 'bad words error' for "all" messages trying to pass through it. It really p's me off, as I know it's something really stupid, but for the life of me, I can't figure it out. I've posted the script here so you can see how I've configured it.

I've commented the @badwords portions in BIG bold letters with ###### comments on each side of them ###### Any fix someone could add would be so much appreciated.

#!/usr/local/bin/perl

$mailprog = '/usr/sbin/sendmail';

# What operating system are we on?
$os = "UNIX"; # enter: "WINDOWS" for NT or 95 machines.

# list of e-mail addresses
@email_list = ("admin\@mysite.com");

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

@AUTHURLS = ('http://mysite.com');

# Check to make sure this script was called by an authorized URL(s)

&check_url;

sub check_url
{
if ($ENV{'HTTP_REFERER'})
{
foreach $AUTHURL (@AUTHURLS)
{
if ($ENV{'HTTP_REFERER'} =~ /$AUTHURL/i)
{
$check_url = '1';
last;
}
}
}
else
{
$check_url = '1';
}

if ($check_url!= 1)
{
print "Content-type: text/html\n\n";
print "<html>\n <head>\n <title>Unauthorized URL Referrer - Access Denied</title>\n </head>\n";
print "</body></html>\n";
exit;
}

}

read(STDIN, $input, $ENV{'CONTENT_LENGTH'});

@pairs = split(/&/, $input);

foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);

$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

$FORM{$name} = $value;
}

# Lets translate our hash variables
$recipient = $FORM{'recipient'};
$message = $FORM{'message'};
$fromwho = $FORM{'fromwho'};
$fromname = $FORM{'fromname'};
$subject = $FORM{'subject'};
$phone = $FORM{'phone'};

#################### BEGIN BADWORDS MAIN ROUTINE ########################################

&check_badwords; # Tried 40 variations of this

# The @badwords array contains the list of "bad words" that you want to prevent
@badwords = ("badword1", "badword2", "badword3", "badword4");
sub check_badwords {
$badwords="on";
@check_fields = ("message", "fromwho", "fromname", "subject");
foreach $badword (@badwords) {
foreach $check_field (@check_fields) {
if ($FORM{$check_field} =~ /$badword/) {
$badwords="on";
}
}
}
if ($badwords eq "on") {
&badwords_error;
exit;
}
}

&badwords_error if $check_field; # Tried 20 variations of this

#################### END BADWORDS MAIN ROUTINE ########################################

# Get rid of blank lines
# this fixes the bug of wierd blank lines
# $message =~ s/\cM//g;
# $message =~ s/\n/ /g;

# Check fields
&missing(message) unless $message;
&missing(your_email_address) unless $fromwho;
&missing(subject) unless $subject;

# What we have to do

&getdate;

if($log eq "yes") {
&LogIt;
}

if ($os eq "UNIX") {
&SendIt;
} else {
require "winmail.pl";
&SendMail($mailprog, $tempdirectory, $subject,
$email_list[$recipient], $message);
}

&PrintResponse;

# functions #

sub SendIt {
open (MAIL, "¦$mailprog -t") ¦¦ die $!;
print MAIL "To: $email_list[$recipient]\n";
print MAIL "From: $fromname <$fromwho>\n";
print MAIL "Subject: $subject\n";
print MAIL "$message\n";
print MAIL "\n";
print MAIL "Phone Number: $phone\n";
print MAIL "\n";
print MAIL "<REMOTE HOST> $ENV{'REMOTE_HOST'}\n";
print MAIL "<REMOTE ADDRESS> $ENV{'REMOTE_ADDR'}\n";
print MAIL "<USER AGENT> $ENV{'HTTP_USER_AGENT'}\r\n";
close(MAIL);
}

sub LogIt {

open(DATA, "$data") ¦¦ die $!;
$number = <DATA>;
close(DATA);

$number++;

open(DATA, ">$data") ¦¦ die $!;
print DATA "$number";
close(DATA);

open (FILE, ">>$logfile") ¦¦ die $!;
print FILE "$email_list[$recipient]&&$fromwho&&$fromname&&$subject&&$message&&$date&&$number\n";
close(FILE);
}

sub getdate {

@days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
@months = ('January','Feburary','March','April','May','June','July','August','September',
'October','November','December');

($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
if($hour < 10) { $hour = "0$hour"; }
if ($min < 10) { $min = "0$min"; }
if ($sec < 10) { $sec = "0$sec"; }

$date = "$days[$wday], $months[$mon] $mday, 19$year";
}

sub PrintResponse {
print "Content-type: text/html\n\n";
print <<"END"
<html>

<head>
<title>Thanks!</title>

</head>

<body>
<p><font size=6>Thanks!</font></p>
<p><a href="http://www.mysite.com">Return to Mysite.com</a></p>
</body>

</html>

END

}

sub missing {
local($what) = @_;

print "Content-type: text/html\n\n";
print "<HTML><HEAD><TITLE>You Forgot: $what</TITLE></HEAD>\n";
print "<BODY>\n";
print "You forgot to fill out: <b>$what</b>\n";
print "<br><br>\n";
print "Please go back and try again!\n";
print "</BODY></HTML>\n";
exit;
}

#################### Start BADWORDS SUBROUTINE ########################################

sub badwords_error {
print "Content-type: text/html\n\n";
print "<html><head><title>ERROR: Bad Words Found!</title></head>\n";
print "<body bgcolor=#FFFFFF text=#000000>";
print "<center><h1>Bad Words Found!</h1></center>\n";
print "Please keep our website clean by refraining from using vulgar words!";
print "</form></body></html>\n";
exit;
}

#################### END BADWORDS SUBROUTINE ########################################

Thanks for taking the time to view this,

Dave

$match = join ' ¦¦ ', map { "/\\b\$badwords[$_]\\b/o" } 0..@#badwords;
$match = eval "sub { $match }";
foreach (@check_fields) {
$badwords++, last if &$match;
}
print 'you naughty little chap ;)' if $badwords;

@badwords expert badly needed

Wow! 4-days and it still won’t work ):

bsd4me

gsx

bsd4me

bsd4me

Josk

andreasfriedrich

bsd4me

andreasfriedrich

Join The Conversation

Moderators and Top Contributors

Hot Threads This Week