#!/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 = 100; my %chat; my %chatorder; ########################################### # Configuration section ########################################### $Text::Wrap::columns = 100; my @words = ("scheldwoordenlijst"); my @list = ("Webmaster"); my $url = "http://www.provider.nl/cgi-bin/shout/chat.pl"; ## Change the above line to the full URL of the chat script my $imagedir = "http://www.provider.nl/shoutbox/emoticons"; # location of image directory (emoticons) ## Change the above line to the full URL of the /images/ folder for the chat script my $ip = ""; ## Change to the administrator IP address my $chathelp = "http://www.provider.nl/shoutbox/chathelp.html"; my $log = "http://www.provider.nl/cgi-bin/shout/log.pl"; ## Change the two above lines to point to the chathelp.html and log.pl files my $pagead = "Typ je naam en je bericht hieronder"; ########################################## # 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; my $js=""; my $name = param('Naam'); 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 "Je hebt geen rechten om als Administrator te posten"; exit; } if ($message ne "") { open( LOG, "$file" ); # open count log for ID $cnt = ; close(LOG); $cnt++; open( LOG, "> $file" ); print LOG $cnt; close(LOG); $name =~ s/"; print "document.location.href=\"$redirect\";"; print ""; } else { print ""; } } else { print ""; } } # Start printing everything out my $cnt = 0; foreach (keys %chat) { $cnt++; } print start_table; print Tr(td({-height=>'5', width=>'450', bgcolor=>'#FF6600'},"
Shouts
\n" )); for (grep defined($_), (keys %chat)[-50..-1]) { my ( $name, $message, $userip) = split /~~/, $chat{$_}; $name =~ s/$_/oeps/g for @words; # say goodbye to swear words $name = wrap('', '', $name); $message =~ s/$_/oeps/g for @words; # say goodbye to swear words $message = wrap('', '', $message); $message =~ s#:01:##g; $message =~ s#:02:##g; $message =~ s#:03:##g; $message =~ s#:04:##g; $message =~ s#:05:##g; $message =~ s#:06:##g; $message =~ s#:07:##g; $message =~ s#:08:##g; $message =~ s#:09:##g; $message =~ s#:10:##g; if ($message =~ m/(^\/me)/) { $name = "$name"; $message =~ s/$1//; $message = "$message<\i>"; if (grep { $name eq "$_" } @list) { print Tr(td({-width=>'550'},"$name $message
\n")), } else { print Tr(td({-width=>'550'},"$name $message
\n")), }} else { if (grep { $name eq $_ } @list) { print Tr(td({-width=>'550'},"<$name> $message
\n")), } else { print Tr(td({-width=>'550'},"<$name> $message
\n")), } } } print Tr(td({-height=>'5', width=>'550', bgcolor=>'#FF6600'},"

$pagead\n" )); print ""; my $location = join("", "http://", $ENV{'SERVER_NAME'}, $ENV{'REQUEST_URI'}); open(BANNED, "<$banned") or die "Cannot open $banned because: $!"; while() { chomp; if ($_ eq $ENV{REMOTE_ADDR}) { print <<"ALL";
Jou IP adres is verbannen, je mag geen gebruik maken van deze box.
ALL exit; } } close(BANNED);