#!/usr/bin/perl
##########################
#
# IEZChat V. 1.0
# GraphicsByIvana.com
# FREE
# Scroll down about 25 lines and start editing
# the variables ($variable_name) shown below.
# Upload in ASCII Mode & CHMOD 755
#
# Access it /cgi-bin/chat.pl
#
# Thanks for using it!
#
##########################
use CGI::Carp qw(fatalsToBrowser);
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, $INFOCOLOR, $BGCOLOR, $FORMCOLOR,
$PUBLICCOLOR, $PRIVATECOLOR, $SENTPUBCOLOR, $SENTPVTCOLOR, $TEXTCOLOR,
$LINKCOLOR, $ALINKCOLOR, $VLINKCOLOR, $CSSFILE,
$msgcolor,
$from, $to,
$timestamp,
$date,
$link,
$cur,
@entries,
$entry,
%times,
%hosts,
@users,
$user,
$remote_host,
$sorry,
$line, $key, $value1, $value2, $beg,
$taken, $display, $dsplycnt
);
# 1 = YES and 0 = NO
### SITE DEFAULTS - CHANGE THESE AS NECESSARY ###############################
$CHATFILE = 'chatfile'; # name of chat file
$USERS = 'chatusers'; # file storing active user info
$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 = 1; # show date/time of messages
$SHOW_EMAIL = 1; # enable email link at users name
$CAPITALIZE = 1; # capitalize names
$TITLE = "I-Blogger Chat"; # page title
$WELCOME = "<H1>WELCOME</H1>"; # <H1>$WELCOME</H1>
$INFOCOLOR = '5E704B'; # color of welcome and other text
$FORMCOLOR = 'white'; # bgcolor for form, if table is used
$PUBLICCOLOR = 'black'; # color for PUBLIC messages
$PRIVATECOLOR = 'green'; # color for PRIVATE messages
$SENTPUBCOLOR = '333333'; # color for SENT PUBLIC messages
$SENTPVTCOLOR = 'red'; # 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 <<End_of_Text; # start HTML
Content-type: text/html
<HTML>
<HEAD>
<TITLE> $TITLE</TITLE>
</HEAD>
<body>
<A NAME="TOP"></A>
<CENTER>
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 = <UHANDLE>);
($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
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 <b>name</b> 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 start_form; # HTML form
if ( length($user) && !$sorry ) { # save user name
print '<input type=hidden name="save" value="'.lc($user).'">',"\n";
} else { # save previous user name
print '<input type=hidden name="save" value="'
.$cur->param("save").'">',"\n";
};
print "<b>Your Name:</b> ", $cur->textfield( # sticky "name" field
-NAME => "name",
-SIZE => 30);
print " <b>To:</b> ",
$cur->popup_menu(-NAME => 'to', # "to" field
-VALUES => \@users,
-DEFAULT => 'Everyone',
-OVERRIDE => 1) # set to 0 to make sticky
, "\n";
print " ";
print $cur->submit( -VALUE => "Send or Refresh"), " ";
#print "</center>";
if ($SHOW_EMAIL) {
print "<BR><b>Email or URL:</b> \n",
$cur->textfield( # sticky email/URL field
-NAME => "email",
-SIZE => 30), " <font size=-1>(optional)</font>\n";
};
print " <b>Message:</b> \n",
$cur->textfield( # message field
-NAME => "message",
-SIZE => 30,
-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"), "<BR>\n";
###
print end_form, "\n";
print qq|
<font size=1><B>Private Message:</B> Select To Who. <B>New Messages:</B> Click Send or Refresh.</font></center>
|;
print hr;
print qq|
<B>Current Time:</B>
<script language="JavaScript">
<!--
// we put this here so we can see something change
document.write('' + (new Date).toLocaleString() + '');
//-->
</script>
<P>
|;
print "<CENTER><FONT SIZE=\"5\" COLOR=\"$PRIVATECOLOR\">
$sorry
</FONT></CENTER>\n<HR>" if ($sorry);
$dsplycnt=0;
while (@entries && ($dsplycnt < $MAXDISPLAY)) { # display messages
$entry = shift(@entries);
$link = $entry->param("email") if ($SHOW_EMAIL);
$from = $entry->param("name");
$from =~ s/(\w+)/\u$1/g if ($CAPITALIZE);
$to = $entry->param("to");
$to =~ s/\s+/ /g;
$to =~ s/(\w+)/\u$1/g if ($CAPITALIZE);
$date = $entry->param("date") if ($SHOW_DATE);
if ( length($user) && (lc($to) eq lc($user)) ) {
$msgcolor = $PRIVATECOLOR;
$display = 1 if (!$sorry);
} elsif (length($user) && (lc($from) eq lc($user))) {
if (lc($to) eq 'everyone') {
$msgcolor = $SENTPUBCOLOR;
$display = 1;
} else {
$msgcolor = $SENTPVTCOLOR;
$display = 1 if (!$sorry);
};
} elsif (lc($to) eq 'everyone') {
$msgcolor = $PUBLICCOLOR;
$display = 1;
};
if ($display) {
$display = 0;
$dsplycnt++;
if ($link) {
if ($link =~ m/@/) {
printf ("<FONT COLOR=\"$msgcolor\"><B>
<a href=\"mailto:%s\">%s</a> to %s</B> %s</FONT>\n",
$link, $from, $to, $date);
} else {
$link =~ s/^http:\/\///;
printf ("<FONT COLOR=\"$msgcolor\"><B>
<a href=\"http:\/\/%s\">%s</a> to %s</B> %s</FONT>\n",
$link, $from, $to, $date);
};
} else {
printf ("<FONT COLOR=\"$msgcolor\"><B>%s to %s</B> %s</FONT>\n",
"$from", "$to", $date);
};
printf ("<BR><FONT COLOR=\"$msgcolor\">%s</FONT>\n",
$entry->param("message"));
print hr;
};
};
print <<End_of_Text; # finish HTML
<FONT COLOR="$INFOCOLOR" face=Arial size=2>
<CENTER>
<h2><b>Back To <A NAME="BOTTOM" HREF="#TOP">Top</a> of Page</b></h2>
<a href=http://www.graphicsbyivana.com/ target=_blank>Powered By IEZChat</a>
</CENTER>
</FONT>
</BODY>
</HTML>
End_of_Text
sub get_time {
my (
$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$dst,
@months
);
@months = ("January","February","March","April","May","June","July",
"August","September","October","November","December");
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$dst)
= localtime(time()+$HOURADJUST*3600);
if ($hour < 10) {
$hour = '0'.$hour;
}
if ($min < 10) {
$min = '0'.$min;
}
if ($sec < 10) {
$sec = '0'.$sec;
}
$year += 1900; # Y2K OK!
$TZONE =~ tr/S/D/ if ($dst); # fix time zone string for daylight savings
return $timestamp = "$months[$mon] $mday, $year $hour:$min:$sec";
}
sub bail { # print errors directly to browser
my $error = "@_";
print h1("Error:"), p($error), end_html;
die $error;
}