
Lesia
Deleted
Mar 3, 2000, 8:48 PM
Post #4 of 4
(8396 views)
|
Brian, I couldn't find the email addresses, so here's the script. My email address is tmhlmg@northcascades.net if anyone prefers I send it as an attatchment. The modifications needed are, reverse page layout so that the text and user name box is at the bottom of the page, take out the pull down menu, and make it so user's ip's don't show in the room. Thanks, Lesia #!/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 $swap_image, # swap images $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"; # <H1>$WELCOME</H1> $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 <<End_of_Text; # start HTML Content-type: text/html <HTML> <HEAD> <TITLE> $TITLE</TITLE> </HEAD> <BODY BGCOLOR="$BGCOLOR" TEXT="$TEXTCOLOR" LINK="$LINKCOLOR" ALINK="$ALINKCOLOR" VLINK="$VLINKCOLOR" > <A NAME="TOP"></A> <FONT COLOR="$INFOCOLOR"> <CENTER> <H1>$WELCOME</H1></CENTER> <CENTER> <b>Earliest Comments at <A HREF="#BOTTOM">Bottom</a> of Page</b> </CENTER> </FONT> 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 ### # 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: $!"); #### TD MODIFY ROUTINE 3/3/2000 #### 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 ################################################ $swap_image = $cur->param("message"); $swap_image =~ s/:angel:/<img src="http:\/\/216.65.76.77\/icons\/angel.gif">/g; $swap_image =~ s/:bheart:/<img src="http:\/\/216.65.76.77\/icons\/bheart.gif">/g; $swap_image =~ s/:blush:/<img src="http:\/\/216.65.76.77\/icons\/blush.gif">/g; $swap_image =~ s/:coffee:/<img src="http:\/\/216.65.76.77\/icons\/coffee.gif">/g; $swap_image =~ s/:cry:/<img src="http:\/\/216.65.76.77\/icons\/cry.gif">/g; $swap_image =~ s/:cryingrose:/<img src="http:\/\/216.65.76.77\/icons\/cryingrose.gif">/g; $swap_image =~ s/:cuffs:/<img src="http:\/\/216.65.76.77\/icons\/cuffs.gif">/g; $swap_image =~ s/:devil:/<img src="http:\/\/216.65.76.77\/icons\/devil.gif">/g; $swap_image =~ s/:eyes:/<img src="http:\/\/216.65.76.77\/icons\/eyes.gif">/g; $swap_image =~ s/:frown:/<img src="http:\/\/216.65.76.77\/icons\/frown.gif">/g; $swap_image =~ s/:heart:/<img src="http:\/\/216.65.76.77\/icons\/heart.gif">/g; $swap_image =~ s/:hk:/<img src="http:\/\/216.65.76.77\/icons\/hk.gif">/g; $swap_image =~ s/:hot:/<img src="http:\/\/216.65.76.77\/icons\/hot.gif">/g; $swap_image =~ s/:kiss:/<img src="http:\/\/216.65.76.77\/icons\/kiss.gif">/g; $swap_image =~ s/:licks:/<img src="http:\/\/216.65.76.77\/icons\/licks.gif">/g; $swap_image =~ s/:phyt:/<img src="http:\/\/216.65.76.77\/icons\/phyt.gif">/g; $swap_image =~ s/:poof:/<img src="http:\/\/216.65.76.77\/icons\/poof.gif">/g; $swap_image =~ s/:roses:/<img src="http:\/\/216.65.76.77\/icons\/roses.gif">/g; $swap_image =~ s/:slurp:/<img src="http:\/\/216.65.76.77\/icons\/slurp.gif">/g; $swap_image =~ s/:smile:/<img src="http:\/\/216.65.76.77\/icons\/smile.gif">/g; $swap_image =~ s/:wink:/<img src="http:\/\/216.65.76.77\/icons\/wink.gif">/g; # print $cur->p("$swap_image"); $cur->param("message", $swap_image); ################################################ @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 hr; #print "<TABLE BGCOLOR=\"$FORMCOLOR\" # put a table around form, if you like # BORDER =\"1\" CELLPADDING =\"10\"><TR><TD>\n"; 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>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"; if ($SHOW_EMAIL) { print "<BR><B>Email or URL:</B>\n", $cur->textfield( # sticky email/URL field -NAME => "email", -SIZE => 40), " (optional)<BR>\n"; }; print "<BR><B>Message:</B><BR>\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"), "<BR>\n"; ### print $cur->submit( -VALUE => "send / refresh"), " "; #print $cur->reset( -VALUE => "clear"); # clear button, if you like print end_form, "\n"; #print "</TD></TR></TABLE>\n"; print hr; 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"> <CENTER> <b>Latest Comments at <A NAME="BOTTOM" HREF="#TOP">Top</a> of Page</b> </CENTER> <p> <CENTER> <A HREF="$RETURN">Return to Home Page</a></b> </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 ($TZONE)"; } sub bail { # print errors directly to browser my $error = "@_"; print h1("Error:"), p($error), end_html; die $error; }
|