#!/usr/bin/perl
# Always set a path to the external libraries
$lib = ".";
require "$lib/cgi-lib.pl";
require "$lib/chat-lib.pl";
require "$lib/chat.setup";

# Read the form variables in
&ReadParse;

# There are a lot of variables to pass...
# and they all need to be global
&MakeGlobalVariables;

&Debug(sprintf("remote_addr $ENV{'REMOTE_ADDR'}"));

# load the appropriate requires:
# if InitHeader eq "on" then the frameset's been sent,
#    with the header frame's SRC set to the CGI with InitHeader=on
#    load either chat_header_ns.pl or chat_header_ex.pl depending
#      on the browser variable, don't load if not needed
#    IM functions necessitate having multiple pl's for these,
#      because of javascript differences between them
if ($InitHeader eq "on" && $browser eq "Netscape") {
	require "$lib/chat_header_ns.pl";
} elsif ($InitHeader eq "on") {
	require "$lib/chat_header_ex.pl";
}

# 
# We print the magic header.  HOWEVER, since 
# we are constantly forcing the user to reload
# the web page for new chat information, if there
# is currently a session going on, we need to
# send a no-cache message to the browser to tell
# it not to waste memory/disk space caching the
# multiple Chat Pages.
#
print "Content-type: text/html\n";
if ($in{'session'} ne "") {
	print "Expires: 0\n";
	print "Pragma: no-cache\n\n";
} else {
	print "\n";
}

#
# If there is no session id, we need to create one
#
#&Debug(sprintf("session=<$session> fsubmit=<$fsubmit> InitHeader=<$InitHeader> logoff=<$logoff> refresh=<$refresh>"));
$new_session = "no";

## prevent lurkers from pressing back button
## at exit screen
#if ($session eq "logoff") {
#	&PrintChatExit;
#}
#elsif ($session eq "") {
if($session eq "" && $GetUserlist ne "on") {
	if ($chat_username eq "") {
		if ($enter_chat eq "") {
			&PrintChatEntrance($setup,"");
		} else {
			&PrintChatEntrance($setup,"Please enter a username!")
		}
		exit;
	}
	$new_session = "yes";
	#&Debug(sprintf("calling MakeSessionFile($chat_username,$chat_email,$chat_http,$refresh_rate,$how_many_old,0)"));
	$session = &MakeSessionFile($chat_username, $chat_email, $chat_http, $refresh_rate, $how_many_old, "0");
}

#
# We need to get the current session
# information including the current
# high message number.
# 
($user_name, $user_email, $user_http,
 $refresh_rate, $how_many_old, 
 $user_last_read, $high_message) = &GetSessionInfo($session, $fsubmit, $frames);

#
# If the user logs in correctly, we
# should be able to get the chat room info
# we need
# 
($chat_room_name, $chat_room_dir) = &GetChatRoomInfo($chat_room);

#
# We use the current date and time
# in the program
#
($min, $hour, $day, $mon, $year) = (localtime(time))[1,2,3,4,5];
$mon++;
if (length($min) < 2) {
    $min = "0" . $min;
}
$ampm = "AM";
$ampm = "PM" if ($hour > 11);
$hour = $hour - 12 if ($hour > 12);
## fix y2k
$year = $year + 1900;
$current_date_time = "$mon/$day/$year $hour:$min $ampm ET";

# If we are entering a new message,
# we need to write it to a file
#
if ($submit_message ne "" || fsubmit ne "on" || $refresh eq "on") {
	if ($chat_to_user eq "" ||
		$chat_to_user =~ /^all$/i ||
		$chat_to_user =~ /everyone/i) {
			## message is to everyone
			$chat_to_user  = "ALL";
	}

#
# If we are announcing the entry of
# users in the chat room, we need to submit
# a message to that effect
#
if ($chat_announce_entry eq "on" && $new_session eq "yes") {
	$submit_message = "on";
	$chat_to_user = "ALL";
	$chat_message = "<font face=arial,helvetica,verdana color=\#009900><B>just entered!</B></font><font size=1 face=helvetica,arial>&nbsp;&nbsp;$current_date_time</font>";
	## hack...
	$fsubmit="on";
}

## fsubmit is only on if entry is made from chatform,
## or if new_session case above is met. logoff message
## generated below
if($fsubmit eq "on" && $logoff eq "") {
	## autogenerate a color change message
	if($colorchange eq "on") {
		$chat_message="changed color to \#$textcolor!";
	}
	## suppose folks just hit update with no message...
	if($chat_message ne "") {
		&WriteMessageFile;
	}
}

# we need to get rid of old messages
	&PruneOldMessages($chat_room_dir);

#
# We need to be able to GetSessionInfo
# again since the state of the messages that
# are available have changed since the 
# user last read the information.
#
# Last_read has not changed, so we
# keep track of it with a temporary 
# variable (old_last_read) and reset it
# afterwards.
#
	$old_last_read = $user_last_read;
	($user_name, $user_email, $user_http,
		$refresh_rate, $how_many_old, 
		$user_last_read, $high_message) = &GetSessionInfo($session, $fsubmit, $frames);
	$user_last_read = $old_last_read;
	#&Debug(sprintf("return from 2nd call to GetSessionInfo: <$user_name,$user_email,$user_http,$refresh_rate,$how_many_old,$user_last_read, $high_message>"));
}

## add an itty bitty userlist at the top
## -- if IMPoll ne "on"
if($IMPoll ne "on") {
	$UserListToPrint="Chatters: ";
	foreach $key (sort keys %UserList) {
		$UserListToPrint .= " $key -";
	}
	chop($UserListToPrint);
	## the bitty list initializes the chat_buffer
	$chat_buffer.="<CENTER><font face=arial,helvetica,verdana size=2>$UserListToPrint</font></CENTER>\n";
} else {
	## use chat_buffer as a sentinel value...
	## if 'INIT', then pop off reply to IM window
	$chat_buffer="INIT";
}

#
# Now that we have session information
# we need to gather the message info
# from the chat_room_directory.
#
if ($session =~ /(\w+)/) {
	$session = $1;
} else {
	$session = "";
}

#
# This condition is met if a session has gone to the
# PrintChatExit screen, and the back button or
# a the history list has been clicked
#
$whofile = "$chat_room_dir/$session.who";
if(! -f $whofile) {
	$submit_message = "on";
	$chat_to_user = "ALL";
	$chat_message = "<font face=arial,helvetica,verdana color=\#009900><B>just re-entered!</B></font><font size=1 face=helvetica,arial>&nbsp;&nbsp;$current_date_time</font>";
	## hack...
	$fsubmit="on";
}
# We want to make sure the "WHO" file 
# for a user is written in order
# to keep track of who is in the room.
#
## make a new whofile every time
unlink($whofile);
open(WHOFILE, ">$whofile");
print WHOFILE "$user_name|$user_email|$user_http|$current_date_time\n";
close (WHOFILE);
&RemoveOldWhoFiles($chat_room_dir);
#&Debug(sprintf("whofile routine complete"));

if($logoff ne "" ) {
	## make a logoff message
	$submit_message = "on";
	$chat_to_user = "ALL";
	$chat_message = "<B><font face=arial,helvetica,verdana color=\#009900>logged off.</font></B><font size=1 face=helvetica,arial>&nbsp;&nbsp;$current_date_time</font>";
	&WriteMessageFile;
	## remove whofile
	$whofile = "$chat_room_dir/$session.who";
	unlink($whofile);
	## remove session file... or let them lurk
	#$SessionFile="Sessions/$session.dat";
	#unlink($SessionFile);
	#$session="";
	#&Debug(sprintf("logoff eq <$logoff>, calling PrintChatExit"));
	&PrintChatExit;
}

#
# We add one to the user last read
# because we do not want to read the
# last read message.
# We subtract how many old messages
# we are allowed to read.
$msg_to_read = $user_last_read + 1;
if($chat_announce_entry ne "on") {
	## because if we just arrived,
	## we want to see the messages
	$msg_to_read -= $how_many_old;
}
if ($msg_to_read < 1) {
    $msg_to_read = 1;
}

#&Debug(sprintf("high_message=<$high_message> msg_to_read=<$msg_to_read>"));

if ($high_message >= $msg_to_read) {
	for ($x = $high_message; $x >= $msg_to_read; $x--) {
		$x = sprintf("%6d",$x);
		$x =~ tr/ /0/;   
		if (-e "$chat_room_dir/$x.msg") {
			open(MSG,"<$chat_room_dir/$x.msg") ||
			&CgiDie("Could not open $x.msg");
			$msg_from_user = <MSG>;
			#$msg_from_user = &HtmlFilter($msg_from_user);
			$msg_color = <MSG>;
			$msg_http = <MSG>;
			$msg_to_user = <MSG>;
			#$msg_to_user = &HtmlFilter($msg_to_user);
			$msg_date_time = <MSG>;
			chop($msg_from_user);    
			chop($msg_color);
			chop($msg_http);
			chop($msg_to_user);    
			chop($msg_date_time);
			$msg_body="";
			while(<MSG>) {
				$_ = &HtmlFilter($_);
				$msg_body .= "$_";
			}
			close(MSG);
			if ($IMPoll eq "on") {
				## send the first message and bail
				if ($msg_to_user eq $user_name ) {
					$msg_body =~ s/\\0//g;
					$chat_buffer = "<center><font face=helvetica,arial,verdana color=$msg_color><B>from $msg_from_user to $msg_to_user</B></font><BR><font face=helvetica,arial,verdana color=$msg_color size=2>$msg_body</font></center>\n";
					## remove the IM once it's queued to send
					$message_rm="$chat_room_dir/$x.msg";
					if ($message_rm =~ /([\w-.]+[\w-.\/]+)/) {
						$message_rm = $1;
					} else {
						$message_rm = "";
					}
					unlink("$message_rm");
					$reply_to_user=$msg_from_user;
					last;
				}
			} else {
				if ($msg_to_user eq $user_name) {
					$chat_buffer .= "<SCRIPT LANGUAGE=JavaScript>\n";
					$chat_buffer .= "top.header.DoIMPopUp()\n";
					$chat_buffer .= "</SCRIPT>\n";
				}
				elsif($msg_to_user eq "ALL") {
					$chat_buffer .= "<font face=arial,helvetica,verdana color=\#$msg_color size=3><B>$msg_from_user - </B><font size=2>$msg_body</font></font>";
					$chat_buffer .= "<BR>\n";
				}
			}
		}
	}
}
#&Debug(sprintf("calling PrintChatScreen..."));
# Print the chat screen.
&PrintChatScreen($chat_buffer, $refresh_rate, 
                 $session, $chat_room, $setup,
                 $frames, $fmsgs, $fsubmit);

#######################
#                     #
# END OF MAIN ROUTINE #
#                     #
#######################
sub WriteMessageFile { 
	local($lockfile)="$chat_room_dir/msg.LCK";
	local($wMsgOkay)=1;
	local($TimeOut)=0;
	local($PID_Loop)=0;

	while($wMsgOkay == 1 && $TimeOut <= 5000) {
		$TimeOut++;
		# case for wait period necessity
		&Debug(sprintf("*******\n$$ is us."));
		$cmd="ps -auxw|grep \"chat.cgi\"|grep -v grep|grep -v defunct";
		open(PSLIST,"$cmd|");
		while(<PSLIST>) {
			$_ =~ s/  */ /g;
			chomp($_);
			&Debug(sprintf("PID List: $_"));
			@fields=split(/ /,$_);
			$pses=$field[2];
			## if there is a higher PID running chat.cgi, we loop
			if($pses > $$) {
				&Debug(sprintf("looping because $pses is greater than $$"));
				$PID_Loop=1;
				last;
			}
		}
		if($PID_Loop == 0) {
			$high_number = &GetHighMessageNumber;
			$high_number++; 
			$high_number = sprintf("%6d",$high_number);
			$high_number =~ tr/ /0/;           
			if (-f $lockfile) {
				&Debug(sprintf("$$ found $lockfile, looping"));
				# loop
				$wMsgOkay=1;
			} else {
				$cmd="touch $lockfile";
				system($cmd);
				&Debug(sprintf("$$ WRITING $high_number.msg"));
				# not loop
				$wMsgOkay=0;
				open(MSGFILE, ">$chat_room_dir/$high_number.msg");
				print MSGFILE "$user_name\n";
				print MSGFILE "$textcolor\n";
				print MSGFILE " \n";
				print MSGFILE "$chat_to_user\n";
				print MSGFILE "$current_date_time\n";
				print MSGFILE "$chat_message\n";
				close(MSGFILE);
				unlink($lockfile);
			}
		}
		else {
			$PID_Loop=0;
		}
	}
}

############################################################
#
# subroutine: GetSessionInfo 
#   Usage:
#   ($session, $username, @extra_fields,
#    = &GetSessionInfo($session, "script name",
#    *in);
#
#   Parameters:
#     $session = session id.  Null if it is not defined yet
#     $fsubmit = we are printing the submit portion of
#        a chat frame so do not do new message processing
#     $frames = we are printing the main frameset HTML 
#        document so do not do new message processing
#
#   Output:
#     $session = session id
#     An array of fields consisting of:
#       $username, $email, $home page,
#       $refresh_rate, $old_message_count
#     $high_message = high message number
#
############################################################

sub GetSessionInfo {
local($session, $fsubmit,$frames) = @_;
local($session_file);
local($temp,@fields, @f);
local($high_number, $high_message);

#&Debug(sprintf("Entry to GetSessionInfo: <$session><$fsubmit><$frames>"));

$session =~ /(\w*)/;
$session = $1;

$session_file = "$session.dat";

#
# Open the session file
#
open (SESSIONFILE, "<$chat_session_dir/$session_file");

while (<SESSIONFILE>) {
$temp = $_;
} 
chop($temp);


@fields = split(/\|/, $temp);

close (SESSIONFILE);                  

#
# Get the highest message number 
#
$high_message = &GetHighMessageNumber;

# Keep track of old fields
@f = @fields;
# Update last read field
@fields[@fields - 1] = $high_message;
#
# We need to write the new last read variable out
# to the session file
#
if ($fsubmit ne "on" &&
    $frames ne "on") {
    open (SESSIONFILE, ">$chat_session_dir/$session_file");
    print SESSIONFILE join ("\|", @fields);
    print SESSIONFILE "\n";
    close (SESSIONFILE);
}
(@f, $high_message);

} # End of GetSessionInfo


############################################################
#
# subroutine: GetHighMessageNumber
#   Usage:
#     $high_message = &GetHighMessageNumber;
#
#  This routine returns the highest message number
#  for the chat room.
#
#   Output:
#     $high_message_number
#
############################################################

sub GetHighMessageNumber {
local($last_file, @files);

# Read in all the files and sort them
opendir(CHATDIR, "$chat_room_dir");
@files = sort(grep(/msg/, readdir(CHATDIR)));
closedir(CHATDIR);

# Return highest message or 0 if no files
if (@files > 0) {
    $last_file = $files[@files - 1];
} else {
    $last_file = "0000000";
}

# Return the first 6 characters of the filename
substr($last_file,0,6);

} # End of GetHighMessageNumber

############################################################
#
# subroutine: CheckForDuplicateUsername
#   Usage:
#   $session = &CheckForDuplicateUsername();
#
#  Dave Rickard
# 
#  Give the user the boot out to the old login page if they
#  have a session ID that is new or null, and there's already
#  a user_name in a who file in the chatroom directory.
#
#  Parameters:
#
#   Output:
#
############################################################

sub CheckForDuplicateUsername {
	#&Debug(sprintf("CheckForDuplicatUsername entry"));
	$WhoCounterFile="$chat_room_dir/SpeedoCounter";
	$WhoCounter=0;
	opendir(CHATDIR, "$chat_room_dir");
	@files = grep(/who$/,readdir(CHATDIR));
	closedir(CHATDIR);

	if (@files > 0) {
		## make an array with all the users in it
		## that's the 1st field of all the *.who files
		## in the chat_room_dir
		foreach $checkwhofile (@files) {
			$WhoCounter++;
			open (WHOFILE,"<$chat_room_dir/$checkwhofile");
			$wholine = <WHOFILE>;
			@whofields = split(/\|/,$wholine);
			close(WHOFILE);
			$CheckSessionID=split(/\./,$checkwhofile);
			## make a userlist for a private message list bos
			## and to display a teeny list
			$UserList{$whofields[0]}++;
			if($chat_username eq $whofields[0]) {
				if ($session ne $CheckSessionID) {
					# same username, different session...
					# boot!
					&PrintChatEntrance($setup,"$chat_username is already in use, please choose another!")
				}
			}
		}
		## got through the list with no dupes...
		## make them a who file
		$whofile = "$chat_room_dir/$session.who";
		## good practices... 
		#unlink($whofile);
		## write it out
		open(WHOFILE, "> $whofile");
		print WHOFILE "$user_name|$user_email|$user_http|$current_date_time\n";
		close(WHOFILE);
		## Put the new username on %UserList for displaying
		$UserList{$user_name}++;
		## make the speedo counter for this room
		$WhoCounter++;
		open(WHOCTR,"> $WhoCounterFile");
		print WHOCTR "$WhoCounter\n";
		close(WHOCTR);
		## housekeeping...
		#&RemoveOldWhoFiles;
	}
}


############################################################
#
# subroutine: MakeUserList
#   Usage:
#   &MakeUserList();
#
#  We want to make a hash that we can foreach through
#  in order to have a listbox of users for private
#  messaging choices, a display of all who are in the
#  room, and a speedometer counter.  Not performed on
#  initial entry (new_session eq yes), since 
#  CheckForDuplicateUser does the same thing, booting
#  those with duplicate user_names back to the entry
#  screen.
#
#  Dave Rickard
#
############################################################
sub MakeUserList {
	local($chat_room_dir)=@_;
	opendir(CHATDIR, "$chat_room_dir");
	@files = grep(/who$/,readdir(CHATDIR));
	closedir(CHATDIR);
	## initialize SpeedoCounter (WhoCounter)
	$WhoCounter=0;

	if (@files > 0) {
		## make an array with all the users in it
		## that's the 1st field of all the *.who files
		## in the chat_room_dir
		foreach $checkwhofile (@files) {
			$WhoCounter++;
			open (WHOFILE,"<$chat_room_dir/$checkwhofile");
			$wholine = <WHOFILE>;
			@whofields = split(/\|/,$wholine);
			close(WHOFILE);
			$CheckSessionID=split(/\./,$checkwhofile);
			## make a userlist for a private message list box
			## and to display a teeny list
			$UserList{$whofields[0]}++;
		}
	}
	## make the speedo counter for this room
	$WhoCounterFile="$chat_room_dir/SpeedoCounter";
	open(WHOCTR,"> $WhoCounterFile");
	print WHOCTR "$WhoCounter\n";
	close(WHOCTR);
}


############################################################
#
# subroutine: MakeSessionFile
#   Usage:
#   $session = &MakeSessionFile(@fields);
#
#  This routine makes a session file on the basis of the
#  fields that make up a user such as first name and last
#  name.
#
#  Parameters:
#   @fields = a list of fields that make up the user
#
#   Output:
#     $session = session id
#
############################################################
                                       
sub MakeSessionFile {
local(@fields) = @_;
local($session, $session_file);

#
# RemoveOldSessions
#
&RemoveOldSessions;

# Seed the random generator
srand($$|time);
$session = int(rand(60000));
# pack the time, process id, and random $session into a
# hex number which will make up the session id.
$session = unpack("H*", pack("Nnn", time, $$, $session));

$session_file = "$session.dat";

#
# Create the actual session file
# 
open (SESSIONFILE, ">$chat_session_dir/$session_file");      
print SESSIONFILE join ("\|", @fields);
print SESSIONFILE "\n";

close (SESSIONFILE);

$session;                                

} # End of MakeSessionFile


############################################################
#
# subroutine: RemoveOldSessions
#   Usage:
#     &RemoveOldSessions;
#
# This routine removes old session files based on the
# age determined by the defined variables 
# ($chat_session_length).                     
#
#  Parameters:
#    None.
#
#  Output:
#     None.
############################################################

sub RemoveOldSessions
{
local(@files, $file);
# Open up the session directory.
opendir(SESSIONDIR, "$chat_session_dir");
# read all entries except "." and ".."
@files = grep(!/^\.\.?$/,readdir(SESSIONDIR));
closedir(SESSIONDIR);                 
                         
# Go through each file
foreach $file (@files)
        {
# If it is older than session_length, delete it
# Note that the filename needs to be untainted before removing.
        if ($file =~ /([\w-.]+)/) {
            $file = $1;
        } else {
            $file = ".dat";
        }
        if (-M "$chat_session_dir/$file" > $chat_session_length)
                {
                unlink("$chat_session_dir/$file");
                }

        }
} # End of RemoveOldSessions
                                      
############################################################
#
# subroutine: RemoveOldWhoFiles
#   Usage:
#     &RemoveOldWhoFiles;
#
# This routine removes old who files based on the age
# determined by the defined variables
# ($chat_who_length)
#
#  Parameters:
#    None.
#
#  Output:
#     None.
############################################################

sub RemoveOldWhoFiles {
	local($chat_room_dir)=@_;
	local(@files, $file);
	# Open up the chat_dir directory.
	opendir(CHATDIR, "$chat_room_dir");
	# read only "who" files
	@files = grep(/who$/,readdir(CHATDIR));
	closedir(CHATDIR);                 
                         
	# Go through each file
	foreach $file (@files) {
		# If it is older than chat_who_length, delete it
		# Note that the filename needs to be untainted before removing.
		if ($file =~ /([\w-.]+)/) {
			$file = $1;
		} else {
			$file = ".dat";
		}
		if (-M "$chat_room_dir/$file" > $chat_who_length) {
			unlink("$chat_room_dir/$file");
		}
	}
} # End of RemoveOldWhoFiles

############################################################
#
# subroutine: GetChatRoomInfo
#  Usage:
#    &GetChatRoomInfo($chat_room);
#
#   Parameters:
#     $chat_room = abbreviated chat room identifier
#
#   Output:
#     Returns an array of the chat room name and
#     chat room directory.
#
############################################################

sub GetChatRoomInfo {
   local($chat_room) = @_;           
   local($chat_room_name, $chat_room_dir, $x);
   local($chat_room_number, $error);

$chat_room_number = -1;

for ($x = 1; $x <= @chat_room_variable; $x++)
        {
        if ($chat_room_variable[$x - 1] eq $chat_room)
                {
                $chat_room_number = $x - 1;
                last;
                }
        } # End of FOR chat_room_variables

if ($chat_room_number > -1) {
    $chat_room_name = $chat_rooms[$chat_room_number];
    $chat_room_dir = $chat_room_directories[$chat_room_number];    
} else {
    $chat_room_name="";
    $chat_room_dir = "";
    $chat_room = "None Given" if ($chat_room eq "");
    $error =
        "<strong>Chat Room: '$chat_room' Not Found</strong>";
    &PrintChatError($error);
    die;
}
# 
# Check to see if anyone else wants to be
# logged in as that
# 
# If so, boot out to the login page.  This can
# happen when someone clicks the refresh button
# on their browser; the session ID will be remade,
# there'll be their login name in the old who file
# ./$chat_room_dir/$sessionID.who.. they'll get the
# boot!
if($new_session eq "yes") {
	&CheckForDuplicateUsername();
}
else {
	&MakeUserList($chat_room_dir);
}

## if dupe username was found they were sent to PrintChatEntrance,
## otherwise they're here to return these values:
($chat_room_name, $chat_room_dir);

} # end of GetChatRoomInfo
                                   
############################################################
#
# subroutine: PruneOldMessages
#  Usage:
#    &PruneOldMessages($chat_room_dir);
#
#   Parameters:
#     $chat_room_dir = directory of chat room
#
#   Output:
#     Unlinks (deletes) messages
#     in the chat room directory based on age or sequence
#     number as defined in the setup file.
#
############################################################
                                                                        
sub PruneOldMessages {
    local($chat_room_dir) = @_;
    local($x, @files);
    local($prunefile);
#
# We prune on the basis of
#
# AGE IN DAYS:
# $prune_how_many_days
#
# AGE BY SEQUENCE NUMBER
# $prune_how_many_sequences
#
    opendir(CHATDIR, "$chat_room_dir");
    @files = sort(grep(/msg/, readdir(CHATDIR)));
    closedir(CHATDIR);

    for ($x = @files; $x >= 1; $x--) {
        $prunefile = "$chat_room_dir/$files[$x - 1]";
        # we need to untaint the filename to be pruned...
        if ($prunefile =~ /([\w-.]+[\w-.\/]+)/) {
            $prunefile = $1;
        } else {
            $prunefile = "";
        }
        # First we check the age in days
        if ((-M "$prunefile" > $prune_how_many_days) &&
            ($prune_how_many_days > 0)) {
            unlink("$prunefile");
            &RemoveElement(*files, $x - 1);
            next;
        }


        #
        # Check the sequence and delete if it the msg # limit is hit
        #
        if (($x <= (@files - $prune_how_many_sequences))
            && ($prune_how_many_sequences != 0)) {
            unlink("$prunefile");
            &RemoveElement(*files, $x - 1);
            next;
        }
    } # End of for all files

} # End of PruneOldMessages

############################################################
#
# subroutine: RemoveElement
#  Usage:
#    &RemoveElement;
#
#   Parameters:
#     *file_list = array of message numbers
#     $number = pointer into the array of the
#               element to remove
#
#   Output:
#     *file_list without the $number element.
#
############################################################

sub RemoveElement
{
local(*file_list, $number) = @_;

if ($number > @file_list)
        {
        die "Number was higher than " .
            "number of elements in file list";
        }
splice(@file_list,$number,1);

@file_list;

} # End of RemoveElement

############################################################
#
# subroutine: HtmlFilter
#  Usage:
#    $filtertext = &HtmlFilter($filterthis);
#
#   Parameters:
#    $filter = text to filter HTML in
#
#   Output:
#     Filtered string
#
############################################################

sub HtmlFilter
{
local($filter) = @_;

## turn anchor references into links that pop up a new window
if($filter =~ /http:\/\//i) {
	$filter =~ s/(http:\/\/.\S*)/<a href=$1 target=new>$1<\/a>/gi
}

# 
# The following filters the HTML images
# out, if they are disallowed.  The code
# after this, filters out all HTML if it
# is disallowed.
#
#if ($no_html_images eq "on")
#{
#    $filter =~ s/<(IMG\s*SRC.*)>/&LT;$1&GT;/ig;
#} # End of parsing out no images

#if ($no_html eq "on")
#{
#    $filter =~ s/<([^>]+)>/\&LT;$1&GT;/ig;
#} # End of No html                                         

## filter out quotes and double quotes
## ... it messes up the javascript writes
#$filter =~ s/\'//g;
#$filter =~ s/(\<|\>|\.|\~|\/|\\|\(|\)|\&|\^|\%|\$|\#|\@|\!)(\<|\>|\.|\~|\/|\\|\(|\)|\&|\^|\%|\$|\#|\@|\!)\*/ /gi;

#$filter =~ s/  */ /gi;
#$filter =~ s/\$/s/gi;
#$filter =~ s/(8{1,}|)\={2,}(>{1,}|)/ (art deleted) /g;     

#$filter=&CussWords($filter,"motherfucker"," genuine article ");
#$filter=&CussWords($filter,"fucker"," plumber ");
#$filter=&CussWords($filter,"fucking"," organizing ");
#$filter=&CussWords($filter,"fucked"," organized ");
#$filter=&CussWords($filter,"gangbang"," tupperware party ");
#$filter=&CussWords($filter,"tit"," hacky sack ");
#$filter=&CussWords($filter,"boob"," distracting attribute ");
#$filter=&CussWords($filter,"boner"," attention deficit ");
#$filter=&CussWords($filter,"hardon"," rather large nose ");
#$filter=&CussWords($filter,"erection"," issue with my childhood ");
#$filter=&CussWords($filter,"queer"," oboe player ");
#$filter=&CussWords($filter,"dyke"," Lawrence Welk fan ");
#$filter=&CussWords($filter,"slease"," fun to be around ");
#$filter=&CussWords($filter,"homo"," good buddy ");
#$filter=&CussWords($filter,"faggott"," patron of the arts ");
#$filter=&CussWords($filter,"slut"," popular person ");
#$filter=&CussWords($filter,"go(d|dd)a(m|mm|mn)"," blessed ");
#$filter=&CussWords($filter,"da(m|mn|mm)"," darn ");
#$filter=&CussWords($filter,"blowme"," shake my hand ");
#$filter=&CussWords($filter,"fu(ck|k|g|gg)"," organize ");
#$filter=&CussWords($filter,"shit"," stuff ");
#$filter=&CussWords($filter,"cunt"," flower ");
#$filter=&CussWords($filter,"pussy"," cat ");
#$filter=&CussWords($filter,"dick"," living room ");
#$filter=&CussWords($filter,"prick"," prince ");
#$filter=&CussWords($filter,"sex"," tiddly winks ");
#$filter=&CussWords($filter,"asshole"," awfully nice person ");
#$filter=&CussWords($filter,"vagina"," new car ");
#$filter=&CussWords($filter,"butt"," bottom ");
#$filter=&CussWords($filter,"cock"," admittedly narrow mind ");
#$filter=&CussWords($filter,"cum"," snow ");
#$filter=&CussWords($filter,"twat"," vision of loveliness ");
#$filter=&CussWords($filter,"bitch"," charming girl ");
#$filter=&CussWords($filter,"bastard"," dashing fellow ");
#$filter=&CussWords($filter,"fag"," gentleman ");
#$filter=&CussWords($filter,"bloody"," dadburn ");
#$filter=&CussWords($filter,"blowjob"," foot rub ");
#$filter=&CussWords($filter,"suck"," nicely coordinate ");
#$filter=&CussWords($filter,"anus"," Alanis Morrisette ");
#$filter=&CussWords($filter,"penis"," pencil ");
#$filter=&CussWords($filter,"nigger"," superior being ");
#$filter=&CussWords($filter,"gay"," fabulous ");
#$filter=&CussWords($filter,"retard"," wise one ");
#$filter=&CussWords($filter,"licker"," incredibly intelliqent one ");
#$filter=&CussWords($filter,"whore"," lovely companion ");
#$filter=&CussWords($filter,"clit"," ticklish spot ");
#$filter=&CussWords($filter,"godda(m|mm|mn)it"," dabnabbit ");
#$filter=&CussWords($filter,"ass"," HeeeeeHaaaaaw ");
$filter;
} # End of HTML Filter


sub CussWords {
	local($line, $subout, $subin)=@_;
#	$subout =~ s/c/(c|\\()/gi;
#	$subout =~ s/a/(a|\@)/gi;
#	$subout =~ s/i/(i|1|l|!)/gi;
#	$subout =~ s/s/(s|5)/gi;
#	$subout =~ s/u/(u|v)/gi;
#	$subout =~ s/e/(e|3)/gi;
#	$subout =~ s/t/(t|7)/gi;
#	$subout =~ s/w/(w|\/\/)/gi;
#	$subout =~ s/o/(o|0)/gi;
#
#
#	$chkstr="";
#	$garbage="(\\W*)";
#	$pos=0;
#	for($pos=0; $pos <= length($subout); $pos++) {
#		$chkstr.=substr($subout,$pos,1) . $garbage;
#	}
#print "$chkstr\n";
#$line =~ s/$chkstr/$subin/gi;
	return($line);
}


############################################################
#
# subroutine: MakeGlobalVariables
#
#   Output:
#     no explicit returns, just makes Global Variables
#
############################################################
sub MakeGlobalVariables {
	# are we debugging? 1=yes, else=no
	$DoDebug=1;
	
	#
	# The chat_ variables are initial form
	# variables read in from the first screen
	# where the user signs up for the chat mode
	#
	# $refresh_rate is > 0 if the user
	# has a browser that supports auto 
	# refreshing using the META Tag such as
	# Netscape.
	#
	# How many old, is the amount of 
	# old messages to display with the new
	# messages.
	#
	# The above to variables are written to
	# the session files.
	#
	$browser = $in{'browser'};
	$chat_username = $in{'chat_username'};
	$refresh_rate = $in{'refresh_rate'};
	$how_many_old = $in{'how_many_old'};
	$textcolor = $in{'textcolor'};
	$infoframe = $in{'infoframe'};
	$colorchange = $in{'colorchange'};
	$InitHeader = $in{'InitHeader'};
	$GetUserlist = $in{'GetUserlist'};
	$IMPoll = $in{'IMPoll'};
	
	#
	# $chat_room is the chat_room a person
	# is in.
	#
	# $setup is the setup file to read.  If
	# no setup is specified, then $setup will
	# be set equal to "chat".
	# 
	$chat_room = $in{'chat_room'};
	$setup_file = $in{"setup"};
	
	#
	# The following are variables
	# related to the various chat operations
	#
	$enter_chat = $in{'enter_chat'};
	$submit_message = $in{'submit_message'};
	$logoff = $in{'logoff'};
	
	## make a default for $textcolor
	if($textcolor eq "") {
		$textcolor="000000";
	}
	
	#
	# $fmsgs means the script was called
	# from the frame with the messages in them
	# 
	# $fsubmit means the script was called
	# from the frame with the submit chat 
	# message form in it.
	#
	#$frames = $in{'frames'};
	$frames="on";
	$fmsgs = $in{'fmsgs'};
	$fsubmit = $in{'fsubmit'};
	$refresh = $in{'refresh'};
	
	# 
	# The following are needed for submitting
	# a message
	#
	$chat_to_user = $in{'chat_to_user'};
	$chat_message = $in{'chat_message'};
	
	# --NOW HARDWIRED AT THE TOP OF MAIN
	# We have to untaint the setup file variable
	# So we filter it so that it needs to be word
	# characters or dash characters.
	#if ($setup_file =~ /([\w-]+)/) {
	#	$setup_file = $1;
	#} else {
	#	$setup_file = "";
	#}
	#if ($setup_file eq "") {
	#	$setup_file = "chat";
	#}
	#require "./$setup_file.setup";

	#
	# Set up a default chat_script
	# if we did not define one
	#
	#if ($chat_script eq "") {
		$chat_script = "chat.cgi";
	#}
	
	# 
	# $user_last_read is the last read
	# chat message for the user in the chat
	# room
	#
	$user_last_read = 0;
	
	## if refresh is pressed on the browser,
	## we don't have a session id (that button removed). If new entry,
	## sessionid will be null anyway
	$session = $in{'session'};
	
#&Debug(sprintf("*****\n*****\n1: IMPoll=<$IMPoll> GetUserlist=<$GetUserlist> chat_message=<$chat_message> chat_to_user=<$chat_to_user> session=<$session> browser=<$browser>"));
}