- \n";
print MAIN "
- /) {
print MAIN "
- $subject - $name";
if ($FORM{'img'} && $pixicon) { print MAIN "
"; } if ($FORM{'url'} && $linkicon) { print MAIN "
"; } print MAIN " $date\n"; print MAIN "(0)\n"; print MAIN "
- \n";
print MAIN "
; close(FOLLOWUP); open(FOLLOWUP,">$basedir/$mesgdir/$followup_num\.$ext"); foreach $followup_line (@followup_lines) { $work = 0; if ($followup_line =~ / - /) {
print FOLLOWUP "
- $subject $name";
if ($FORM{'img'} && $pixicon) { print FOLLOWUP "
"; } if ($FORM{'url'} && $linkicon) { print FOLLOWUP "
"; } print FOLLOWUP " $date\n"; print FOLLOWUP "(0)\n"; print FOLLOWUP "
- \n";
print FOLLOWUP "
$title - $num_to_show Recent Messages \n"; print "\n"; print "$title
[ Post a New Message ] [ $title ] [ How to Use This Board ] \n"; } else { print "[ Post a New Message ] [ $title ] \n"; } print "\n"; print "
Recent Messages
- \n";
srchfiles: foreach $mesgfile (@mesgfiles) {
open(MSGS,"$basedir/$mesgfile");
@lines =
; close(MSGS); foreach $line (@lines) { if ($line =~ /^ $line"); if (($messages += 1) >= $num_to_show) { last srchfiles; } } } } } if ($messages == 0) { print " No Messages Posted Recently
Message Added: $subject \n"; print "\n"; # Debug - print the form args now if ($debugargs == 1) { $debugargs = 2; &parse_form; } print "Message Added: $subject
\n"; print "
- Name: $name \n"; print "
- E-Mail: $email \n"; print "
- Subject: $subject \n"; if ($followup != 0) { print "
- In Reply to: $origsubject posted by "; if ($origemail) { print "$origname on $origdate \n"; } else { print "$origname on $origdate
\n";
}
}
print "
- \n";
print FOLLOWUP "
\n"; print "Body of Message:
\n"; &print_message_body; if ($message_url) { print "Link: $message_url_title
\n"; } if ($message_img) { print "Image:
\n"; } print "Added on Date: $date\n"; print "
\n"; print "[ Go to Your Message* ] [ $title ] \n"; print "
\n"; print "* - When you return to the main page, if you don't see your message header in the list of messages,\n"; print "try clicking the Reload button on your Web browser.\n"; print "\n"; } sub fatal_error { ($why, $longwhy) = @_; print "Content-type: text/html\n\n"; print "
$title ERROR: $why \n"; print "ERROR: $why
$longwhy
\n"; print "\n"; exit; } sub check_arglen { ($avar, $aname, $alen) = @_; if (length($avar) > $alen) { &fatal_error("$aname is Too Long", "Sorry - $aname can't be longer than $alen characters.
Use the [Back] button in your browser to return to the previous page and make it shorter."); } } sub error { print "Content-type: text/html\n\n"; print "
$title ERROR: Required field missing \n"; if ($FORM{'name'} eq "") { print "ERROR: No Name
\n"; } if ($FORM{'subject'} eq "") { print "
$title ERROR: No Subject \n"; print "ERROR: No Subject
\n"; } print "The necessary fields are: Name, Subject and Message.
\n"; print "Use the [Back] button in your browser to return to the previous form and fill in the missing information.
\n"; print "\n"; exit; } sub print_message_body { @chunks_of_body = split(/\<\;p\>\;/,$hidden_body); foreach $chunk_of_body (@chunks_of_body) { @lines_of_body = split(/\<\;br\>\;/,$chunk_of_body); foreach $line_of_body (@lines_of_body) { # Walt 2/97: Restore punctuation (to allow HTML again) $line_of_body =~ s/<//g; $line_of_body =~ s/"/"/g; if (index($line_of_body,":") == 0) { print "$line_of_body"; } else { print $line_of_body; } print "
\n"; } print ""; } } sub get_date_time { ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); if ($sec < 10) { $sec = "0$sec"; } if ($min < 10) { $min = "0$min"; } if ($hour < 10) { $hour = "0$hour"; } if ($mon < 10) { $mon = "0$mon"; } if ($mday < 10) { $mday = "0$mday"; } $year += 1900; $year =~ s/^\d\d//; $month = ($mon + 1); if ($use_time == 1) { $date = "$hour\:$min\:$sec $month/$mday/$year"; } else { $date = "$month/$mday/$year"; } chop($date) if ($date =~ /\n$/); $long_date = "$month/$mday/$year at $hour\:$min"; # Switch to shorter format } sub check_banned { my ($temp) = @_; check_banned1($temp); # Check original text $temp =~ s/0/o/g; # Common spammer trick $temp =~ s/1/i/g; check_banned1($temp); # Check again with 0 and 1 substitution } sub check_banned1 { my ($temp) = @_; my $word; if ( $bannedwords ) { if (!@bannedwords) { if (! (-s $bannedwords) || !open BANNED, "<$bannedwords") { &email_error("Can't open banned word file $bannedwords"); return 1; } chomp(@bannedwords =
); } foreach $word (@bannedwords) { if ( lc($temp) =~ /$word/ ) { log_message("$long_date: MESSAGE BLOCKED - Banned word <$word> $ENV{'REMOTE_ADDR'}; Subject: $subject"); &fatal_error("Banned Word in Message", "This message board is, unfortunately, under constant attack by automatic spammers who try to post hundreds of bogus messages a day. To protect legitimate users, messages are not allowed to contain certain words that almost always indicate a spam message.
If you tried to post a legitimate message, please accept our apology and try again, or notify the Webmaster."); } } } if ($bannedips) { if ( !@bannediplist ) { if (! (-s $bannedips) || !open BANNED, "<$bannedips") { &email_error("Can't open banned word file $bannedips"); return 1; } chomp( @bannediplist =
); } $remaddr = $ENV{'REMOTE_ADDR'}; foreach $bannedip (@bannediplist) { if ( $bannedip == $remaddr ) { log_message("$long_date: MESSAGE BLOCKED - Banned IP address $ENV{'REMOTE_ADDR'}; Subject: $subject"); &fatal_error("Spammer Protection Activated", "This message board is, unfortunately, under constant attack by automatic spammers who try to post hundreds of bogus messages a day. Something in your message makes it look like you may be a spammer.
If you tried to post a legitimate message, please accept our apology and try again, or notify the Webmaster."); } } } } # Decide whether a subject line is long and gibberish (score over 35) sub check_gibberish { my (@line, $i, $word); @line = split(/ /,$subject); $i = 0; foreach $word (@line) { $i += strange_word_score($word); } if ( $i >= 30 ) { log_message("$long_date: MESSAGE BLOCKED - Subject Line Bad (Score $i) $ENV{'REMOTE_ADDR'}; Subject: $subject"); &fatal_error("Spammer Protection Activated", "This message board is, unfortunately, under constant attack by automatic spammers who try to post hundreds of bogus messages a day.
Something in your message makes it look like you may be a spammer.
If you tried to post a legitimate message, please accept our apology and try again, or notify the Webmaster."); } if ( $i >= 10 ) { log_message("$long_date: WARNING - Subject Line Suspicious (Score $i) $ENV{'REMOTE_ADDR'}; Subject: $subject"); } } sub strange_word_score { my (@word, $score, $i, $j, $c1, $c2); ($i) = @_; @word = split(//,$i); if ($#word <=1) { return 0; } # print "<"; print @word; print ">$#word\n"; $score = 0; # if ($#word < 5) { return $score; } # Pass anything under 7 chars if (!(uc(@word[0]) =~ /[A-Z\d]/)) { $score += 5; # Initial non-alphanumeric - don't look at rest #print "Initial non-alpha @word\n"; return $score; } for ($i = 0; $i < $#word; ++$i) { $c1 = @word[$i]; $c2 = @word[$i+1]; if (uc($c1) =~ /[A-Z]/ && $c2 eq '.') { ++$i; # Alpha followed by period - ignore abbr. #print "$c1$c2 - ignore abbr at $i\n"; next; } if ($c1 =~ /\d/) { #print "$c1 - skip numeric at $i\n"; next; # Ignore numerics } if (!(uc($c1) =~ /[A-Z]/)) { #print "$c1 - non-alphabetic at $i\n"; next; } # Skip non-alphabetic if (!(uc($c2) =~ /[A-Z]/)) { #print "$c2 - second char non-alphabetic at $i\n"; next; } # Second char non-alpha - skip next tests. if ($c1 =~ /[a-z]/ && $c2 =~ /[A-Z]/) { #print "$c1$c2 - lower followed by upper at $i\n"; $score += 5; } # Add for lc followed by uc $c1 = uc($c1); $c2 = uc($c2); if (0 == ($digraphs{$c1} & (1 << (ord($c2) - ord('A'))))) { #print "$c1$c2 - unlikely digraph at $i\n"; $score += 8; } # Add for unlikely digraph } return $score; }
- $subject $name";
if ($FORM{'img'} && $pixicon) { print FOLLOWUP "
- \n";
print MAIN "