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

##################
#  Script Version 15.2 	# Added epoch-indexed visitors control. 
#  Added undefs, Replaced Flock, Case insensitive slow ban. Guest reload limit, Autoboot
##################

$epoch = 0;
$mailprog= "/usr/lib/sendmail" ;
$recipient= "webmaster\@gorean-shores.com" ;      # escape the @
$message = "";   # Main chat buffer;
$etype = 0;		# error type flag
$bye = "";
$bye_type = 0;		# Boolean
$usemail = 0;
$debug_var = 0;         # 
$debug_count = 0;       # 
$exclusion = 0;         # Flag bad IP addies
$valid_ref = "www.gorean-shores.com";   # 
$theroom = "Courtyard";
$host_list = 0;
$is_member = 0;
$use_slow = 1; 
$use_whispers = 1;

$stardate ="";
$data = 0;

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

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

$hr = "<HR>";
$top_message = "";
#############################

$file_dir = "/home/gor/public_html/axroZo"; 
$vis_dir = "/home/gor/public_html/axviZo";
$data_dir = "/home/gor/public_html/axdaZo";

$mem_dir = "/home/poolside/public_html/bdir";
$excl_dir = "/home/gor/public_html/ignore";   
$log_dir = "/home/gor/public_html/ignore";  
$ignore_dir = "/home/poolside/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";
$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";




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


$public_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{'user'}) {






	   $user = "$FORM{'user'}";
	}

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

	}



	if ($FORM{'ignore'}) {

	   $ignore = "$FORM{'ignore'}";
	}

	if ($FORM{'name'}) {
	   $name = "$FORM{'name'}";	# remove all but the following chars from namestring.
	   $_ = $name;
	   tr/a-zA-Z0-9/_/cs;		# change non-alphas to single space
	   $name = $_;
	   $name =~ s/ /_/g;
	}

	if ($FORM{'room'}) {
	   $room = "$FORM{'room'}";
	   $_ = $room;
	   tr/a-zA-Z0-9/_/cs;		# change non-alphas to single space
	   $room = $_;
	   $oldroom = $room;
	}

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

      if ($FORM{'epoch'}) {
        $epoch = $FORM{'epoch'};
      }
      if ($FORM{'bye'}) {
        $bye = $FORM{'bye'};
      }

      if ($FORM{'message'}) {
	   $message = $FORM{'message'};
	   $message =~ s/\cM//g;
  
	   $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;
	   &run_filter;
   }

	($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 ($ENV{'HTTP_REFERER'} =~ /http:\/\/([^\/]+)/) {
	   if (!($ENV{'HTTP_REFERER'} =~ /$valid_ref/)) {
		&login;
		exit;
	   }
	}

	if ($data eq "new") {
	  # sleep(1);
	   &check_memlist;
	   if($is_member == 1)  {
		$etype = 0;
	      &error_out;
	   }
	   &check_name;

	   $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.

	   &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);  
	exit;  # This is the end of the script;
}

########################
# Create files if they don't exist
sub create {
	open(INDEXA,">$file_dir/index.html");
	print INDEXA "$index_html\n";
	close(INDEXA);

	open(INDEXB,">$vis_dir/index.html");
	print INDEXB "$index_html\n";
	close(INDEXB);

	open(INDEXC,">$mem_dir/index.html");
	print INDEXC "$index_html\n";
	close(INDEXC);

	open(INDEXD,">$ignore_dir/index.html");
	print INDEXD "$index_html\n";
	close(INDEXD);

	&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> Room Quake!!</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
	$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;
}

sub createi {    #  Set up guest's ignore file. Called if user checks ignore box.
	$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 > 500)  {
	   my $scratch = substr($message, 1, 500);
	   $message = $scratch;
	  # $debug_var = 101;
	}
}



# 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/.gcensus.txt") || die "Can't Open gor Guest Access Log: $!\n";
	flock LOG, 2;
	print LOG "[$stardate] $name - $ra - $ENV{'HTTP_USER_AGENT'}\n";
	close(LOG);
}

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

sub check_exclusion  {


$aol0 = "205.188.";
$aol1 = "172.";   
$aol2 = "64.12.";  
$aol3 = "198.8"; 
$aol4 = "152.163.188."; 
   

	$isnumeric=0;


	my $ra = $ENV{'REMOTE_ADDR'};
	my $rg = $ENV{'HTTP_USER_AGENT'};

	$rg =~ s/\[//g;

	$rg =~ s/\]//g;
	$rg =~ s/\(//g;
	$rg =~ s/\)//g;	# Q's fingerprint
	if($rg =~ "Mozilla/4.0 compatible; MSIE 6.0; Windows 98; Win 9x 4.90; SNET OLR v5.0; YComp 5.0.2.6") {
	$debug_var = $rg;
	   $etype = 5; # 
	   &error_out;
	}
	if($rg =~ "C-CCK-MCD NSCPCD476") {
	   $debug_var = $rg;
	   $etype = 3; # Fake a 404 error
	   &error_out;
	}

	if($rg =~ "Mozilla/4.78 TuringOS; Turing Machine; 0.0") {
	$debug_var = $rg;
	   $etype = 3; # Fake a 404 error
	   &error_out;
	}


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

	# banned Poolies - Note the 207.254 IP is Dak, 209
	if(($ra =~ /^207.254.18./) || ($ra =~ /^209.30./) || ($ra =~ /^66.180./)) {
	   $etype = 3; #
	   &error_out;
	}

	# Q-like assholes
	if(($ra =~ /^216.120.182./) || ($ra =~ /^66.217./) || ($ra =~ /^192.128.166./) || ($ra =~ /^172.133.26/) || ($ra =~ /198.70.43./) || ($ra =~ /^62.6.122./) || ($ra =~ /^172.148.191./) || ($ra =~ /^209.104.78./) || ($ra =~ /^66.136./) || ($ra =~ /^130.94./) || ($ra =~ /^200./) || ($ra =~ /^210./)) {   
	   $etype =3;    # fake 404 error
	   &error_out;  #  Fuck 'em.
	} 

#	# Anon - Safe Proxy?
#	if(($ra =~ /^65.19./)) {   
#	   $etype = 5;  # Anon services
#	   &error_out;  # 
#	} 

	if(($ra =~ "207.44.154."))   { # ANONYMIZATIONSERVICE.COM 
	   $etype = 5; # Anons restricted
	   &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 404 error
              &error_out;   #
            }
         }  # end of foreach  
}


######################
# 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)  {

		   sleep(19);
              last;
		}
	   }
	}
}


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

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

	$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 only
	      $debug_var = $listed_name;
		chomp($member_name);
		last;
		}
		$iter++;
	   }
}

############
# Check Name	# Checks to see if a desired guest name is currently chatting

sub check_name {

	&check_exclusion;

	if(($name =~ /__/) || ($name eq "_")) {
	   $etype = 1;
	   &error_out;
	}

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

	if($vname eq "") {
	   $etype = 1;
	   &error_out;
	}

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

	foreach $vfilelist_line (@vfilelist) {
	   if ($vfilelist_line eq $vname) {
		$etype = 1;
		&error_out;
	   }
	}
	undef @vfilelist;
}


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

sub login {

	my $ra = $ENV{'REMOTE_ADDR'};
	my $rg = $ENV{'HTTP_USER_AGENT'};

	if($rg =~ " whatever bad address goes here") {
	   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;

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

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

<html><head><title>Gorean Shores</title></head>

<META HTTP-EQUIV=\"Expires\" CONTENT=\"Mon, 06 Jan 1990 00:00:01 GMT\">
<META HTTP-EQUIV=\"Pragma\" CONTENT=\"no-cache\">
<META HTTP-EQUIV=\"Cache-Control\" CONTENT=\"no-cache\">	

<body bgcolor="87CEEB" background="$bgd" text="wheat" link="yellow" 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">

<font face="Helvetica,Ariel" color="wheat">
<table width="70%"><tr><td align=center>
<font size=4><B>- FREE Guest Visitor's access -</B></font>
<tr><td align=center>Enter your username below. <i>Guest visitors do not need a password</i></td></tr>
<font size=2>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 <BR>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><BR>
<tr><td align=center>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.</P>
</font><B>Username - </B><input type=text size=18 name=\"name\" maxlength=25>  <input type=submit value=\"$enter_chat\"><BR>
</td></tr></table><br>
<font size=3 face=\"helvetica\"><i>  </i><BR><BR>

Are you looking for the Member's login page?  <BR> <a href="/tavern/gsmember.cgi">MEMBERS 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-Used 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 "Debug $debug_var\n";
   	   print "<center><H2>Sorry:</H2>\n";
   	   print "<TABLE width=\"70%\"><TR><TD><font face=\"Helvetica\" text=\"slategray\">\n";
   	   print "<B>The name you selected is already in use by a registered Member of The Tavern.<BR>\n";  
   	   print "Please hit your browsers BACK button and try again using a different name. </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 or it is already in use.</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 "<H1>Oops! </h1>\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 404 page
   	   print "Content-type: text/html\n\n";
   	   print "<html><head><title>404 Not Found</title></head>\n";
   	   print "<body><H1>Not Found</H1>\n";
   	   print "The requested URL /gor/gsguest.cgi was not found on this server.<P>\n";
   	   print "<HR><ADDRESS>Apache/1.3.21 Server at www.gorean-shores.com Port 80</ADDRESS>\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/gsguest.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-><b> $name</b><!--:$ra:-->\n"); 
	   }  #  end of elsif statement

	   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;

	$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-\>/) {
		push (@main_new,"<!-:$time:-><!-s->\n","<!-:$time:-><b>$name</b>  ip:$ra 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");
		push (@visitors_new,"<!-:$time:-><!-$name-><b>$name</b>\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'};
	$vname = $name;
	$vname =~ s/ /_/g;

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

	if(($vname eq "0") || ($vname eq "0") || ($vname eq "") || ($ra eq "")) {   # someone screwing with us?
	   print "Location: $zoom_link\n\n";
	}

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

         if($font_color eq "default")  {
		$font_color = $text_color;
	   }
	   if($font_size eq "default")  {
	   $font_size = 3;

	}

      foreach $main_line (@main) {
         if ($main_line =~ /\<!-s-\>/) {
		push (@main_new,"<!-:$time:-><!-s->\n","<!-:$time:-><!--:$vname:--> <B>$name </B> <font size=1> $date CST $ra </font><BR><font color=\"$font_color\" size=\"$font_size\">$message</font> $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 (($bye -= 1) == 0)   {
		$bye_type = 1;  # We're going to need a nag screen on this exit.
		&leave;
	}
	$vname = $name;
	$vname =~ s/ /_/g;
	$vname =~ s/\//_/g;

	if(($vname eq "0") || ($vname eq "")) {
	   print "Location: $zoom_link\n\n";
	}

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

	if ($room eq "Courtyard") { 

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

	   if ($room eq "Market_Bazaar") {
		$background = "../graphics/gs_cobbles.jpg";
		$text_color = "e0e0e0";
		$bgcolor = "gray";
	   }   
	   elsif ($room eq "Slave_Kennels") {
		$background = "../graphics/silkpurple.jpg";
		$text_color = "a2a2a2";
		$bgcolor = "FFDAB9";
	   }   
	   elsif ($room eq "Training_Yard") {
		$background = "../graphics/trainingyard.gif";
		$text_color = "wheat";  
		$bgcolor = "green";     
	   }   
	   elsif ($room eq "Piazza") {
		$background = "../graphics/piazza.jpg";
		$text_color = "C0C0C0";  
		$bgcolor="66CDAA";       
	   }   

	   elsif ($room eq "Pump_House") {
		$background = "../graphics/back13.jpg";
		$text_color = "efefef";  
		$bgcolor = "0A0A07";     
	   } 
	   elsif ($room eq "Arsonal") {
		$background = "../graphics/deepred.jpg";
		$text_color = "efefef";
		$bgcolor = "0A0A07";
	   } 
	   elsif ($room eq "Forum") {
		$background = "../graphics/back17.jpg";
		$text_color = "c0c0c0";
		$bgcolor = "303030";
	   } 
	   elsif ($room eq "The_Tavern") {
		$background = "../graphics/back12.jpg";
		$text_color = "e0e0e0"; 
		$bgcolor = "000044";     
	   }   
	   # This must be a private room...

	   else  {   
		$background = "../graphics/proom.jpg";
		$text_color = "c1c2c3";
		$bgcolor = "c1c2c3";    
		}

		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);

	   $bgc = $back_color;

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



<html><head><title>$room</title>


<script language="Javascript">
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>
<input type=hidden name=name value=$name>
<center><a href="#top"></A>
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";   


	if ($use_whispers == 1)  {
         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=300 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";


	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 "<BR><HR></CENTER>\n";

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

	if(($name eq "Jed") || ($name eq "Aaron")) {
	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 (check for whispers too!)
         
		($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\">$public_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 $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=\"000044\" background=\"$bgd\" text=\"C0C0C0\" link=\"$link_color\" vlink=\"$vlink_color\">\n";

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

	# ###########   Begin major changes to program operation   ##################################
	#############################################################################################
	
	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");
	   flock DFILE, 2;
	   print DFILE "$name\n$ip";    # print out the file...
	   close (DFILE)
	}
	 
     $bye = 150;	# preload the spam counter.

	print "<input type=hidden name=\"viz\" value=\"$time\">\n";
	print "<input type=hidden name=\"epoch\" value=\"$epoch\">\n";
	print "<input type=hidden name=\"room\" value=\"$room\">\n";
	print "<input type=hidden name=\"name\" value=\"$name\">\n";

	print "<center><table width = \"60%\">\n";  
	print "<font face = \"Helvetica\">\n"; 

	# print "Debug $debug_var\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=14 name=\"public\">$public_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=\"#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";

	$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 {



	$ra = $ENV{'REMOTE_ADDR'};

	$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> $ra<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=#2222ff><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 {
	$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;
   
	if($bye_type == 1)  {

	   print "Location: $nag_link\n\n";
	}
	else {
	   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 {
	&chop_msglen;  # Truncate guest's message string to 500 chars.

	$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/\n\n\n\n\n/ /g;
	$message =~ s/\n.\n.\n.\n./ /g;
	$message =~ s/.\n.\n.\n.\n/ /g;
	$message =~ s/<BR><BR><BR><BR><BR>//ig;
	$message =~ s/<h1>//ig;
	$message =~ s/<h2>//ig;
#	$message =~ s/\n\n/ <P> /ig;
	$message =~ s/\n/ <BR> /ig;
	$message =~ s/<BR>.<BR>.<BR>.//ig;
	$message =~ s/.<BR>.<BR>.//ig;
	$message =~ s/javascri//ig;
}


sub get_epoch  {
		my $ip = $ENV{'REMOTE_ADDR'};		# Use local var - dont contaminate global
		$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);

	     chomp($dfile[1]);
		# print "Content-type: text/html\n\n";
		# printf "<html>$fname = $dfile[0]... $dfile[1] <br>\n";
		
# This does NOT work yet.
		#if ($ip ne $dfile[1])  {
		  # printf "Holy Balls! It works! $ip, $dfile[1]<br></html>\n";
		#}
		$name = $dfile[0];
	}
	else  {
		# debug
		# print "Content-type: text/html\n\n";
		# printf "<html>Does not exist = $fname<br><br><br></html>\n";
		$etype = 6;
		&error_out;

	}
}