#!/usr/bin/perl -T
#use CGI::Carp qw( fatalsToBrowser );

##################
#  Script Version 15.2 	# Added epoch-indexed visitors control. 
#					SPLIT Guest and member's programs
#  Added undefs, Replaced Flock, Case insensitive slow ban. Guest reload limit, Autoboot
##################
$last_access = 1000;
$epoch = 0;
$epoch_name = "";
$epoch_ip = "";
$ra = "";
$vr = "";
$mailprog= "/usr/lib/sendmail" ;
$recipient= "webmaster\@gorean-shores.com" ;      # escape the @
$message = "";   # Main chat buffer;
$etype = 0;		# error type flag

$bye_type = 0;		# Boolean
$usemail = 0;
$debug_var = 0;         # 
$debug_count = 0;       # 

$is_member = 0;		#
 
$member_name = "";      # 
$name_color = "000000"; #
$exclusion = 0;         # Flag bad IP addies
$valid_ref = "www.gorean-shores.com";   # 
$theroom = "Courtyard";
$host_list = 0; 

$stardate ="";
$data = 0;
$passwd = "123";

$back_color = "default";
$text_color = "default";
$font_color = "default";
$font_size = "default";
$background = "";
$italic = "off";
$bold = "off";
$tc = "";
$tag = "";
$img = "on";

$link_color = "yellow";
$vlink_color = "#FF9966";
$wcolor = "ee0012";   # Whisper color 

$poof_message = "<img src=\"../graphics/bewell.gif\">";
$regnow_pic = "<img src=\"../graphics/regnow.gif\">";

$top_message = "";
#############################

$data_dir = "/home/gor/public_html/axdaZo";
$file_dir = "/home/gor/public_html/axroZo"; 
$vis_dir = "/home/gor/public_html/axviZo";
$mem_dir = "/home/poolside/public_html/bdir";
$excl_dir = "/home/gor/public_html/ignore";   
$log_dir = "/home/gor/public_html/ignore";  
$ignore_dir = "/home/gor/public_html/ignore";
$cfg_dir = "/home/gor/public_html/cfg";

#############################

$logo_gif = "../graphics/gsbanner.jpg";
$whisp = "../graphics/whisper.gif";
$title_gif = "../graphics/main.gif"; 
$sub_link = "http://www.gorean-shores.com/phpBB2";
$regpage_link = "http://www.poolsidechat.com/newsignup.html";
$help_link = "../gssub/help.html";
$time_link = "../gssub/time-conversion.html";




$color_link = "../gssub/colors.html";
$accounts_link = "http://www.poolsidechat.com/account-service.html";
$bye_link = "../gssub/thanks.html";
$nag_link = "../gssub/nagbot.html";
$zoom_link = "../multipop.html";
$gor_link = "http://www.gorean-shores.com";
$who_link = "../whoshere.cgi";
$nfo_link = "http://www.gorean-shores.com/nfo.cgi";

##############################

$member_rooms = "<option>The Tavern<option>Piazza<option>Training Yard<option>Market Bazaar<option>Slave Kennels<option>Forum"; 
$gate = "Courtyard";

$viz_time = 500; 
# This is the time in seconds which people will remain in the visitors list since last reload.

$chat_time = 1000;  # Number of seconds that messages will remain in the chat file.

$old_time = 150;
# This is the time in seconds for "New" messages.

$lock_time = 1; 

#####################
# Main Chat variables

$message_text = "Messages:";
$tof_text = "Top Of Page";

$post_reload = "Post/Reload";
$clear_text = "Clear";
$leave_text = "Leave";
$who_text   =  "Who/Where";
$delold_text = "Del Old"; 
$enter_button = "Enter Room";
$enter_chat = "Enter Chat";
$index_html = "<h2>Access Denied</h2>";

$script_name = $ENV{'SCRIPT_NAME'};


#### begin script ########################################

	$time = time();
	&parse_form;

########################
# Parse Form

sub parse_form {   
	read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
	@pairs = split(/&/, $buffer);
	foreach $pair (@pairs) {
         ($namer, $value) = split(/=/, $pair);
         $value =~ tr/+/ /;
         $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
         $value =~ s/<!--(.|\n)*-->//g;
         $value =~ s/\|//g;    #no pipes
         $value =~ s/\`//g;    #no backticks

	   $value =~ s/</&lt;/g;  # NO HTML. ever
	   $value =~ s/>/&gt;/g;
		
	  $value =~ s/\<script//ig;
	  $value =~ s/\<applet//ig;
	  $value =~ s/\<embed//ig;
	  $value =~ s/\<form//ig;

        $FORM{$namer} = $value;
	}
	&get_variables;
}

###########
# Get variables from form

sub get_variables {

	if ($FORM{'data'}) {
	   $data = "$FORM{'data'}";
	}   

	if ($FORM{'public'}) {
	   $public = "$FORM{'public'}";
	   $public =~ s/ /_/g;
	   $public =~ s/\//_/g;
	}

	if ($FORM{'private'}) {
	   $private = "$FORM{'private'}";
	   $private =~ s/ /_/g;


	   $private =~ s/\//_/g;
	}
	if ($FORM{'back_color'}) {
         $back_color = "$FORM{'back_color'}";
	} 

	if ($FORM{'font_color'}) {
	   $font_color = "$FORM{'font_color'}";
	} 

	if ($FORM{'text_color'}) {
	   $text_color = "$FORM{'text_color'}";
	} 
  
	if ($FORM{'font_size'}) {
	   $font_size = "$FORM{'font_size'}";
	} 

	if ($FORM{'bold'}) {
	   $bold = "$FORM{'bold'}";
	}

	if ($FORM{'italic'}) {
	   $italic = "$FORM{'italic'}";
	}

 	if ($FORM{'tc'}) {
 	   $tc = "$FORM{'tc'}";
 	}

	if ($FORM{'tag'}) {
	   $tag = "$FORM{'tag'}";
	}
	if ($FORM{'user'}) {
	   $user = "$FORM{'user'}";
	}

	if ($FORM{'wsp'}) {
	   $wsp = "$FORM{'wsp'}";
	}

	if ($FORM{'img'}) {
	   $img = "$FORM{'img'}";
	}
	if ($FORM{'ignore'}) {
	   $ignore = "$FORM{'ignore'}";
	}

	if ($FORM{'name'}) {
	   $name = "$FORM{'name'}";     # remove all but the following chars from namestring.

	   $_ = $name;
         $OK_CHARS='a-zA-Z0-9_-~-';	   # A restrictive list.
         eval "tr/[$OK_CHARS]/_/c";
         $name = $_;
         $name =~ /^([-.\w]+)$/;
         $name =~ s/\[/_/g;
         $name =~ s/\]/_/g;
         $name =~ s/__/_/g;
         $name =~ s/ /_/g;
         $name =~ s/\|//g;    #no pipes
         $name =~ s/\`//g;    #no backticks
	    if ($name eq "nanana") {
		$etype = 0;
		&error_out;
	    }
		
	}

	if ($FORM{'room'}) {
         $room = "$FORM{'room'}";
         $_ = $room;
         $OK_CHARS='a-zA-Z0-9_-~-';	   # A restrictive list.
         eval "tr/[$OK_CHARS]/_/c";

         $room = $_;
         $room =~ /^([-.\w]+)$/;
         $room =~ s/\[/_/g;
         $room =~ s/\]/_/g;
         $room =~ s/__/_/g;
         $room =~ s/  /_/g;
         $room =~ s/\|//g;    #no pipes
         $room =~ s/\`//g;    #no backticks
         $oldroom = $room;
	}

      if ($FORM{'viz'}) {
         $viz = "$FORM{'viz'}";
      }
      if ($FORM{'epoch'}) {
        $epoch = "$FORM{'epoch'}";
      }

      if ($FORM{'passwd'}) {
        $passwd = "$FORM{'passwd'}";
      }

      if ($FORM{'numlines'}) {
        $numlines = $FORM{'numlines'};
      }
      if ($FORM{'message'}) {


        $message = $FORM{'message'};
        $message =~ s/\cM//g;
	  &run_filter;  

	if ($message =~ /\<img src/) {
	   if($img eq "off")  {
		$message =~ s/\>//ig;
            $message =~ s/\"//ig;
	      $message =~ s/\<img src/ Link /ig;
          }
	}
	else  {
	   $message =~ s/http:\/\/\S+/<a href="$&" target="new">$&<\/a> /ig;
	}
	$message =~ s/https:\/\/\S+/<a href="$&" target="new">$&<\/a> /ig;
	$message =~ s/ftp:\/\/\S+/<a href="$&" target="new">$&<\/a> /ig;
	$message =~ s/\S+\@\S+\.\S+/<a href="mailto:$&">$&<\/a> /ig;
   }


	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
	if ($sec < 10) {
         $sec = "0$sec";
	}
	if ($min < 10) {
         $min = "0$min";
	}
	if ($hour < 10) {
         $hour = "0$hour";
	}
 	$mon++;
	if ($mon < 10) {
         $mon = "0$mon";
	}
	if ($mday < 10) {
         $mday = "0$mday";
	}

	$date = "$hour\:$min\:$sec";
	$gate =~ s/ /_/g;
	$gate =~ s/\//_/g;
	&location;
}

##########
# Determine origin of call

sub location {

######
  	if ($data eq "")  {
  	   $debug = "-location-";
	   $name = "";	
	   &get_user;
	}
######

	if ($ENV{'HTTP_REFERER'} =~ /http:\/\/([^\/]+)/) {
	   if (!($ENV{'HTTP_REFERER'} =~ /$valid_ref/)) {
		&login;
		exit;
	   }
	}

	   &chop_msglen;  # Truncate member's message string to 5000 chars.

	   $message =~ s/\n/\n <P> /ig;
	   $message =~ s/\n/ <BR> /ig;

	if ($data eq "new") {
	   $ra = $ENV{'REMOTE_ADDR'};	# So far so good. Record his IP address. (Independent from time log)

	   $room = "Courtyard";		# His only room choice so far is already made for him.
	   &check_membership;

	   if($is_member != 1)  {
	      $etype = 0;  # Tell them to use another page
		&error_out;
	   }

	&log_hit;   # 
	&create;    # Maintain files
	&register;  # Adds user info to the vizfile
	&reload;    # 

	}

	elsif ($data eq "$delold_text") {
         &delete_old;  # delete old visitor messages
	   &create;      # 
	   &update;      # Update the reload time
	   &reload;      # Reload the page.
	}

	elsif ($data eq "$post_reload") {
	   if($message eq " ") {
		if($ignore eq "on")  {               
	         &freshen;  # Get the information in the message field
	         &create;   # Maintain files 
	         &createi;  # create ignore list if required.
	         &update;   # Update reload time
	         &reload;   # Reload the page.
	      }
	      else  {
	         &freshen;  # Get the information in the message field
	         &create;   # Maintainance 
	         &update;   # Update the latest reload time in vizfile
	         &reload;   # 
 	     }
	  }
	   # This must be a Message Post of some kind

	   elsif($wsp eq "on")  {
		&create;   # Could this be a double post issue too?
		&privmsg;  # Send a private message instead of &post
		&update;   # Update the latest reload time in the visitor's file
		&reload;   # Reload the page after posting the message.
	   }
	   elsif ($ignore eq "on")  {
		&create;   # Maintain files
		&createi;  # create ignore list if required.
		&post;     # Add message (if any) to chat file  
		&update;   # Update the latest reload time
		&reload;   #.
	   }

	   else  {
		&create;   # Maintain files 
		&post;     # Add message to the chat file
		&update;   # Update the reload time
		&reload;   # 
	   }
	}
	elsif ($data eq "$who_text")  {
	   &whos_here;
	}

	elsif ($data eq "$enter_button") {
	   if ($private ne "") {
		$room = "$private";
		&create;   # Maintain files 
		&change;   # Remove the person from the old room
		&register; # Add their information to the visitors file
		&reload;   # Reload the page.
	   }
         elsif ($public ne "") {
		$room = "$public";
		&create;   # Maintain files
		&change;   # Remove the person from the old room
		&register; # Add their information to the visitors file

		&reload;   # Reload the page.
	   }
	   else {
		&create;   # Maintain files
		&update;   # Update the reload time in the visitors file
		&reload;   # Reload the page.
	   }
	}
	elsif ($data eq "$leave_text") {
         &leave;    # Remove person, send them away
	}        
	else {    # if none of the above "data" variables are set, this must be a new login.
	   &countviz; # Count the number of visitors
         &login;    # Print the login page
	}
 
	sleep(1);  # will this help eliminate douple posting?
	exit;  # This is the end of the script;
}

########################
# Create files if they don't exist
sub create {

	&createv;
}

sub createv {
	$fname = sprintf("%s/vis%s", $file_dir,$room);
	$fname =~ /^([-.\w]+)$/;

	if (-e "$fname") {
         open (VISITORS,"$fname");
         flock VISITORS, 2;                 
         @visitors = <VISITORS>;
         close (VISITORS);

	   if ($visitors[0] =~ /\<!-s-\>/) {
            foreach $visitors_line (@visitors) {
		   ($b0,$load,$b1) = split(/:/,$visitors_line);
		   if ($visitors_line =~ /\<!-s-\>/) {
                  push (@visitors_new,"<!-:$time:-><!-s->\n");
               }
               elsif ($time - $load > $viz_time) {
               }
               else {
                  push (@visitors_new,"$visitors_line");
               }
		}
		undef @visitors;   #mine
		$fname = sprintf("%s/vis%s", $file_dir,$room);
		$fname =~ /^([-.\w]+)$/;
		open(VISITORS,">$fname");
		flock VISITORS, 2;
		foreach $visitors_line(@visitors_new) {
               print VISITORS "$visitors_line";
            }
            close (VISITORS);
            undef @visitors_new;
	   } 

	   else {
		$fname = sprintf("%s/vis%s", $file_dir,$room);
		$fname =~ /^([-.\w]+)$/;
		open (VISITORS,">$fname");
		print VISITORS "<!-:$time:-><!-s->";
		close (VISITORS);
	   }
	}

	else {
         $fname = sprintf("%s/vis%s", $file_dir,$room);
         $fname =~ /^([-.\w]+)$/;
         open (VISITORS,">$fname");
         flock VISITORS, 2;
         print VISITORS "<!-:$time:-><!-s->";
         close (VISITORS);
	}

	opendir(FILES,$file_dir);
	@filelist =  grep(!/^\.\.?$/, readdir (FILES));
	closedir(FILES);
	foreach $filelist (@filelist) {
	   if (-A "$file_dir/$filelist" > $chat_time / 86400) {
		$fname = sprintf("%s/%s", $file_dir,$filelist);
		$fname =~ /^([-.\w]+)$/;
		unlink("$fname");
		$fname = sprintf("%s/%s", $ignore_dir,$filelist);
		$fname =~ /^([-.\w]+)$/;
		unlink("$fname");
	   }
	}
	undef @filelist;
	&createc;
}

sub createc {  

# Creates or appends to a chat room

	$fname = sprintf("%s/chat%s", $file_dir,$room);
	$fname =~ /^([-.\w]+)$/;

	if (-e "$fname") {
	   open(MAIN,"$fname");
	   flock MAIN, 2;
	   @main = <MAIN>;
	   close(MAIN);

	   if ($main[0] =~ /\<!-s-\>/) {
		foreach $main_line (@main) {
               ($s,$entry,$s) = split(/:/,$main_line);

               if ($main_line =~ /\<!-s-\>/) {
                  push (@main_new, "<!-:$time:-><!-s->\n");
               }
               elsif ($time - $entry > $chat_time) {
               }
               else {
                  push (@main_new,"$main_line")
               }
            }
	      undef @main;
            $fname = sprintf("%s/chat%s", $file_dir,$room);
            $fname =~ /^([-.\w]+)$/;

		open(MAIN,">$fname");
		flock MAIN, 2;
		foreach $main_line(@main_new) {
		   print MAIN "$main_line";
		}
		close (MAIN);
		undef @main_new;
	   }
	   else {
		open (MAIN,">$fname");           # file exists but doesn't start with <begin>
		flock MAIN, 2;
		print MAIN "<!-:$time:-><!-s->\n";
		print MAIN "<!-:$time:-><!--:GorBot:--><font color = #ff1010><B>GorBot:</B> RoomQuake!!</font><hr>\n";
		close (MAIN); 
		}
	   }
	   else {            # this file doesn't exist at all and must be created...
		$fname = sprintf("%s/chat%s", $file_dir,$room);
		$fname =~ /^([-.\w]+)$/;
		open (CHAT,">$fname");
		flock CHAT, 2;   
		print CHAT "<!-:$time:-><!-s->";
		close (CHAT);
	   }
	&guestfile;
}

sub guestfile {    #  Set up guest file. Fix zero-byte problem, add time and begin markers

######
  	if ($data ne "new")  {
  	   $debug = "-sub guestfile-";
	   $name = "";	
	   &get_user;
	}
######

	$vname = $name;
	$vname =~ s/ /_/g;
	$vname =~ s/\//_/g;
	$fname = sprintf("%s/%s", $vis_dir,$vname);
	$fname =~ /^([-.\w]+)$/;

	if (-e "$fname") {
	}
	else {
	   open (VFILE,">$fname");
	   flock VFILE, 2;
	   print VFILE "<!-:$time:-><!-s->\n";
	   close (VFILE)
	}
	&countviz;
}

sub countviz {
	 opendir(VFILES,$vis_dir);
	@vfilelist =  grep(!/^\.\.?$/, readdir (VFILES));
	closedir(VFILES);
	foreach $vfilelist (@vfilelist) {

	   if (-A "$vis_dir/$vfilelist" > $viz_time / 86400) {
	   	$fname = sprintf("%s/%s", $vis_dir,$vfilelist);
		$fname =~ /^([-.\w]+)$/;
		unlink("$fname");
	 	$fname = sprintf("%s/%s", $ignore_dir,$vfilelist);
		$fname =~ /^([-.\w]+)$/;
		unlink("$fname");
	   }
	}
	undef @vfilelist;
	&check_memlist;
}

sub createi {    #  Set up guest's ignore file. Called if user checks ignore box.
	&get_user;
	$vname = $name;
	$vname =~ s/ /_/g;
	$vname =~ s/\//_/g;
	$fname = sprintf("%s/%s", $ignore_dir,$vname);
	$fname =~ /^([-.\w]+)$/;
	open(IFILE,">>$fname") || die "Can't Open User ignore list: $!\n";
	flock IFILE, 2;
	print IFILE "$user\n";
	close (IFILE);

	# Let the Bot report ignore notice into user's PM file
	$fname = sprintf("%s/%s", $vis_dir,$vname);
	$fname =~ /^([-.\w]+)$/;

	open (VFILE,"$fname") || die $!; 
	flock VFILE, 2;    
	@vfile = <VFILE>;
	close (VFILE);

	foreach $vfile_line (@vfile) {
	   if ($vfile_line =~ /\<!-s-\>/) {
		push (@vfile_new,"$vfile_line","<!-:$time:-><!--:GorBot:--><img src=\"$whisp\"> from <b>GorBot </b> $date CST<BR> You have set <b>$user</b> to be ignored. This condition will last until you log out.</font><HR>\n");
	   }
	   else {

		push (@vfile_new,"$vfile_line");
	   }
	}
	undef @vfile;

	open(VFILE,">$fname") || die $!;
	flock VFILE, 2;
	foreach $vfile_line(@vfile_new) {
         print VFILE "$vfile_line";
	}
	close(VFILE);
	undef @vfile_new;
}


##### manually remove old Whispers. #

sub delete_old  { 
	$vname = $name;
	$vname =~ s/ /_/g;
	$vname =~ s/\//_/g;
	$fname = sprintf("%s/%s", $vis_dir,$vname);
	$fname =~ /^([-.\w]+)$/;
	unlink("$fname");

	$fname = sprintf("%s/%s", $ignore_dir,$vname);
	$fname =~ /^([-.\w]+)$/;
	unlink("$fname");
	&create;
	&countviz;
}

#########
# Refresh $message before reload
sub freshen {
	$mess = $message;
}


sub chop_msglen {
	my $strlength = length($message);
	if ($strlength > 5000)  {
	   my $scratch = substr($message, 1, 5000);
	   $message = $scratch;
	}
}

# Get the Date For Logging Purposes 
sub log_hit {
 
	$epoch = time();

	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($epoch);
	$year00 = $year + 1900;  # y2K fix

	if ($sec < 10)  { $sec = "0$sec";   }
	if ($min < 10)  { $min = "0$min";   }
	if ($hour < 10) { $hour = "0$hour"; }
	if ($mday < 10) { $mday = "0$mday"; }
	$mon++;
	if ($mon < 10)  { $monc = "0$mon";  }
	$stardate = "$hour\:$min\:$sec $mon/$mday/$year00";

	open(LOG,">>$log_dir/.mcensus.txt") || die "Can't Open gor Member Access Log: $!\n";
	flock LOG, 2;
	print LOG "[$stardate] $name - $ra - $ENV{'HTTP_USER_AGENT'}\n";
	close(LOG);
}


############
sub check_membership {
$iter = 0;
$listed_name = "";
$mname = "";

	if (($passwd eq "123") || ($passwd eq "")) {
	   $etype = 0;
	   &error_out;
	}

	else {
         $mname = $name;
         $mname =~ s/ /_/g;
         $mname =~ s/\//_/g;

	   open(MFILE,"$mem_dir/.combined");
	   flock MFILE, 2;
	   @mfile = <MFILE>;
	   close(MFILE);

	   foreach $mfile_line(@mfile)  {
		$password = "";
		($f1,$listed_name,$f2,$test,$f3,$f4) = split(/:/,@mfile[$iter]);
         
		if ($mname eq $listed_name)  {
		   $password = crypt($passwd,PC);


		if ($password eq $test) {
		   $is_member = 1;  # if name exists in member files AND pass matches
               $iter++;
               $member_name = $mfile[$iter];
	         last;
            } 
		else {
		   $etype = 0;
               &error_out;

		   # if name exists but password doesn't match
            }
	   } 
	   $iter++; 

	   } # end foreach
	}
}




############
sub check_memlist {

	$iter = 0;
	$is_member = 0;     # refresh these four...
	$member_name = 0;
	$listed_name = "";

	if($data ne "new" && $data ne "0") {
	   $debug = "- check_memlist, data = $data -";
	   $name = "";
	   &get_user;
	}

	$mname = $name;
	$mname =~ s/ /_/g;
	$mname =~ s/\//_/g;

	open(MFILE,"$mem_dir/.combined");
	flock MFILE, 2;
	@mfile = <MFILE>;

	close(MFILE);
      
	foreach $mfile_line(@mfile)  {
	   ($b0,$listed_name,$b1,$test,$b2) = split(/:/,@mfile[$iter]);
         
	   if ($mname eq $listed_name)  {
		$iter +=1;
		$is_member = 1;  # if name exists in member files
		$member_name = $mfile[$iter];	# Get member's html
		chomp($member_name);
	      $member_name =~ s/mgif/\/www.poolsidechat.com\/mgif/ig;   #grab member data from outside this domain...
		last;
		}
		$iter++;
	   }
}


######################
# check slow

sub check_slow
{
	if ($use_slow == 1)  {
	   open(SLOWFILE,"$excl_dir/sfile.txt");
	   flock SLOWFILE, 2;
	   @slow = <SLOWFILE>;
	   close(SLOWFILE);

	   foreach $slow_line(@slow) {
		chomp($slow_line);
		chomp($name);
		if ($slow_line =~ /$name/ig)  {
		   print "Location: $zoom_link\n\n";
		   sleep(19);
              last;
		}
	   }
	}
}

######################
# Check Exclusion file 

sub check_exclusion  {

$aol1 = "172.";   
$aol2 = "64.12.";  
$aol3 = "198.8"; 
$aol4 = "152.163.188."; 
   
      $isnumeric=0;
      $ra = $ENV{'REMOTE_ADDR'};

	# Official WebTV bad boy addresses
	if($ra eq "209.240.198.60" || $ra eq "209.240.220.61") {
	   $etype = 4; # 
	   &error_out;
	}

	# Note the 207.254 IP is Dak
	if(($ra =~ /^207.254.18./)) {
	   $etype = 3; #
	   &error_out;

	}
      $test_remote = $ra;
      $test_remote =~ tr/0123456789-//d; 

      open(EXFILE,"$excl_dir/xfile.txt") || die $!;
      flock EXEFILE, 2;
      @exclusion = <EXFILE>;
      close(EXFILE);
      $lamer = substr($ra,0,10);

         foreach $ex_line(@exclusion) {

            chomp($ex_line); 
            $host_list = substr($ex_line,0,10);
            if($lamer eq $host_list)  {
		   $etype =3;    # fake 500 error

		   &error_out;   #
            }
         }  # end of foreach  
}

# ##########################    get member's config file.
sub read_cfg   {
my @cfg = "";

	   $vname = $name;
	   $vname =~ s/ /_/g;
	   $vname =~ s/\//_/g;

	   if (-e "$cfg_dir/$vname") {
		open(CFG,"$cfg_dir/$vname"); 
	      @cfg = <CFG>;
   	      close(CFG);
		chomp(@cfg[0]);
		($null,$back_color,$text_color,$font_color,$font_size,$bold,$italic,$tc,$tag,$img) = split(/:/,@cfg[0]);
	   }
}



# HTML PAGES ############

sub login {
	&remove_epoch;		# the next guy logging in will help maintain files
	$ra = $ENV{'REMOTE_ADDR'};
      $rg = $ENV{'HTTP_USER_AGENT'};

#      if($rg =~ "compatible; MSIE 5.5; Windows 98; Win 9x 4.90; SNET OLR v5.0") {
#	   print "Location $bye_link\n\n";
#	}
#      if($rg =~ "compatible; MSIE 5.5; AOL 7.0; Windows 98; Win 9x 4.90; SNET OLR v5.0") {
#	   print "Location $bye_link\n\n";
#	}

	opendir(VFILES,$vis_dir);
	@vfilelist =  grep(!/^\.\.?$/, readdir (VFILES));
	closedir(VFILES);

	$gate =~ s/ /_/g;
	$gate =~ s/\//_/g;

	$fname = sprintf("%s/vis%s", $file_dir,$gate);
	$fname =~ /^([-.\w]+)$/;

	open (VISITORS,"$fname");
	flock VISITORS, 2;
	@visitors = <VISITORS>;
	close (VISITORS);

	foreach $visitors_line (@visitors) {

	   ($b0,$load,$b1) = split(/:/,$visitors_line);
         if ($visitors_line =~ /\<!-s-\>/) {
		push (@visitors_new,"<!-:$time:-><!-s-> $ra\n");
	   }
         elsif ($time - $load > $viz_time) {
         }
         else {
		push (@visitors_new,"$visitors_line");
         }
	}
	undef @visitors;
	open(VISITORS,">$fname");
	flock VISITORS, 2;
	foreach $visitors_line(@visitors_new) {
         print VISITORS "$visitors_line";
	}
	close (VISITORS);
	$vnum=@visitors_new;
	$vnum=$vnum - 1;
	undef @visitors_new;

     $bye = 100;

	print "Content-type: text/html\n\n";
	my $bgd = "http://www.gorean-shores.com/graphics/back12.jpg";

	print "<html><head><title>Gorean Shores</title></head>\n";

print << "EOD2";  # print till End of Data

<html><head><title>Gorean Shores</title></head>
<body bgcolor="87CEEB" background="$bgd" text="wheat" link="$link_color" vlink="$vlink_color">
<P>&nbsp;</P><center><img src=\"$logo_gif\"><BR><BR>
  
<form method=POST action="$script_name">
<input type=hidden name="data" value="new">
<input type=hidden name="epoch" value="$epoch">
<input type=hidden name="bye" value="$bye">
<input type=hidden name="time" value="$time">
<input type=hidden name="room" value="Courtyard">
<font face="Helvetica,Ariel">

<table border=0 width=60%>
<tr><td align=center><font size=4><B>- REGISTERED MEMBER ACCESS ONLY -</B><BR></font></td></tr>

<tr><td align=center bgcolor=202020>Are you looking for the FREE Guest login page?  <BR> <a href="/tavern/gsguest.cgi">GUESTS CLICK HERE</a></td></tr>

<tr><td align=center><font size=1>TERMS of USE -  <i>This site is for adults only</i>.  ANY direct form of or <i>realistic depiction</i> of illegal activity such as Child Pornography, Incest, Racial Harassment, Beastiality, Snuff or public Toilet sex are NOT tolerated. <a href="/gssub/aup.html"><br><center>You must read the Appropriate Usage Policy before entering this chat.</center></a> 
By clicking the ENTER CHAT button, you are certifying that you are the legal age of adult consent in your place of residence and that you agree to these terms.</td></tr>

</font>

<tr><td align=center><B>Username - </B><input type=text size=18 name=\"name\" maxlength=25>   &nbsp;&nbsp; &nbsp;
<B>Password - </B><input type=password name=\"passwd\" size=18></td></tr>

<tr><td align=center><input type=submit value=\"$enter_chat\"></td></tr>
</td></tr></table><br>
<font size=3 face=\"helvetica\"><i> Welcome to Gorean Shores of Port Kar! </i><BR><BR>
<BR> <a href="/tavern/gsguest.cgi">GUESTS CLICK HERE</a><BR>

</font></CENTER></BODY></HTML>
EOD2
}

###########

# Error Output pages

sub user_gone  {
	$etype = 2;
	&error_out;
}

sub error_out {

	if($etype == 0)  {  # Name-Pass Error
   	   print "Content-type: text/html\n\n";
     	   print "<html><head><title>Sorry</title></head>\n";
   	   print "<body bgcolor=\"c2c2c2\" background=\"/graphics/back12.jpg\" text=\"slategray\">\n";
	
   	   print "<center><H2>Oops!</H2>\n";
   	   print "<TABLE width=\"70%\"><TR><TD><font face=\"Helvetica\">\n";
   	   print "<B>You have entered an invalid Member/Password combination.</B><BR><BR>\n";
   	   print "<B>If you are a Guest visitor, please <a href =\"/tavern/gsguest.cgi\">CLICK HERE</a> for free access to Gorean Shores Tavern.<BR><BR></B>\n";

   	   print "<B>Otherwise, please hit your browsers BACK button and try again. </B><P><BR></P>\n";
   	   print "<BR><BR>Info - EMAIL <a href =\"mailto:webmaster\@gorean-shores.com\">webmaster\@gorean-shores.com</a>\n";
     	   print "</TD></TR></TABLE>\n";
   	   print "</body></html>\n";
	}

	elsif($etype == 1)  {  # Name-Pass Error
   	   print "Content-type: text/html\n\n";
     	   print "<html><head><title>Oops</title></head>\n";
   	   print "<body bgcolor=\"c2c2c2\" background=\"/graphics/back12.jpg\" text=\"slategray\">\n";
	
   	   print "<center><H2>Oops!</H2>\n";
   	   print "<TABLE width=\"70%\"><TR><TD><font face=\"Helvetica\">\n";
   	   print "<B>Either there is something wrong with the name you selected, it is already in use, or you did not correctly enter a password.</B>\n";  


   	   print "<B>Please Hit your Browsers BACK button and try again. </B><P><BR></P>\n";
   	   print " <BR><BR>Info - EMAIL <a href =\"mailto:webmaster\@gorean-shores.com\">webmaster\@gorean-shores.com</a>\n";
     	   print " </TD></TR></TABLE>\n";
   	   print "</body></html>\n";
	}
	elsif ($etype == 2) {  # user has left
	   print "Content-type: text/html\n\n";
   	   print "<html><head><title>User has Gone</title></head>\n";
   	   print "<body bgcolor=\"c2c2c2\" background=\"/graphics/back12.jpg\" text=\"slategray\">\n";
   	   print "<H2>Too late </h2>\n";
   	   print "<H3>The person you've sent a whisper to has already left the chat</h3>\n";  
   	   print "<H3>Please Hit your Browsers BACK button and click Return. </h3>\n";

   	   print "</body></html>\n";
	}
	elsif ($etype == 3) {  #  Fake 500 page
   	   print "Content-type: text/html\n\n";
   	   print "<html><head><title>500 Internal Server Error</title></head>\n";
   	   print "<body><H1>Internal Server Error</H1>\n";

    	   print "The server encountered an internal error or misconfiguration and was unable to complete your request.<BR>\n";
   	   print "Please contact the server administrator, Webmaster\@gorean-shores.com and inform them of the time the error occurred <BR>\n";
   	   print " and anything you might have done that may have caused the error.\n";
           print "</body></html>\n";
	}

	elsif ($etype == 4) {  #  Warning Screen
   	   print "Content-type: text/html\n\n";
   	   print "<html><head><title>WARNING</title></head>\n";
   	   print "<body bgcolor=RED><H1><center>WARNING</H1>\n";

    	   print "<H3>You have attempted an unauthorized access.<BR>\n";
   	   print "You IP Address has been banned from this website at the discretion of the Webmaster or Server Administrator <BR>\n";
   	   print "All access attempts are logged and further attempts to get into this website will be regarded as electronic trespass.</center></H3>\n";
	   print "</body></html>\n";
	}

	elsif ($etype == 5) {  #  Anon Services
   	   print "Content-type: text/html\n\n";
   	   print "<html><head><title>WARNING</title></head>\n";
   	   print "<body bgcolor=RED><H1><center>WARNING</H1>\n";

   	   print "<H3>You have attempted an unauthorized access.<BR>\n";
   	   print "Anonomous IP or Proxy services are not permitted at this website<BR>\n";
   	   print "</body></html>\n";
	}

	elsif ($etype == 6) {  #  General error

   	   print "Content-type: text/html\n\n";

   	   print "<html><head><title>General Error</title></head>\n";
   	   print "<body bgcolor = gray><H1><center>Oops</H1>\n";
   	   print "<H3>It looks like you've become lost!<BR><BR>\n";
   	   print "<H4><BR>Sometimes finding your way means going back to the begining.</H4> <BR>\n";
   	   print "<a href =\"/tavern/gsmember.cgi\">Click Here</a> to go that way.<BR><BR></B>\n";
   	   print "</body></html>\n";
	}
   exit;
}

###########
# Register
sub register {

	$login = "$date";
	$ra = $ENV{'REMOTE_ADDR'};   
	open (VISITORS,"$file_dir/vis$room") || die $!;
	flock VISITORS, 2;
	@visitors = <VISITORS>;
	close (VISITORS);

	foreach $visitors_line (@visitors) {
	   if ($visitors_line =~ /<!-$name->/) {
	   }
	   elsif ($visitors_line =~ /\<!-s-\>/) {
		push (@visitors_new,"<!-:$time:-><!-s->\n");
		push (@visitors_new,"<!-:$time:-><!-$name-> $member_name\n");
	   }  

	   else {
	      push (@visitors_new,"$visitors_line");
	   }
	}
	undef @visitors;

	$fname = sprintf("%s/vis%s", $file_dir,$room);
	$fname =~ /^([-.\w]+)$/;
	open(VISITORS,">$fname") || die $!;
	flock VISITORS, 2;
	foreach $visitors_line(@visitors_new) {
	   print VISITORS "$visitors_line";
	}
	close(VISITORS);
	undef @visitors_new;

	$name_color = $text_color;

	$vname = $name;
	$vname =~ s/ /_/g;
	$vname =~ s/\//_/g;
	open(VFILE,"$vis_dir/$vname");
	flock VFILE, 2;
	@vfile = <VFILE>;
	close(VFILE);

	foreach $vfile_line (@vfile) {
	   if ($vfile_line =~ /\<!-s-\>/  && $room ne "Courtyard") {
		push (@vfile_new,"$vfile[0]","<!-:$time:->\n");
	   }

	   else {

		push (@vfile_new,"$vfile_line");
	   }
	}

	undef @vfile;
	$fname = sprintf("%s/%s", $vis_dir,$vname);
	$fname =~ /^([-.\w]+)$/;
	open(VFILE,">$fname");
	flock VFILE, 2;
	foreach $vfile_line(@vfile_new) {
	   print VFILE "$vfile_line";
	}
	close (VFILE);
	undef @vfile_new;

	open(MAIN,"$file_dir/chat$room") || die $!;
	flock MAIN, 2;
	@main = <MAIN>;
	close(MAIN);

	foreach $main_line (@main) {
	   if ($main_line =~ /\<!-s-\>/) {
	     ###  $member_name =~ s/mgif/\/www.poolsidechat.com\/mgif/ig;   #grab member data from outside this domain...
		push (@main_new,"<!-:$time:-><!-s->\n","<!-:$time:->$member_name <font size=4 color=$tc>$tag</font> has joined the chat at $date CST <HR>\n");
	   }
	   else {
		push (@main_new,"$main_line");
	   }
	}
	$fname = sprintf("%s/chat%s", $file_dir,$room);
	open(MAIN,">$fname") || die $!;
	flock MAIN, 2;
	foreach $main_line(@main_new) {
	   print MAIN "$main_line";
	}
	close(MAIN);
}

##########
# Update Visitor's log

sub update {
	$fname = sprintf("%s/vis%s", $file_dir,$room);
	$fname =~ /^([-.\w]+)$/;
	open (VISITORS,"$fname") || die $!;
	flock VISITORS, 2;
	@visitors = <VISITORS>;
	close (VISITORS);

	foreach $visitors_line (@visitors) {
	   if ($visitors_line =~ /<!-$name->/) {
	   }
	   elsif ($visitors_line =~ /\<!-s-\>/) {
		push (@visitors_new,"<!-:$time:-><!-s->\n");
	      ### $member_name =~ s/mgif/\/www.poolsidechat.com\/mgif/ig;   # grab member data from outside this domain...
		push (@visitors_new,"<!-:$time:-><!-$name->$member_name\n");
	   }
	   else {
	      push (@visitors_new,"$visitors_line");
	   }
	}
	$fname = sprintf("%s/vis%s", $file_dir,$room);
	$fname =~ /^([-.\w]+)$/;
	open(VISITORS,">$fname") || die $!;
	flock VISITORS, 2;

	foreach $visitors_line(@visitors_new) {
         print VISITORS "$visitors_line";
	}
	close(VISITORS);
	undef @visitors_new;
}






############################################################

# Post message:  Modify chat page for this room.  
############################################################
sub post {

	$ra = $ENV{'REMOTE_ADDR'};

	$debug = "post";
	&get_user;

  	$vname = $name;
  	$vname =~ s/ /_/g;

	$vname =~ s/\//_/g;

	if ($message ne "") {

	   open(MAIN,"$file_dir/chat$room") || die $!;
         flock MAIN, 2;
         @main = <MAIN>;
         close(MAIN);

         $name_color = $text_color;

         if($font_color eq "default")  {
		$font_color = $text_color;
	   }
	   if($font_size eq "default")  {
	   $font_size = 3;
	}
      my $bo;
      my $it;
      if($bold eq "on")  { $bo = "\<B\>";  }
      if($italic eq "on")  { $it = "\<I\>";  }

      foreach $main_line (@main) {
         if ($main_line =~ /\<!-s-\>/) {
	   	push (@main_new,"<!-:$time:-><!-s->\n","<!-:$time:-><!--:$vname:--> $member_name <font size=4 color=$tc>$tag</font> <font size=1> $date CST</font><BR><font color=\"$font_color\" size=\"$font_size\">$bo$it$message</i></b></a></font></font></center><HR>\n");
         }
         else {
                push (@main_new,"$main_line");
            }
      }  # end foreach

	$fname = sprintf("%s/chat%s", $file_dir,$room);
      $fname =~ /^([-.\w]+)$/;
      open(MAIN,">$fname") || die $!;
      flock MAIN, 2;
      foreach $main_line(@main_new) {
         print MAIN "$main_line";
      }
      close(MAIN);
      undef @main_new;
      $message =" ";  # For WebTV and MSIE users. NULL posts make them puke.
   }
}

#######################################################
# Reload ##############################################
sub reload {

	if ($data ne "new")  {
  	   $debug = "-reload-";
	   $name = "";	
	   &get_user;
	}
	&read_cfg;

	$vname = $name;
	$vname =~ s/ /_/g;

	my $nimfo = $name."&".$epoch;  # We'll need this security string for console operations.

	######### Major fork in program logic

	if ($room eq "Courtyard") { 

         &courtyard_main;
	}
	else  {
	   &get_epoch;
	   &check_exclusion;
	   &check_slow;

	   if ($room eq "The_Tavern") {    
		$background = "../graphics/back12.jpg";
		if($text_color eq "default")  { $text_color = "cyan";  }
		if($back_color eq "default")  { $bgcolor = "navy";     }
	   }
	   elsif ($room eq "Slave_Kennels") {
		$background = "../graphics/silkpurple.jpg";
		if($text_color eq "default")  {  $text_color = "a2a2a2"; }
		if($back_color eq "default")  {  $bgcolor = "FFDAB9";    }
	   }   
	   elsif ($room eq "Training_Yard") {
		$background = "../graphics/trainingyard.gif";
		if($text_color eq "default")  {  $text_color = "wheat";  }
		if($back_color eq "default")  {  $bgcolor = "green";     }
	   }   
	   elsif ($room eq "Piazza") {
		$background = "../graphics/piazza.jpg";
		if($text_color eq "default")  {  $text_color = "C0C0C0";  }
		if($back_color eq "default")  {  $bgcolor="66CDAA";       }
	   }   
	   elsif ($room eq "Market_Bazaar") {
		$background = "../graphics/gs_cobbles.jpg";
		if($text_color eq "default")  {  $text_color = "f0f0f0";  }
		if($back_color eq "default")  {  $bgcolor = "gray";     }
	   }   
	   elsif ($room eq "Forum") {
		$background = "../graphics/back17.jpg";
		if($text_color eq "default")  {  $text_color = "c0c0c0";  }
		if($back_color eq "default")  {  $bgcolor = "303030";     }
	   } 
	   # This must be a private room...
	   else  {   
		$background = "../graphics/proom.jpg";
		if($text_color eq "default")  { $text_color = "c1c2c3";  }
		   if($back_color eq "default")  { $bgcolor = "c1c2c3";     }    
		}

		$back_color =~ /^([-.\w]+)$/;
		$back_color =~ s/>//g;
		$back_color =~ s/<//g;

		open(MAIN,"$file_dir/chat$room") || die $!;
		flock MAIN, 2;
		@main = <MAIN>;

		close(MAIN);


		open (VISITORS,"$file_dir/vis$room") || die $!;
		flock VISITORS, 2;
		@visitors = <VISITORS>;
		close (VISITORS);

		opendir(VFILES,$vis_dir);
		@vfilelist =  grep(!/^\.\.?$/, readdir (VFILES));
		closedir(VFILES);





		if (-e "$ignore_dir/$vname") {
		   open (IFILE,"$ignore_dir/$vname") || die $!;
		   @ifile = <IFILE>;
		   close (IFILE);
		}

		@afilelist = @vfilelist;
		@vfilelist = sort(@afilelist);

		
		$vfcounter = 0;
		foreach $vfilelist_line (@vfilelist) {
		   if ($vfilelist_line ne "index.html") {
			@userviz[$vfcounter++] = "<option> $vfilelist_line"; 
		   }
		}
	   open (VFILE,"$vis_dir/$vname");
	   flock VFILE, 2;
	   @vfile = <VFILE>;
	   close (VFILE);

	   shift(@main);

	   shift(@vfile);
	   @unchat = @main;
	   push (@unchat,@vfile);
	   @schat = sort(@unchat);
	   @chat = reverse(@schat);

	   if($back_color eq "default") { 
		my $bgc="c1c2c3"; 
	   }

	   else  { 
		$bgc = $back_color;
	   }

	   print "Content-type: text/html\n\n";

	   print << "EOD3";

<html><head><title>$room</title>
<script language="Javascript">
function pop() {window.open("../tavern/console.cgi?name="+'$nimfo','pop','width=450,height=490,directories=no,status=YES,scrollbars=YES,resize=YES,menubar=no');}
function nfo() {window.open("../rooms/$room.html",'nfo','width=350,height=380,directories=no,status=no,scrollbars=no,resize=no,menubar=no');}

</script>
</head>
<body bgcolor="$bgc" background="$background" text="$text_color" link="$link_color" vlink="$vlink_color">
<form method=POST action=$script_name>

<input type=hidden name=viz value=$time>
<input type=hidden name=epoch value=$epoch>
<input type=hidden name=room value=$room>

<center><a href="#top"></A>

<input type=hidden name=back_color value=$back_color>
<input type=hidden name=text_color value=$text_color>
<input type=hidden name=font_color value=$font_color>
<input type=hidden name=font_size value=$font_size>
<input type=hidden name=bold value=$bold>
<input type=hidden name=italic value=$italic>
<input type=hidden name=tc value=$tc>
<input type=hidden name=tag value=$tag>
<input type=hidden name=img value=$img>
EOD3

   $troom = $room;
   $troom =~ s/_/ /g;
   $troom =~ s/\// /g;

 # begin outer table
      print "<p align = center><font size=\"2\" face = \"Helvetica\">\n";

	print "<table border=\"1\" width=\"90%\" cellpadding=\"5\" cellspacing=\"1\">\n";
	print "<TR><TD align=center>\n";
	print "<table border=\"0\" width=\"100%\">\n";
	print "<tr><td align=center><b>$name<b> in  $troom\n";   


	print "</td><td align=\"center\"><input type=checkbox name=\"wsp\">\n";
	print "<font size=1>-Whisper</font>\n";
	print "&nbsp;<select size=1 name=\"user\">@userviz</select>\n";

	print "<font size=1> Ignore-\n";
	print "<input type=checkbox name=\"ignore\"></font>\n";


	print "</td></tr></table>\n";

   # draw the edit box .. No table around it

	print "<textarea name=\"message\" ROWS=\"4\" COLS=\"60\" maxlength=2500 wrap>$mess</textarea>\n";
	print "<table width = 90% border=0>\n";

	print "<tr><td align=center><input type=submit name=\"data\" value=\"$post_reload\">  \n";

	if($img eq "on")  {
	   print "<font size=1> &nbsp;&nbsp;Images ON</font></td>\n";
	}
	else {
	   print "<font size=1> &nbsp;&nbsp;Images OFF</font></td>\n";
	}

	print "<td width=\"15%\"></td> <td align=\"center\"><input type=submit name=\"data\" value=\"$who_text\"> \n";
	print "<input type=submit name=\"data\" value=\"$delold_text\">\n";

	print "<input type=reset value=\"$clear_text\"> <input type=submit name=\"data\" value=\"$leave_text\">\n";
	print "</td></TR></table>\n";   #end lower table
	print "</TD></TR></TABLE></CENTER>\n";  #end outer table 

	print "<center><font size=\"2\" face = \"Helvetica\">\n";
	print "\| <a href=\"../gssub/help.html\">Help</a> \|\n";
	print "<a href=\"javascript:nfo()\">Room Info</a> \|\n";

	print "<a href=\"../gssub/colors.html\">HTML Colors</a> \|\n";
	print "<a href=\"http://www.poolsidechat.com/bsearch.html\">Is this Name taken?</a> \|\n";

	print "<a href=\"http://www.poolsidechat.com/newsignup.html\">Sign Up HERE</a> \|\n";
	print "<a href=\"http://www.poolsidechat.com/account-service.html\">Whats my account status?</a> \|\n";
	print "<a href=\"http://www.gorean-shores.com/phpBB2\">Corks</a> \|\n";
	print "<a href=\"javascript:pop()\">Console</a> \|\n";

	print "<BR><HR></CENTER>\n";

	print "</font></font></center></p>\n";

	if($name eq "Jed") {
 	   print "Debug=$debug_var<BR>\n";
 	 }

	#################################### 
  
	# Start outputting messages.
	my $msgs = 0;

	$numlines = "new";
      @new = @chat[(0 .. 24)];

      foreach $one_of_new (@new) {
	   if ($one_of_new eq "") {
	   }

	   else {
		$msgs += 1;
		$flag=0;        


		# Username is the 4th field of ALL chats including whispers.
         
		($x1,$mes_time,$x2,$user,$x3,$x4) = split(/:/,$one_of_new);
		chomp($user);

		foreach $ignore_line (@ifile)  {           # entering ignore loop
		   chomp($ignore_line);
		   if($user =~ /$ignore_line/)  {
			$flag = 1; 
		   }
		}
		if ($flag == 1)  {
		}
		else   {
		   print "$one_of_new";
		$flag = 0; 
		}
	   }
	} 

	print "<BR>\n";

	##### Begin Room change controls
	print "<font size=\"2\" face = \"Helvetica\">\n";
	print "<CENTER><TABLE ALIGN=CENTER WIDTH = \"70%\"><TD ALIGN=CENTER><h3>Change Public Rooms</h3></TD><TD ALIGN=CENTER><H3>Create A Private Room<H3></TD></TR>\n";

	print "<TR><TD ALIGN=CENTER><select size=1 name=\"public\">$member_rooms</select></TD><TD ALIGN=CENTER><input type=text size=18 name=\"private\"></TD></TR>\n";

	print "<TR><TD ALIGN=CENTER><input type=submit name=\"data\" value=\"$enter_button\"></TD><TD ALIGN=CENTER><input type=submit name=\"data\" value=\"$enter_button\"></TD></TR>\n";
	print "</TABLE><HR></center>\n";

	########## Begin room visitors list


	print "<CENTER><b>This Room's Visitors</b><BR>\n";
	print "<TABLE BORDER=2 WIDTH=40% >\n";
	print "<TR ALIGN=CENTER VALIGN=CENTER>\n";

	foreach $vlist_line (@visitors) {

	   if ($vlist_line ne "index.html") {
		print "<tr><td><b>$vlist_line</b></td></tr>\n";
	   }
	}
	print "</table><BR>\n";
	print "<BR><center><input type=submit name=\"data\" value=\"$post_reload\"> </center> \n";
	print "<BR></form>\n"; 

	## Room-specific footers


	&write_tail;


	print "<BR>\n";

	print "<a href=\"http://www.gorean-shores.com/phpBB2\" target=\"new\"> NEW Gorean Shores Message Corks </A><P><BR></P>\n";
	print "<a href=\"http://www.binaryfarm.com\"><img src=\"../graphics/bflogo-sm.gif\" border=\"0\"></A>\n";
      print "<BR><font size=2>(C) 1996 - 2005 Binary Farm<P> </body> </html>\n";
	} # end if $room eq Courtyard  
}


###### Courtyard (GateHouse) #############################

sub courtyard_main  {

	my $ip = $ENV{'REMOTE_ADDR'};					
	$name =~ s/ /_/g;							# Start an epoch file on him. 
	$name =~ s/\//_/g;

	$filename = sprintf("%s/%s", $data_dir,$epoch);

	if (-e "$filename") {		# File should NOT exist yet
	   $etype = 2;
	   &error_out;  
	}
	else {	

 	   open (DFILE,">$filename")|| die "Can't create new epoch file $!\n";

	   flock DFILE, 2;
	   print DFILE "$name\n$ip";    # print out the file...
	   close (DFILE)
	}
    
	&read_cfg;

	my $bgd = "http://www.gorean-shores.com/graphics/back13.jpg";
	$title_gif = "http://www.gorean-shores.com/graphics/pchat.gif";

	print "Content-type: text/html\n\n";
	print "<html><head>\n";
	
	print "<title>Courtyard</title></head>\n";


	print "<body bgcolor=\"87CEEB\" background=\"$bgd\" text=\"$text_color\" link=\"yellow\" vlink=\"$vlink_color\">\n";

	print "<form method=POST action=\"$script_name\">\n";

	print "<input type=hidden name=\"epoch\" value=\"$epoch\">\n";
	print "<input type=hidden name=\"name\" value=\"$name\">\n";
	print "<input type=hidden name=\"room\" value=\"$room\">\n";
	print "<input type=hidden name=\"viz\" value=\"$time\">\n";
	print "<input type=hidden name=\"tc\" value=\"$tc\">\n";
	print "<input type=hidden name=\"tag\" value=\"$tag\">\n";
	print "<input type=hidden name=\"img\" value=\"$img\">\n";
	print "<center><table width = \"60%\">\n";   

	print "<font face = \"Helvetica\">\n"; 
	print "<tr><td align = \"left\"><B>$name</B> - You are currently in the <font color=red><B>Courtyard</B></font>\n";
	print "<td align=\"center\">&nbsp;&nbsp;&nbsp;<input type=submit name=\"data\" value=\"$who_text\"></td></tr>\n";  
	print "</table></center>\n";

	print "<blockquote><P></p>\n";

	print "<table border=1  cellpadding=5 width = \"85%\"><tr><td>\n";

	print "<table border=0>\n";
	print "<tr><td align=\"center\" ><b>Select a Public Room</b></td></tr>\n";

	print "<tr><td align=\"center\"><select size=12 name=\"public\">$member_rooms</select></td></tr>\n";
	print "<tr><td align=\"center\"><b>Or a Private Room</b><BR>\n";

	print "<center><input type=text size=14 name=\"private\"></center></td></tr>\n";
   

   	print "<tr><td align=\"center\"><input type=submit name=\"data\" value=\"$enter_button\"></td></tr>\n";
	print "</table>\n";

###############
      print "<td bgcolor=\"wheat\"><font color=\"navy\">\n";

	# print " <img src=\"/graphics/news.gif\">\n";

	print "<P><BR><font size=2>You have entered a Gorean themed series of rooms. The activities you see portrayed here are not always polite and can be rather harsh at times. It is best you choose which room you enter wisely. For more detailed information, please see the homepage. <BR><i>All collars honored.</i>


<ul>
<li>Tavern- This tavern, Gorean Shores, is located in the city of Port Kar. It is a wild and, at times, dangerous place to be. Free Women and barenecked slaves enter at your own discretion. Kill/Capture Zone</li>

<li>Piazza- Located outside the tavern, a much more relaxed atmosphere with a covered awning and tables. Acceptable for Free Women and those wishing to
learn and avoid forced collars. Not a Kill/Capture Zone</li>
<li>Training Yard- also located outside the Tavern, this walled in area serves as a place for men to practice at weapons and even catching slaves. Slaves may also use the area to practice dances if it is not in use. Kill/Capture Zone</li>


<li>Bath House- attached to the main building, a place for men to relax and enjoythe attention of slaves. Free Women are welcome to enter, but they will leave as slaves. Kill/Capture Zone</li>


<li>Slave Kennels- located off the main tavern, this is a private area for slaves to learn and ready themselves for serving in the tavern. Only slaves and Council members allowed unless you are specifically invited. Not a Kill/Capture Zone, however, unless a free woman is a member of the caste of Physicians there on business, all other free women found there will be assumed to be searching for a collar. In the event of a raid, all slaves in this room are safe.</li>


<li>Forum- A public room dedicated to the discussion of Gorean lifestyle issues. Not a Kill/Capture Zone.</li>

</ul></font><BR> \n";
	print " <br>Welcome to Gorean Shores!</p>\n";
	print "</td>\n";


	print "</td></tr></table><P>\n";
	print "</blockquote></form>\n";
	print "<CENTER><br><a href=\"http://www.goreanforum.com/top/in.php?site=1061424731\" target=\"_blank\"><img src=\"../graphics/88logo.gif\" alt=\"Enter to GoreanForum - The Top 100 Sites and Vote for this Site!\" border=0></a><BR></P>\n";

	&write_tail;
}

sub write_tail  {

	print "<CENTER><FONT FACE=\"Helvetica\" SIZE=\"2\">\n";
	print "<a href=\"http://www.gorean-shores.com/gorhome/homepage.html\" target=\"new\"><img src=\"http://www.gorean-shores.com/graphics/gsbanner.jpg\" border=\"0\"></A><P><BR></P>\n";
	print "\n";
	print "<a href=\"$regpage_link\"> Register NOW!</a> \|\n";
	print "<a href=\"$help_link\"> Help</a> \|\n";
	print "<a href=\"$time_link\"> Time Convertor</a> \|\n";

	print "<a href=\"$sub_link\"> GS SUB</a> \|\n";
	print "<a href=\"$color_link\"> Font School</a> \|\n";
	print "<a href=\"$accounts_link\"> Account Services</a> \|\n";

	print "<a href=\"#top\">Top</a>\n";
	print "</FONT></CENTER>\n";
} 

########################
#  Who's here

sub whos_here  {
	print "Location: $who_link\n\n";
	return;
}

##############
# Change rooms
sub change {

$text_color = "default";
$font_color="default";

	&get_user;
	$viz = "0";
	open(MAIN,"$file_dir/chat$oldroom") || die $!;
	flock MAIN, 2;
	@main = <MAIN>;
	close(MAIN);



	foreach $main_line (@main) {
	   if ($main_line =~ /\<!-s-\>/) {
		push (@main_new,"<!-:$time:-><!-s->\n","<!-:$time:-><b>$name</b> has left the room at $date CST<BR><hr>\n");
	   }

	   else {
		push (@main_new,"$main_line");
	   }
	}
	$fname = sprintf("%s/chat%s", $file_dir,$oldroom);
	open(MAIN,">$fname") || die $!;


	flock MAIN, 2;
	foreach $main_line(@main_new) {
	   print MAIN "$main_line";
	}
	close(MAIN);
	undef @main_new;

	open (VISITORS,"$file_dir/vis$oldroom") || die $!;
	flock VISITORS, 2;
	@visitors = <VISITORS>;
	close (VISITORS);

	foreach $visitors_line (@visitors) {
	   if ($visitors_line =~ /<!-$name->/) {

	   }
	   else {
		push (@visitors_new,"$visitors_line");
	   }
	}
	$fname = sprintf("%s/vis%s", $file_dir,$oldroom);
	open(VISITORS,">$fname") || die $!;
	flock VISITORS, 2;
	foreach $visitors_line(@visitors_new) {
	   print VISITORS "$visitors_line";
	}
	close(VISITORS);
	undef @visitors_new;

}

##############
# Send a whisper

# The outgoing message is buffered in "$message".  
# Determine if the recipient's PM file still exists.
# Write to their file.
# Update the Sender's file, assuming IT still exists.. Return error page if not.

sub privmsg {
	&get_user;
	$ra = $ENV{'REMOTE_ADDR'};
	&check_memlist;

	$fname = sprintf("%s/%s", $vis_dir,$user);
	open (VFILE,"$fname") || &user_gone;

	flock VFILE, 2;

	@vfile = <VFILE>;
	close (VFILE);



	if ($message ne "") {
	#   &run_filter;

	   foreach $vfile_line (@vfile) {
		if ($vfile_line =~ /\<!-s-\>/) {
		   push (@vfile_new,"$vfile_line","<!-:$time:-><!-:$name:-><font color=$wcolor><img src=\"$whisp\"> from <b>$name</b><BR> $message</i></b></a></blink></font></font></font></center></center><hr>\n");

		}
		else {
               push (@vfile_new,"$vfile_line");
		}
	   }

	   $fname = sprintf("%s/%s", $vis_dir,$user);
	   open(VFILE,">$fname");
	   flock VFILE, 2;

	   foreach $vfile_line(@vfile_new) {
		print VFILE "$vfile_line";
	   }
	   close(VFILE);
	   undef @vfile_new;
	}

	$vname = $name;
	$vname =~ s/ /_/g;
	$vname =~ s/\//_/g;

	$fname = sprintf("%s/%s", $vis_dir,$vname);
	open (VFILE,"$fname") || die $!;
	flock VFILE, 2;
	@vfile = <VFILE>;
	close (VFILE);

	if ($message ne "") {
	   foreach $vfile_line (@vfile) {
		if ($vfile_line =~ /\<!-s-\>/) {
		push (@vfile_new,"$vfile_line","<!-:$time:-><!-:$name:-><font color=#3333ff><img src=\"$whisp\"> <b>To $user</b> $date CST<BR>$message</i></b></a></blink></font></font></font><hr>\n");
	   }
         else {
		push (@vfile_new,"$vfile_line");
         }
      }
	$fname = sprintf("%s/%s", $vis_dir,$vname);
      open(VFILE,">$fname") || die $!;

      flock VFILE, 2;

      foreach $vfile_line(@vfile_new) {
	   print VFILE "$vfile_line";
      }
	close(VFILE);
	undef @vfile_new;
	}
}

###############
# Leave
sub leave {
	&get_user;
	$fname = sprintf("%s/chat%s", $file_dir,$room);
	open(MAIN,"$fname") || die $!;
	flock MAIN, 2;
	@main = <MAIN>;
	close(MAIN);

	foreach $main_line (@main) {
	   if ($main_line =~ /\<!-s-\>/) {
		push (@main_new,"<!-:$time:-><!-s->\n","<!-:$time:-><b>$name</b> $poof_message has left at $date CST<BR><hr>\n");
	   }
         else {
		push (@main_new,"$main_line");
	   }
	}
	$fname = sprintf("%s/chat%s", $file_dir,$room);
	open(MAIN,">$fname") || die $!;
	flock MAIN, 2;

	foreach $main_line(@main_new) {
	   print MAIN "$main_line";
	}
	close(MAIN);
	undef @main_new;

	$fname = sprintf("%s/vis%s", $file_dir,$room);
	open (VISITORS,"$fname") || die $!;
	flock VISITORS, 2;
	@visitors = <VISITORS>;
	close (VISITORS);

	foreach $visitors_line (@visitors) {
	   if ($visitors_line =~ /<!-$name->/) {
      }
	else {
	   push (@visitors_new,"$visitors_line");
	   }
	}

	$fname = sprintf("%s/vis%s", $file_dir,$room);
	open(VISITORS,">$fname") || die $!;
	flock VISITORS, 2;
	foreach $visitors_line(@visitors_new) {
	   print VISITORS "$visitors_line";
	}
	close(VISITORS);
	undef @visitors_new;
   
	print "Location: $bye_link\n\n";
	
	$vname = $name;
	$vname =~ s/ /_/g;
	$vname =~ s/\//_/g;
	$fname = sprintf("%s/%s", $vis_dir,$vname);
	unlink("$fname");
	$fname = sprintf("%s/%s", $ignore_dir,$vname);
	unlink("$fname");
	$fname = sprintf("%s/%s", $data_dir,$epoch);
	unlink("$fname");
}

sub run_filter {
	$message =~ s/w.outwar/Forbidden_link/g;
	$message =~ s/tinyurl/Forbidden_link/g;
	$message =~ s/albinoblacksheep/Forbidden_link/ig;
	$message =~ s/polychien/Forbidden_link/g;
	$message =~ s/wizardslair/Forbidden_link/g;

	$message =~ s/<body//ig;
	$message =~ s/<\/body//ig;
	$message =~ s/<html//ig;
	$message =~ s/<\/html//ig;
	$message =~ s/<div id="//ig;
	$message =~ s/<\/div//ig;

	$message =~ s/<position//ig;
	$message =~ s/style=\"position//ig;
	$message =~ s/setVariables()//ig;
	$message =~ s/file://ig;
	$message =~ s/<input type=hidden name=name value=//ig;
	$message =~ s/<input type=hidden name=room value=//ig;
	$message =~ s/<input type=submit name=data value=//ig;
	$message =~ s/<INPUT//ig;
	$message =~ s/onclick//ig; 
	$message =~ s/onload//ig;
	$message =~ s/onmove//ig;


	$message =~ s/ActiveXObject//ig; 
	$message =~ s/<hr//ig; 
	$message =~ s/<dd//ig;
	$message =~ s/()//ig;

	$message =~ s/<<//g;
	$message =~ s/<pre//ig;
	$message =~ s/<LI//ig;
	$message =~ s/<UL//ig;

	$message =~ s/<form//ig;
	$message =~ s/<texta//ig;
	$message =~ s/<\/texta//ig; 
	$message =~ s/<table//ig; 
	$message =~ s/<\/table/ /ig;
	$message =~ s/<script/ /ig;
	$message =~ s/<style/ /ig;
	$message =~ s/<OnMouse/ /ig;  
	$message =~ s/window.status/ /ig;
	$message =~ s/window.location/ /ig; 
	$message =~ s/<embed//ig;
	$message =~ s/META //ig;
	$message =~ s/HTTP-EQUIV//ig;


	$message =~ s/<MUILTICO//ig;
	$message =~ s/<SPACER//ig;

	$message =~ s/\n\n\n\n\n/ /g;
	$message =~ s/<BR>.<BR>.<BR>.//ig;
	$message =~ s/<BR><BR><BR><BR><BR>//ig;
#	$message =~ s/\n\n/<P> /ig;

	$message =~ s/\n/ <BR> /ig;

	$message =~ s/&lt;/</g;
	$message =~ s/&gt;/>/g;

	$message =~ s/&quot;/"/g;
	$message =~ s/fork //ig;
	$message =~ s/<xmp//ig;  
	$message =~ s/<nobr>//ig;
}

sub get_user  {  # Sets globals to whatever is in the user's epoch file

		$fname = sprintf("%s/%s", $data_dir,$epoch);
		$fname =~ /^([-.\w]+)$/;

		open (DFILE,"$fname") || die "Can't open user file, called from $debug $!\n";
		@dfile = <DFILE>;
		close (DFILE);

	      chomp($dfile[0]);
		chomp($dfile[1]);

		$name = $dfile[0];
		$epoch_ip = $dfile[1];
}

sub get_epoch  {
		$fname = sprintf("%s/%s", $data_dir,$epoch);
		$fname =~ /^([-.\w]+)$/;

	if (-e "$fname") {
		open (DFILE,"$fname") || die "Can't open epoch file $!\n";
		flock DFILE, 2;
		@dfile = <DFILE>;
		close (DFILE);
		$epoch_name = $dfile[0];
		$epoch_ip = $dfile[1];
	}
	else  {
		 print "Content-type: text/html\n\n";
		 printf "<html>Does not exist = $fname<br><br><br></html>\n";
		 exit(1);
	}
}

sub remove_epoch  {
	opendir(FILES,$data_dir);						# read epoch directory into @filelist
	@filelist =  grep(!/^\.\.?$/, readdir (FILES));

	closedir(FILES);

	foreach $filelist (@filelist) {
	   if (-A "$data_dir/$filelist" > $last_access / 86400) {
		$fname = sprintf("%s/%s", $data_dir,$filelist);
		$fname =~ /^([-.\w]+)$/;
		unlink("$fname");
	   }	
	}
	undef @filelist;
}