#!/usr/bin/perl
# Chat program (version 2.13)
#
# Copyright 1998 Michael Chavel (chavel@aquilo.net)
# You may use this program for PERSONAL, NON-PROFIT USE ONLY!
# The most recent version of this program and documentation can
# be found at http://www.aquilo.net
use 5.004;
use strict; # enforce declarations and quoting
use CGI qw(:standard); # import shortcuts
use Fcntl qw(:flock); # imports LOCK_EX, LOCK_SH, LOCK_NB
my (
$URL, $CHATFILE, $USERS, $MAXSAVE, $MAXDISPLAY, $MAXUSERS, $ACTIVETIME,
$SHOW_DATE, $SHOW_EMAIL, $CAPITALIZE, $HOURADJUST, $TZONE,
$TITLE, $WELCOME, $RETURN, $INFOCOLOR, $BGCOLOR, $FORMCOLOR,
$PUBLICCOLOR, $PRIVATECOLOR, $SENTPUBCOLOR, $SENTPVTCOLOR, $TEXTCOLOR,
$LINKCOLOR, $ALINKCOLOR, $VLINKCOLOR,
$msgcolor, # current message color
$from, $to, # current message from, to
$timestamp, # time stamp to track active users
$date, # date and time (adjustable for different timezones)
$link, # email or URL of guest
$cur, # new entry in the guestbook
@entries, # holds all entries
$entry, # one particular entry
%times, # hash of users last access times
%hosts, # hash of users IP address or DNS name
@users, # all active users
$user, # current user
$remote_host, # IP address or DNS name of current user
$sorry, # string to inform user of an error
$line, $key, $value1, $value2, $beg, # misc variables
$taken, $display, $dsplycnt
);
### SITE DEFAULTS - CHANGE THESE AS NECESSARY ###############################
$CHATFILE = 'chatfile'; # name of chat file
$USERS = 'chatusers'; # file storing active user info
$RETURN = 'http://www.aquilo.net/projects'; # refer visitors back to this URL
$MAXUSERS = 20; # max number of users
$MAXSAVE = 100; # how many messages to save to disk
$MAXDISPLAY= 25; # max number of messages to display
$ACTIVETIME = 5*60; # time a user stays active (in seconds)
$SHOW_DATE = 0; # show date/time of messages
$SHOW_EMAIL = 0; # enable email link at users name
$CAPITALIZE = 0; # capitalize names
$TITLE = "CHAT"; # page title
$WELCOME = "CHAT"; #
$WELCOME
$INFOCOLOR = 'red'; # color of welcome and other text
$BGCOLOR = 'black'; # overall background color
$FORMCOLOR = 'black'; # bgcolor for form, if table is used
$TEXTCOLOR = 'red'; # text color
$LINKCOLOR = 'red'; # link color
$ALINKCOLOR = 'red'; # active link color
$VLINKCOLOR = 'red'; # visited link color
$PUBLICCOLOR = 'red'; # color for PUBLIC messages
$PRIVATECOLOR = 'yellow'; # color for PRIVATE messages
$SENTPUBCOLOR = 'red'; # color for SENT PUBLIC messages
$SENTPVTCOLOR = 'silver'; # color for SENT PRIVATE messages
$HOURADJUST = 0; # add this to local hour
$TZONE = 'EST'; # to display this time zone
# # automatically adjusts for
# # daylight savings (EST -> EDT, etc)
#############################################################################
$timestamp = time(); # get time stamp
$sorry = 0; # no error yet
print < $TITLE
End_of_Text
if (-e $USERS) { # update users
open(UHANDLE, "+< $USERS") || bail("cannot open $USERS: $!");
} else {
open(UHANDLE, "+> $USERS") || bail("cannot open $USERS: $!");
}
flock(UHANDLE, LOCK_EX) || bail("cannot flock $USERS: $!");
while (!eof(UHANDLE) && (%times < $MAXUSERS) ) {
chomp($line = );
($key, $value1, $value2) = split(/:/, $line);
if ($timestamp-$value1 < $ACTIVETIME) { # check if still active
$times{$key} = $value1;
$hosts{$key} = $value2;
};
};
$remote_host = $ENV{'REMOTE_HOST'};
$cur = CGI->new(); # current request
$URL = $cur->script_name(); # URL of this script
$user = $cur->param("name"); # get user name
$user =~ tr/ \n\r\t\f/ /s; # remove consequtive spaces
chop($user) if ($user =~ m/ $/); # remove any trailing junk
$user = substr($user, 1) if ($user =~ m/^ /); # remove any leading junk
$user =~ s/(\w+)/\u$1/g if ($CAPITALIZE); # capatalize (if enabled)
$cur->param("name", $user);
foreach (keys %times) { # check active user names
$taken=$_ if (m/^$user$/i);
};
if (length($taken)) { # is name already active
###
# one method of verifying users is to check the previous $user value
# saved in a hidden field in the HTML form. If they don't match
# this person is trying to use someone else's name
if (lc($user) ne $cur->param("save")) {
###
# another way to verify users is to check the remote users ip address.
# if it is not the same as before assume this is a different person
# and prompt for a different user name
# if (!($remote_host =~ m/$hosts{$taken}/i)) {
#
$sorry ="The name $taken is already active. "
.'Please choose another name.';
};
# otherwise, assume this is the same active user
###
} elsif (length($user)) { # new user
$times{$user} = $timestamp;
$hosts{$user} = $remote_host;
};
seek(UHANDLE, 0, 0) || bail("cannot rewind $USERS: !");
foreach (keys %times) {
print UHANDLE "$_:$times{$_}:$hosts{$_}\n"; # save updated user info
push (@users, $_); # record active user names
}
truncate(UHANDLE, tell(UHANDLE)) || bail("cannot truncate $USERS: $!");
close(UHANDLE) || bail("cannot close $USERS: $!");
if ((!$sorry) && $cur->param("message") =~ m/\S/) { # new message
# check for image tags
if ($cur->param("message") =~ m/<\s*IMG\s*.*SRC\s*=/i) {
$sorry = 'Sorry, you can not include images in messages.';
} else {
if (length($user)) {
$cur->param("timestamp", $timestamp); # get timestamp
$cur->param("date", get_time($timestamp)); # get pretty date/time
@entries = ($cur); # save message to array
} else {
$sorry ='You must enter a name to send a message!';
};
};
};
if (-e $CHATFILE) {
open(CHANDLE, "+< $CHATFILE") || bail("cannot open $CHATFILE: $!");
} else {
open(CHANDLE, "+> $CHATFILE") || bail("cannot open $CHATFILE: $!");
}
flock(CHANDLE, LOCK_EX) || bail("cannot flock $CHATFILE: $!");
while (!eof(CHANDLE) && @entries < $MAXSAVE) {
$entry = CGI->new(\*CHANDLE);
push @entries, $entry;
}
seek(CHANDLE, 0, 0) || bail("cannot rewind $CHATFILE: !");
foreach $entry (@entries) {
$entry->save(\*CHANDLE);
}
truncate(CHANDLE, tell(CHANDLE)) || bail("cannot truncate $CHATFILE: $!");
close(CHANDLE) || bail("cannot close $CHATFILE: $!");
push (@users, 'Everyone');
#print hr;
#print "
\n";
print start_form; # HTML form
if ( length($user) && !$sorry ) { # save user name
print '',"\n";
} else { # save previous user name
print '',"\n";
};
print "Name: ", $cur->textfield( # sticky "name" field
-NAME => "name",
-SIZE => 30);
print " To: ",
$cur->popup_menu(-NAME => 'to', # "to" field
-VALUES => \@users,
-DEFAULT => 'Everyone',
-OVERRIDE => 1) # set to 0 to make sticky
, "\n";
if ($SHOW_EMAIL) {
print " Email or URL:\n",
$cur->textfield( # sticky email/URL field
-NAME => "email",
-SIZE => 40), " (optional) \n";
};
print " Message: \n",
$cur->textfield( # message field
-NAME => "message",
-SIZE => 68,
-OVERRIDE => 1); # clears previous message
### if you prefer a textarea for messages
# $cur->textarea(
# -NAME => "message",
# -OVERRIDE => 1, # clears previous message from textarea
# -ROWS => 3,
# -COLUMNS => 68,
# -WRAP => "hard"), " \n";
###
print $cur->submit( -VALUE => "send / refresh"), " ";
#print $cur->reset( -VALUE => "clear"); # clear button, if you like
print end_form, "\n";
#print "