#!/usr/bin/perl -w

#
#  Chatterbox version 2.0
#

use strict;
use warnings;
use POSIX;
use CGI qw(:standard start_table end_table);
use CGI::Carp qw(fatalsToBrowser);

use lib "";

use DB_File;
use Text::Wrap;
$Text::Wrap::columns = 15;

my %chat;
my %chatorder;

###########################################
# Configuration section
###########################################
$Text::Wrap::columns = 15;

my @words = (bad words removed so you don't see them);
my @list  = ("Sulfericacid", "sulfericacid", "Sulfy", "Sulfer", "sulfy
+", "sulfer",
              "admin", "Admin", "webmaster", "Webmaster", "administrat
+or", "Administrator");

my $url = "http://sulfericacid.perlmonk.org/chat/chat.pl";
## Change the above line to the full URL of the chat script

my $imagedir = "http://sulfericacid.perlmonk.org/chat/images";        
+  # location of image directory (emoticons)
## Change the above line to the full URL of the /images/ folder for th
+e chat script

my $ip = "66.47.159.11";
## Change to the administrator IP address

my $chathelp = "chat/chathelp.html";
my $log      = "chat/log.pl";
## Change the two above lines to point to the chathelp.html and log.pl
+ files

my $pagead   = "http://sulfericacid.perlmonk.org";

##########################################
# Please do not edit below this line
##########################################


my $redirect = param('location');

my $chat = "chat.db";                 # location of database
my $file = "count.txt";               # location of count file
my $banned = "banned.txt";            # location of banned IP list

tie %chat, "DB_File", "$chat", O_CREAT|O_RDWR, 0644, $DB_BTREE
    or die "Cannot open file 'chat': $!\n";    












print header, start_html('sulfericacid.perlmonk.org -Oil of vitrol - A
+cid cleanup for code on the web');



my $js="<script langauge=\"Javascript\"> 
document.write('<form><input type=button value=\"Refresh\" onClick=\"w
+indow.location.reload()\"></form>');</script></noscript></noscript>";



    my $name    = param('name');
    my $message = param('message');
    my $cnt;



## Get the user information
if (param) {

    if ($name ne "") {
if (grep { $name eq $_ } @list and $ENV{REMOTE_ADDR} ne "$ip" )
{
  print "<font color=red>You are not authorized to post as the Adminis
+trator</font>";
  exit;
}

        if ($message ne "") {

                     open( LOG, "$file" );   # open count log for ID
         $cnt = <LOG>;
            close(LOG);

           $cnt++;
            open( LOG, "> $file" );
             print LOG $cnt;
            close(LOG);

$name =~ s/</&lt\;/g;        # removing exploit
$name =~ s/~/\&#126\;/g;     # database splitting
$message =~ s/</&lt\;/g;     # removing exploit
$message =~ s/~/\&#126\;/g;  # database splitting

    my $info = join ( '~~', $name, $message, $ENV{REMOTE_ADDR});

    $chat{$cnt} = $info;
        print "<SCRIPT LANGUAGE=\"JAVASCRIPT\">";
        print "document.location.href=\"$redirect\";";
        print "</SCRIPT>";

        }
        else {
           print "<SCRIPT LANGUAGE=\"JAVASCRIPT\">";
           print "document.location.href=\"$redirect\";";
           print "</SCRIPT>";
        }
    }
    else {
        print "<SCRIPT LANGUAGE=\"JAVASCRIPT\">";
        print "document.location.href=\"$redirect\";";
        print "</SCRIPT>";

    }
}


# Start printing everything out

my $cnt = 0;
foreach (keys %chat) {
$cnt++;
}
print qq[(<a href="$chathelp" target="new">chat help</a>)   ];
print "(<a href=\"$log\" target=\"new\">chat logs</a>)";


print start_table;
print Tr(td({-height=>'5', width=>'700', bgcolor=>'#BBCCEE'},"<font si
+ze=2><b>ChatterBox version 1.73</b></font>\n" ));
print Tr(td({-height=>'5', width=>'700', bgcolor=>'#BBCCEE'},"\n"));


for (grep defined($_), (keys %chat)[-10..-1]) { 

my ( $name, $message, $userip) = split /~~/, $chat{$_};

#$name =~ s/$_/****/g for @words; # say goodbye to swear words

$name =~ s[\b$_\b][****]sgi for @words; # say goodbye to swear words


$name = wrap('', '', $name);

#$message =~ s/$_/****/g for @words; # say goodbye to swear words
$message =~ s[\b$_\b][****]sgi for @words; # say goodbye to swear word
+s

$message = wrap('', '', $message);
$message =~ s#:\)#<img src="$imagedir/smiley.gif">#g; # happy emoticon
$message =~ s#:\(#<img src="$imagedir/sad.gif">#g;    # sad emoticon
$message =~ s#:p#<img src="$imagedir/tongue.gif"#g;  # tongue emoticon
$message =~ s#:P#<img src="$imagedir/tongue.gif">#g;  # tongue1 emotic
+on
$message =~ s#:o#<img src="$imagedir/oh.gif">#g;      # oh emoticon
$message =~ s#:O#<img src="$imagedir/oh.gif">#g;      # oh1 emoticon
$message =~ s#\*hug\*#<img src="$imagedir/hug.gif">#g;  # hug emoticon
$message =~ s#\*flower\*#<img src="$imagedir/flower.gif">#g;  # flower
+ emoticon
$message =~ s#\*wink\*#<img src="$imagedir/wink.gif">#g;  # wink emoti
+con
$message =~ s#\*devil\*#<img src="$imagedir/devil.gif">#g;# devil emot
+icon
$message =~ s#\*love\*#<img src="$imagedir/love.gif"\>#g;  # love emot
+icon
$message =~ s#\*sleep\*#<img src="$imagedir/sleep.gif">#g;# sleep emot
+icon
$message =~ s#\*conf\*#<img src="$imagedir/confused.gif">#g;# sleep em
+oticon


  if ($message =~ m/(^\/me)/) {
    $name = "<i>$name";
    $message =~ s/$1//;
    $message = "$message<\i>";
if (grep { $name eq "<i>$_" } @list) {
    print Tr(td({-width=>'700'},"<font size=2 color=red>$name</font><f
+ont size=2> $message</font>\n")),
   }
   else {
    print Tr(td({-width=>'700'},"<font size=2 color=blue>$name</font><
+font size=2> $message</font>\n")),
    }}
   else {
if (grep { $name eq $_ } @list) {
    print Tr(td({-width=>'700'},"<font size=2 color=red>&lt;$name&gt;<
+/font><font size=2> $message</font>\n")),
   } else {
    print Tr(td({-width=>'700'},"<font size=2 color=blue>&lt;$name&gt;
+</font><font size=2> $message</font>\n")),
   } }
}



print Tr(td({-height=>'5', width=>'700', bgcolor=>'#BBCCEE'},""));
print Tr(td({-height=>'5', width=>'700', bgcolor=>'#BBCCEE'},"<font si
+ze=2><p align=right><b>$pagead</b></font>\n" ));
print "</table>";
my $location = join("", "http://", $ENV{'SERVER_NAME'}, $ENV{'REQUEST_
+URI'});


open(BANNED, "<$banned") or die "Cannot open $banned because: $!";
while(<BANNED>) {
 chomp;
   if ($_ eq $ENV{REMOTE_ADDR})
   {
     print <<"ALL";
     <table width="20">
     <td>Your IP has been banned, you are not allowed to use this scri
+pt.</td>
     </table>

ALL

     exit;
   }

}
close(BANNED);

print <<"ALL";
<table width="20" border="0"><form method="POST" action="$url">
<tr><td>Name:</td><td><input type="text" name="name" value="$name" siz
+e="15"></td></tr>
<tr><td>Message:</td><td><input type="text" name="message" size="15" m
+axlength="500"></td></tr>
<tr><td><input type="submit" name="submit" value="send"><input type="h
+idden" name="location" value="$location"></form></td><td>
<form><input type=button value="Refresh" onClick="window.location.relo
+ad()"></form></td></tr>
</form></table> 
<hr>

ALL