#
 # Copyright (c) 2001, 2002 Uiewera Alistair Ruirarchzatrea.  All rights reserved.
 # 
 #  The EPTSL Library is now covered under the BSD Licence, please see
 #  the EPTSL-LICENCE file included for this licence.


#!/usr/bin/perl -w
	 use strict;
	 use Socket;
	 use IO::Select;
	 use IO;
         use IO::Socket;
         use Net::hostent;              # for OO version of gethostbyaddr
	require 'misc.pl';
	require 'toc_unroast.pl';
	my %userdb;
	my %userdb1;
	my %userinfodb;
	my %listeningtolist;
	my %listenerslist;
	my %chatdb;
	my %chatdb1;
	my %chatdb2;
	my $chatid;
	my %usersubscribedto;
	my %flap_seq;
	my %client_seq;
	my %connectionmode;
	my %signonmode;
	my %signedon;
        my %pre_userdb;
        my %pre_userdb1;
        my %whoscontactedus;
        my %userpassdb;
         my $useauth = 0;
         my ($port) = (9000);                  # pick something not in use

         my $socket = IO::Socket::INET->new( Proto     => 'tcp',
                                          LocalPort => $port,
                                          Listen    => 5,
                                          Reuse     => 1);

         die "can't setup server" unless $socket;
         print "[Server $0 accepting clients]\n";
	 my $readable = IO::Select->new;
	 $readable->add($socket);
	 
	 if ($useauth == 2) {
	 # use database access protocol
	 my $edbap_socket = IO::Socket::INET (PeerAddr => 'localhost',
	 					PeerPort => 9001,
	 					Proto => 'tcp'
	 					);
	 }
	 
	 $chatid = 0;
	 
	if ($useauth == 1) {
	use DB_File;
	use Fcntl;
	tie %userpassdb, 'DB_file', 'userdatabase.db', O_CREAT|O_RDWR, 0644;
	}
	
	while(1) { # 1
         
         my ($pre_pass, $pre_evil, $pre_uclass);
         
         
          # $client->autoflush(1);
 	my ($ready) = IO::Select->select($readable, undef, undef, undef);
 	
 	
 	
 	
 	foreach my $s (@$ready)
 	{ # 2
 	if($s == $socket) { # 3
	my $new_sock = $socket->accept;
	$readable->add($new_sock) if $new_sock;
	$connectionmode{$new_sock} = 1;
	$signonmode{$new_sock} = 1;
	$signedon{$new_sock} = 0;
	$client_seq{$new_sock} = 0;
	} # e 3
	else {
 	unless ($foo = sysread($s, 10, $recvbuffer{$s}, -0) {
 	close_connections($s);
yiyr  	}
 	if {$foo == 0) {
 	close_connection($s);
 	}
 	if ($recvbuffer{$s}[1] == 1) {
 		$recvbuffer{$s}[1] = 1;
 		push(@protoproc, $s);
 	}
 	}
 	}
 	
 	foreach my $s (@protoproc) {
 	if($signonmode{$s} = 1) {
 	@arrsplit = split("\n", $recvbuffer{$s});
 	
 	}
 	
 	elsif($signonmode{$s} > 1) {
 	
 	if ($recvbuffer{$s}[2] == 0) {
 		$buffersize = scalar $recvbuffer{$s}[0];
 		if ($buffresize < 4) {
 		
 		}
 		else {
 		
 		}
 	}	
 	}
 	
 	foreach my $s (@commandexec) {
 	$arrlen = scalar(@{$commandbuf{$s}});
 	if ($arrlen > 0) {
 	$message = shift(@commandbuf{$s});
 	toc_main_cmd_proc($s, $message);
 	}
 	if ($arrlen < 2) {
 		$list = grep{
 		foreach my $incoming (@list) {
 			}
 		$userinfodb{$s}[10] = 0;
 	}
 	}
 	
 	foreach my $s (@sendqueue) {
 		$arrlen = scalar(@{$commandbuf{$s}});
 	        if ($arrlen > 0) {
 		$message = $sendbuffer{$s};
 		$foo = sflap_send($s, $message);
 		if ($foo == 0) {
 			close_connection($s);
 		}
 		}
 		if ($arrlen < 2) {
 		$list = grep{
 		foreach my $incoming (@list) {
 		}
 		$userinfodb{$s}[10] = 0;
 		}
 	}
 		
          # $hostinfo = gethostbyaddr($client->peeraddr);
 	# printf "[Conn ect from %s]\n", $hostinfo->name || $client->peerhost;                                                      

sub toc_main_cmd_proc {
	$fd = $_[0];
	$inmessage = $_[1];
	
	# { # 3
my $buf = "buffer";
my $fd = $s;
	if($s)
	{ # 4

if ($connectionmode{"$s"} == 1) { # 5
if ($signonmode{"$s"} == 1) { # 6 
# receive FLAPON/r/n/r/n
print "0\n"; 
# $signonmsg = "SIGN_ON:1";
my @statres = stat($s);
# print $statres[7];
# $result = readline($s);
my $result = "FLAPON";
recieve_flapon($s);
unless ($result eq "FLAPON") {
	if ($result eq "/about") {
	    my $outstring = "A TOC Server written by Uiewera Ruirarchzatrea\n";
	    my $len = length($outstring);
	    syswrite($s, $outstring, $len);
	  }
}
else {
# Recieve last \r\n
# $foo = sysread($s, $inbuf, 2);
# if ($inbuf eq "\r\n") {	  
# recieve_flapon($s);
print "1\n";
# send FLAP SIGNON
send_flap_signon($s, 1, 1, 4, 1);
print "2\n"; 
$signonmode{"$s"} = 2;
# ++$signonmode{"$s"};
# }
}
} # e 6

elsif ($signonmode{"$s"} == 2) { # 6
# recieve FLAP SIGNON
recieve_flap_signon($s);
print "\n3\n";
++$signonmode{"$s"};
} # e 6

elsif ($signonmode{"$s"} == 3) { # 6
# recieve toc_signon message
my $toc_signon_str = serv_recieve($fd);
print $toc_signon_str;
my @parse_toc_signon_str = MISC::parse_tocclientmsg($toc_signon_str);
my $strlen = scalar(@parse_toc_signon_str);
if ($strlen != 8) {
	close_connection($fd);
}
print "\nsignon_len:";
print $strlen;
print "\n";

   if ($parse_toc_signon_str[1] eq "toc_signon") { # 7
	#toc_cmd auth_host auth_port username pass lang ver
   my $myusername = $parse_toc_signon_str[4];
   my $toc_passwd = TOCUNRST::toc_unroast($parse_toc_signon_str[5]);
   my $dbstring;
   if (exists($userdb{"$myusername"})) { # 8
   	my $sendstring =  "ERROR:980";
   	sflap_send($fd, $sendstring);
   	close_connection($s);
   } # e 8
   print("123");
   print($parse_toc_signon_str[4]);
   print("123");
   if ($useauth == 1) { # 8
   if (exists($userpassdb{"$myusername"})) { # 9
   $dbstring = $userpassdb{"$myusername"};
   my ($pre_pass, $pre_evil, $pre_uclass) = split(":", $dbstring);
   if ($pre_pass eq $toc_passwd) { # 10
   } # e 10
   else { # 10
   	my $sendstring = "ERROR:980";
   	sflap_send($fd, $sendstring);
   	close_connection($s);
   	
   } # e 10
   } # e 9
   else { # 9
   	my $sendstring = "ERROR:980";
   	sflap_send($fd, $sendstring);
   	close_connection($s);
   } # e 9
   } # e 8
   $pre_userdb{$parse_toc_signon_str[4]} = $s;
   $pre_userdb1{$s} = $parse_toc_signon_str[4];
   # toc_useronline($parse_toc_signon_str[4]);
   

} # e 7
else { # 7
   close_connection($s);
} # e 7

print "4\n";
my $signonmsg = "SIGN_ON:1";
my $len = length($signonmsg);
# $seq = 1
# $ftype = 1
serv_send($signonmsg, $len, $fd, 2, 2);
print "5\n";
++$signonmode{"$s"};

my $signonmsg2 = "CONFIG:";
my $len2 = length($signonmsg2);
serv_send($signonmsg2, $len2, $fd, 3, 2);
$flap_seq{"$s"} = 4;
$connectionmode{"$s"} = 2;
} # e 6

else {
	print "hmmmm";
}

} #  e 5

else { # 5

my $myusername;
if ($signedon{$s} == 1) {
$myusername = $userdb1{$s};
}
else {
$myusername = $pre_userdb1{$s};
}
my $recvbuffer = serv_recieve($fd);
# require 'misc.pl';
my @parsedtoc = MISC::parse_tocclientmsg($recvbuffer);



if ($parsedtoc[1] eq "toc_send_im") { # 1
my $tosend;
my $tofd;
my $username;
my $fromuser;
my $tosend1;
my $conusername = $parsedtoc[2];
# client to server toc_cmd destuser autorespT/F msg
# server to client IM_IN fromuser autorespT/F msg
if ($userdb{$conusername}) { # 2
	$tofd = $userdb{$conusername};
	$username = $userdb1{$tofd};
	if ($username eq $conusername) { # 3
# $recvbuffer2 ="IM_IN:System\@mydomain.com:F:{$parsedtoc[1]}{$parsedtoc[2]}message:{$parsedtoc[3]}";
if(exists($whoscontactedus{$conusername})) { # 4
my @returnarray = grep(/^($myusername)$/, $whoscontactedus{$conusername});
my $contactlen = scalar($whoscontactedus{$conusername});
if($contactlen > 0) { # 5
push(@{$whoscontactedus{$conusername}}, $myusername);
} # e 5
} # e 4
$fromuser = $userdb1{$s};
$tofd = $userdb{$parsedtoc[2]};
$tosend1="IM_IN:$fromuser:$parsedtoc[3]:";
$tosend1 = $tosend1 . $parsedtoc[4];
# dstuser message T/F
my $len14 = length($tosend1);
print($tosend1);
# ++$flap_seq{$tofd} if serv_send($tosend1, $len14. $tofd, $flap_seq{$tofd}, 2);
sflap_send($tofd, $tosend1);
my $awayflag = substr($userinfodb{$parsedtoc[2]}[6], 3, 1);
if ($awayflag eq "U") { # 4
my $awaymsg = $userinfodb{$parsedtoc[2]}[7];
my $sendstring = "IM_IN:$parsedtoc[2]:T:$awaymsg";
sflap_send($fd, $sendstring)
} # e 4
# ++$seq11;
# $len11 = length($recvbuffer2);
# ++$flap_seq{$s} if serv_send($recvbuffer2, $len11, $fd, $flap_seq{$s}, 2);
# ++$seq11;
 } # e 3
else { # 3
	print "db not right";
	#db not right
} # e 3
} # e 2
else { # 2
	print "user doesnt exist";
	#user doesnt exist
	my $errorstr = "ERROR:901:$parsedtoc[2]";
	sflap_send($fd, $errorstr);
} # e 2
} # e 1


elsif ($parsedtoc[1] eq "toc_fdfdsafdaf") {
	print "hmmm";
}



elsif ($parsedtoc[1] =~ /^toc_init_done/) { # 1
	if ($signedon{$fd} == 0) {
	my $unixepoc = 0;
	my ($evilam, $userclass);
	if ($useauth == 1) {
		$userclass = $pre_uclass;
		$evilam = $pre_evil;
	}
	else {
		if ($myusername eq "norstar") {
			$userclass = " A ";
		}
		else {
		
		$userclass = " O ";
		}
		$evilam = 0;
	}
	my $unixepoc2 = time;
	$userdb{$myusername} = $pre_userdb{$myusername};
	delete $pre_userdb{$myusername};
	$userdb1{$s} = $pre_userdb1{$s};
	delete $pre_userdb1{$s};
	$signedon{$fd} = 1;
	my $permitdeny = "pa";
	# onlineT/F evilamount signontime idlesetfromclient userclass idlesince permitdenmode awaymsg numberofevilswemade
	@{$userinfodb{$myusername}} = ("T", $evilam, $unixepoc2, 0, $userclass, "", $permitdeny, "", 0);
	print("tocinit");
	print("$userdb1{$s}");
	print("tocinit");
	#people listening to us, send then an update of our information
	if (exists($listenerslist{$myusername})) { # 2
	foreach my $incoming (@{$listenerslist{$myusername}}) { # 3
		# my $incoming;
		# $incoming = $_;
		my ($tofd) = $userdb{$incoming};
		# $signedon{$fd} = 1;
		my ($sendstring) = "UPDATE_BUDDY:$myusername:T:$evilam:$unixepoc2:0:$userclass";
		sflap_send($tofd, $sendstring);
 	} # e 3
	} # e 2	
	# people we are listening to, send thier information to ourselves
	if (exists($listeningtolist{$myusername})) { # 2
	foreach my $inusername (@{$listeningtolist{$myusername}}) { # 3
		my $strlength = length($inusername);
		unless ($strlength == 0) {
		if (exists($userinfodb{$inusername})) {
		my ($ostat, $evilamount, $signonsince, $idlefc, $uclass, $idlesince, $pdmode1);
		($ostat, $evilamount, $signonsince, $idlefc, $uclass, $idlesince, $pdmode1) = @{$userinfodb{$inusername}};
		
		my $currentseconds;
		if ($idlefc > 0) {
			my $currenttime = time;
			my ($currentidle, $currentidlesec);
			$currentidlesec = $idlesince - $currenttime;
			$currentseconds = $currentidlesec + $idlefc;
		
		}
		else {
			$currentseconds = 0;
		}
		# $incoming = $_;
		if (exists($userdb{$inusername})) { # 4
		my ($sendstring) = "UPDATE_BUDDY:$inusername:T:$evilamount:$signonsince:$currentseconds:$uclass";
		sflap_send($s, $sendstring);
		} # e 4
		}
		}
		else {
			print "array was empty";
			print $strlength;
		}
	} # e 3
	} # e 2
	}
	else {
		print("toc_init sent twice");
	}
} # e 1
	
elsif ($parsedtoc[1] eq "keepalive_frame") {
	print ("We recieved a keepalive frame\n");
}

elsif ($parsedtoc[1] eq "toc_add_buddy") {
	my $unixepoc = 0;
	my $buddy2;
	my @userlist = @parsedtoc;
	my ($idletime, $online, $evilamount, $signonsince, $idleval, $userclass, $idlesince);
	shift(@userlist);
	foreach $buddy2 (@userlist) {
	# $buddy2 = $_;
	if (exists($userdb{$buddy2})) {
	($online, $evilamount, $signonsince, $idleval, $userclass, $idlesince) = @{$userinfodb{$buddy2}};
	$idletime = calc_idle_val($idleval, $idlesince);
	}
	push(@{$listenerslist{$buddy2}}, $myusername);
	
	push(@{$listeningtolist{$myusername}}, $buddy2);
	if ($signedon{$s} == 1) {
	if (exists($userdb{$buddy2})) {
	
	my $sendstring = "UPDATE_BUDDY:$buddy2:$online:$evilamount:$signonsince:$idletime:$userclass";
	sflap_send($fd, $sendstring);
	}
	}
	}
}

elsif ($parsedtoc[1] eq "toc_remove_buddy") { # 1
	my @userlist = @parsedtoc;
	my $tocommand = shift(@userlist);
	my $arraycount;
	my @newarray;
	my $unixepoc = 0;
	$arraycount = 0;
	foreach my $incominguser (@userlist) { # 2
	
	foreach my $incoming (@{$listeningtolist{"$myusername"}}) { # 3
	
	if ($incoming eq $incominguser) { # 4
		 
		my @newarray = splice(@{$listeningtolist{"$myusername"}}, $arraycount, 1);
		@{$listeningtolist{$myusername}} = @newarray;
		last;
		} # e 4
	else { # 4
		++$arraycount;
	} # e 4
	foreach (@{$listenerslist{"$incominguser"}}) { # 4
	$incoming = $_;
	if ($incoming eq $myusername) { # 5
		 
		@newarray = splice(@{$listenerslist{"$incominguser"}}, $arraycount, 1);
		@{$listeningtolist{$myusername}} = @newarray;
		last;
		} # e 5
	else { # 5
		++$arraycount;
	} # e 5
	
	if ($userdb{"$incominguser"}) { # 5
	
	my $sendstring = "UPDATE_BUDDY:$incominguser:F:0%:$unixepoc:0: O ";
	sflap_send($fd, $sendstring);
	} # e 5
	}
	}
	}
}



elsif ($parsedtoc[1] eq "toc_set_config") {
	my @configarray1 = split("\n", $parsedtoc[2]);
	foreach my $incoming (@configarray1) {
		# $incoming = $_;
		my($type, $value) = split(" ", $incoming);
		if ($type eq "b") {
			# add_user_db($
		print("fdfd");
			}
		elsif ($type eq "p") {
			}
		elsif ($type eq "d") {
			}
		elsif ($type eq "m") {
			}
		elsif ($type eq "g") {
			}
		else {
			print("hmmmm");
		}
	}
	my $config_string = $parsedtoc[2];
	my $lenval = length($config_string);
	# serv_send();
}


elsif ($parsedtoc[1] eq "toc_evil") {
print "hmmm";
# my @resultarray;	
my $username = $parsedtoc[2];
my @resultarray = grep(/^($username)$/, @{$whoscontactedus{$myusername}});
my $resultnum = scalar(@resultarray);
if ($resultnum > 0) { # 2
my $eviltype = $parsedtoc[3];
my $evilamountnew;
my $eviler;
my ($online, $evilamount, $signonsince, $idleval, $userclass, $idlesince) = @{$userinfodb{$username}};
my $evilresult;
my $idletime;
my $sendstring;

my $eviltimes = $userinfodb{$myusername}[8];
if ($eviltimes < 4) { # 3
++$userinfodb{$myusername}[8];
if ($eviltype eq "norm") { # 4
	$evilamountnew = $evilamount + 20;
	$eviler = $myusername;
} # e 4
elsif ($eviltype eq "anon") { # 4
	$evilamountnew =  $evilamount + 5;
	$eviler = "";
} # e 4
$userinfodb{$username}[2] = $evilamountnew;
if ($useauth == 1) { # 4
my $useridbstring = $userpassdb{$username};
my ($pass, $evil, $userclass) = split(":", $useridbstring);
$useridbstring = join(":", $pass, $evilamountnew, $userclass);
$userpassdb{$username} = $useridbstring;
} # e 4
$idletime = calc_idle_val($idleval, $idlesince);
my $eviledstring = "EVILED:$evilamountnew%:$eviler";
my $evilerfd = userdb{$username};
sflap_send($evilerfd, $eviledstring);
foreach my $buddy (@{$listenerslist{$username}}) { # 4
	my $tofd = userdb($buddy);
	$sendstring = "UPDATE_BUDDY:$username:T:$evilamountnew%:$signonsince:$idletime:$userclass";
	sflap_send($tofd, $sendstring);
} # e 4
} # e 3
else { # 3
	my $errorstr = "ERROR:902:$username";
	sflap_send($fd, $errorstr);
} # e 3
} # e 2
else { # 2
	my $errorstr = "ERROR:902:$username";
	sflap_send($fd, $errorstr);

} # e 2
}
elsif ($parsedtoc[1] eq "toc_add_permit") {
print "hhmmm";	
}

elsif ($parsedtoc[1] eq "toc_add_deny") {
	
}

elsif ($parsedtoc[1] eq "toc_chat_join") {
	
	my $chatroomid;
	my $chatupdate;
	my $chatupdatestr;
	my @temparray;
	my $usernamelist;
	my $sendstring;
	my $tofd;
	# CHAT_JOIN:chatid:chatroomname
	# chat_join exchange roomname
	#exchange roomname
	if (exists($chatdb1{"$parsedtoc[2]"}{"$parsedtoc[3]"})) {
	$chatroomid = $chatdb1{$parsedtoc[2]}{$parsedtoc[3]};
	}	
	else {
	$chatdb1{$parsedtoc[2]}{$parsedtoc[3]} = $chatid;
	push(@{$chatdb2{$chatid}}, $parsedtoc[2], $parsedtoc[3]); 
	$chatroomid = $chatid;
	++$chatid;
	$chatdb{$chatroomid}[0] = 0;
	
	}
	my $roomname = $parsedtoc[3];
	$sendstring = "CHAT_JOIN:$chatroomid:$roomname";
	# push(@{$chatdb{"$chatroomid"}}, $myusername);
	push(@{$usersubscribedto{$myusername}}, $chatroomid);
	# ++$chatdb{"$chatroomid"}[0];
	@temparray = @{$chatdb{$chatroomid}};
	push(@{$chatdb{$chatroomid}}, $myusername);
	shift(@temparray);
	$usernamelist = join(":", @temparray);
	$chatupdatestr = "CHAT_UPDATE:$chatroomid:T:$usernamelist";
	sflap_send($fd, $sendstring);
	push(@temparray, $myusername);
	foreach my $username (@temparray) {
		# CHAT_UPDATE_BUDDY:roomid:onlineT/F:userlist
	# $username = $_;
		$tofd = $userdb{$username};
		$chatupdate = "CHAT_UPDATE_BUDDY:$chatroomid:T:$myusername";
		sflap_send($tofd, $chatupdate);
		
	}
	sflap_send($fd, $chatupdatestr);
}

elsif ($parsedtoc[1] eq "toc_chat_send") { # 1

my $message;
my @userlist;
my $chatroomid;

# CHAT_IN:roomid:sourceuser:whisperTF:message
# chat_send roomid message
$message = $parsedtoc[3];
$chatroomid = $parsedtoc[2];
@userlist = @{$chatdb{$chatroomid}};
shift(@userlist);

# $message = parse_roll_cmd($message);	

			
	foreach my $username (@userlist) {
		
		
		my $tofd = $userdb{$username};
		
		my $chatupdate = "CHAT_IN:$chatroomid:$myusername:F:$message";
		
		sflap_send($tofd, $chatupdate);
		}
	
}

elsif ($parsedtoc[1] eq "toc_chat_whisper") {
	my $dstuser;
	my $message;
	my $sendstring;
	my $tofd;
	my $chatroomid;
	
	$chatroomid = $parsedtoc[2];
	$dstuser = $parsedtoc[3];
	$message = $parsedtoc[4];
	
	$tofd = $userdb{$dstuser};
	$sendstring = "CHAT_IN:$chatroomid:$myusername:T:$message";
	sflap_send($tofd, $sendstring);
	
}

elsif ($parsedtoc[1] eq "toc_chat_evil") {
	
}

elsif ($parsedtoc[1] eq "toc_chat_invite") {
	
	my $roomid;
	my $message;
	my $roomname;
	my $sendstring;
	
	# chatrid invitemsg listofbuddies ....
	my @temparray = @parsedtoc;
	shift(@temparray);
	$message = shift(@temparray);
	$roomid = shift(@temparray);
	$roomname = $chatdb2{$roomid}[1];
	# $roomname = $chatdb{$roomid};
	foreach my $username (@temparray) {
		# $username = $_;
		if (exists($userdb{$username})) {
		my $tofd = $userdb{$username};
		
		$sendstring = "CHAT_INVITE:$roomname:$roomid:$myusername:$message";
		sflap_send($tofd, $sendstring);
		}
		else {
		my $errorstr = "ERROR:901:$username";
		sflap_send($fd, $errorstr);
		}
	}
}

elsif ($parsedtoc[1] eq "toc_chat_leave") {
	my $chat_left;
	my @chatarray;
	my $bgcnt;
	my $arraycount = 0;
	my $chatupdate;
	my $chatroomid = $parsedtoc[2];
	if ($chatdb2{$chatroomid}[1]) {
	my $roomname = $chatdb2{$chatroomid}[1];
	@chatarray = @{$chatdb{$chatroomid}};
	shift(@chatarray);
	
	foreach my $incoming (@chatarray) {
		# $incoming = $_;
		if ($myusername eq $incoming) {
			splice (@chatarray, $arraycount, 1);	
		}
		else {
			++$arraycount;
		}
	} 

	$chat_left = "CHAT_LEFT:$chatroomid";
	sflap_send($fd, $chat_left);
	@{$chatdb{$chatroomid}} = @chatarray;
	
	my @resarray = grep(/^($chatroomid)$/, @{$usersubscribedto{$myusername}});
	foreach my $incomeval (@resarray) {
		splice (@{$usersubscribedto{$myusername}}, $incomeval, 1);
	}
	foreach my $username (@chatarray) {
		# $incoming = $_;
			if ($bgcnt == 0) {
			++$bgcnt;
		}
		else {
		
		my $tofd = $userdb{$username};
		$chatupdate = "CHAT_UPDATE:$chatroomid:F:$myusername";
		sflap_send($tofd, $chatupdate);
		}
	}	 
    }
}

elsif ($parsedtoc[1] eq "toc_chat_accept") {
	my $chatroomname;
	my $chatroomid;
	
	$chatroomid = $parsedtoc[2];
	# $chatroomname = chatdb2
	# $sendstring = "CHAT_JOIN:$chatroomid:$chatroomname";
	join_chat($parsedtoc[2]); 
}

elsif ($parsedtoc[1] eq "toc_get_info") {
# my $infolisting;
# infolisting = $userinfodb{"$username"};
	
}
 

elsif ($parsedtoc[1] eq "toc_set_info") {

# $userinfodb{$myusername} = $parsedtoc[2];
	
}

elsif ($parsedtoc[1] eq "toc_set_away") {
	my ($onlinestat, $evil, $signonunix, $idleval, $userclass, $idlesince, $pdmode, $awaymsg) = @{$userinfodb{"myusername"}};
	my $idletime = calc_idle_val($idleval, $idlesince);
	my ($buddy, $char, $sendstring);
	
	if ($parsedtoc[2]) {
	$char = "U";
	substr($userclass, 3, 1) = $char;
	$userinfodb{$myusername}[5] = $userclass;
	$userinfodb{$myusername}[7] = $parsedtoc[2];
	foreach $buddy (@{$listenerslist{$myusername}}) {
	my $tofd = $userdb{$buddy};
	$sendstring = "UPDATE_BUDDY:$myusername:T:$evil:$signonunix:$idletime:$userclass";
	sflap_send($tofd, $sendstring);
	}
	}
	else {
	$char = " ";
	substr($userclass, 3, 1) = $char;
	$userinfodb{$myusername}[5] = $userclass;
	$userinfodb{$myusername}[7] = "";
	foreach $buddy (@{$listenerslist{$myusername}}) {
	my $tofd = $userdb{$buddy};
	$sendstring = "UPDATE_BUDDY:$myusername:T:$evil:$signonunix:$idletime:$userclass";
	sflap_send($tofd, $sendstring);
	}
	}	

}

elsif ($parsedtoc[1] eq "toc_get_dir") {
	
}

elsif ($parsedtoc[1] eq "toc_set_dir") {
	
}

elsif ($parsedtoc[1] eq "toc_dir_search") { 
	
}

elsif ($parsedtoc[1] eq "toc_set_idle") {
my $idleval = $parsedtoc[2];
my ($onlinestat, $evil, $signonunix, $idleval2, $userclass, $idlesince, $pdmode) = @{$userinfodb{$myusername}};
$userinfodb{$myusername}[4] = $idleval;
if ($idleval > 0) {
	$userinfodb{"$myusername"}[6] = time;
}
else {
	$userinfodb{"$myusername"}[6] = "";
}
	
foreach my $buddy (@{$listenerslist{$myusername}}) {
	my $sendstring;
	my $tofd = $userdb{$buddy};
	$sendstring = "UPDATE_BUDDY:$myusername:T:$evil:$signonunix:$idleval:$userclass";
	sflap_send($tofd, $sendstring);
	# broadcast_msg("$myusername, $sendstring");
}
}

elsif ($parsedtoc[1] eq "toc_set_caps") {
	
}

elsif ($parsedtoc[1] eq "toc_format_nickname") {
	
}

elsif ($parsedtoc[1] eq "toc_change_passwd") {
	
}

# elsif ($parsedtoc[1] eq "dsadsad") {
# 	print("tocinit");
# }

else {
	print("\nUnsupported command\n:");
	print($parsedtoc[1]);
	print(":\n");
	print("\n\n");
	my $toprint = join(":", @parsedtoc);
	print $toprint;
	print("\n\n");
	my $testtoc = $parsedtoc[1];
	# $testtoc =~ tr/a-zA-Z/-/c;
	print $testtoc;
	if ($testtoc =~ /^toc_init_done/) {
		print "toc_init works here";
	}
}

print "recieve\n";
my $len12 = length($recvbuffer);
my $recvbuffer1 = "IM_IN:System\@mydomain.com:F:We recieved a message";
my $len11 =  length($recvbuffer1);
my $seq11 = $flap_seq{"$s"};
serv_send($recvbuffer1, $len11, $fd, $seq11, 2);
++$flap_seq{"$s"};
# }
} # e 5
} # e 4

else { # 4
close_connection($s);
# $readable->$remove($s);
# $s->close;


} # e 4
} # e 3
} # e 2
} # e 1

sub proc_stbcp_message {
if($incoming[0] eq "/sendim") {
}
elsif($incoming[0] eq "/sendim" {

sub send_im {
	
my $tosend;
my $tofd;
my $username;
my $fromuser;
my $tosend1;
my $conusername = $parsedtoc[2];
# client to server toc_cmd destuser autorespT/F msg
# server to client IM_IN fromuser autorespT/F msg
if ($userdb{$conusername}) { # 2
	$tofd = $userdb{$conusername};
	$username = $userdb1{$tofd};
	if ($username eq $conusername) { # 3
# $recvbuffer2 ="IM_IN:System\@mydomain.com:F:{$parsedtoc[1]}{$parsedtoc[2]}message:{$parsedtoc[3]}";
if(exists($whoscontactedus{$conusername})) { # 4
my @returnarray = grep(/^($myusername)$/, $whoscontactedus{$conusername});
my $contactlen = scalar($whoscontactedus{$conusername});
if($contactlen > 0) { # 5
push(@{$whoscontactedus{$conusername}}, $myusername);
} # e 5
} # e 4
$fromuser = $userdb1{$s};
$tofd = $userdb{$parsedtoc[2]};
$tosend1="IM_IN:$fromuser:$parsedtoc[3]:";
$tosend1 = $tosend1 . $parsedtoc[4];
# dstuser message T/F
my $len14 = length($tosend1);
print($tosend1);
# ++$flap_seq{$tofd} if serv_send($tosend1, $len14. $tofd, $flap_seq{$tofd}, 2);
sflap_send($tofd, $tosend1);
my $awayflag = substr($userinfodb{$parsedtoc[2]}[6], 3, 1);
if ($awayflag eq "U") { # 4
my $awaymsg = $userinfodb{$parsedtoc[2]}[7];
my $sendstring = "IM_IN:$parsedtoc[2]:T:$awaymsg";
sflap_send($fd, $sendstring)
} # e 4
# ++$seq11;
# $len11 = length($recvbuffer2);
# ++$flap_seq{$s} if serv_send($recvbuffer2, $len11, $fd, $flap_seq{$s}, 2);
# ++$seq11;
 } # e 3
else { # 3
	print "db not right";
	#db not right
} # e 3
} # e 2
else { # 2
	print "user doesnt exist";
	#user doesnt exist
	my $errorstr = "ERROR:901:$parsedtoc[2]";
	sflap_send($fd, $errorstr);
} # e 2
} # e 1


}
sub broadcast_msg {
	my @incomingarray = @_;
	my $sendstring = pop(@incomingarray);
	
	foreach my $incoming (@incomingarray) {
		# $incoming = $_;
		my $tofd = $userdb{"$incoming"};
		sflap_send($tofd, $sendstring);
	}
}	
sub calc_idle_val {
	
	my ($beginidletime, $beginidleamount) = @_;
	my ($currentidle, $currentidlesec, $currentseconds); 
	my $currenttime =  time;
	if ($beginidleamount > 0) {
	$currentidle = $beginidletime - $currenttime;
	$currentidlesec = int abs($currentidlesec);
	$currentseconds = $currentidlesec + $beginidleamount;
	return($currentseconds);
	}
	else {
	my $zeroval = 0;
	return($zeroval);
	}
}

sub parse_roll_cmd {
my $bgcnt = 0;
my $split1;
my $split2;
my @rollarray;
my $rollsize;
my $dice;
my $sides;
my $rollarg1len;
my $rolltestchar;
my $dicestring;
my $diceval;
my $myusername;
my $message;

$message = @_;

($split1, $split2) = split(" ", $message, 2);
$split1 = 0;
		if ($split1 eq "//roll") { # 2
			#//roll -sides2 -dice2 arguments not need order
			@rollarray = split(" ", $split2);
			$rollsize = scalar(@rollarray);
			
			if ($rollsize < 2) { # 3
				$dice = 2;
				$sides = 6;
			} # e 3
			else { # 3
				
				$rollarg1len = length($rollarray[1]);
				$rolltestchar = substr($rollarray[1], 0, 1);
				if ($rolltestchar eq "d") {
				}
				elsif ($rolltestchar eq "s") {
				}
				$message = "$myusername rolled $dice ($sides)-sided dice: 1 2 3";	
			} # e 3
			my $i;
			for ($i=0;$i<$dice;$i++) { # 3
			$diceval = rand $sides;
			$dicestring = $dicestring . $diceval;
			} # e 3
			} # e 2
	return $message;		
}

sub add_user_db {
	# add a user to the user databases
}

sub toc_useronline {
	print("hmmm");
}

sub tocuseroffline {
	print("hmmm");
	
}

sub join_chat_room {
	my ($exchange, $roomname, $fd) = @_;
	my ($chatroomid);
	if ($chatdb1{$exchange}{$roomname}) {
		$chatroomid = $chatdb{$exchange}{$roomname};
		join_chat($chatroomid, $roomname, $fd);
	}
	else {
		$chatroomid = create_chat ($exchange, $roomname);
		join_chat($chatroomid, $roomname, $fd);
	}
	return ($chatroomid);
}

sub create_chat {
# exchange roomname
	my $exchange;
	my $roomname;
	my $chatid;
	my $chatroomid;
	my @inarray = @_;	
	($exchange, $roomname) = @_;
	if ($chatdb1{$exchange}{$roomname}) {
	return("");
	}	
	else {
	$chatdb1{"$inarray[0]"}{"$inarray[1]"} = $chatid;
	$chatroomid = $chatid;
	++$chatid;
	$chatdb{"$chatroomid"}[0] = 0;
	push(@{$chatdb2{$chatroomid}}, $inarray[0], $inarray[1]);
	return $chatroomid;
	}
}

sub join_chat {
	my $usernamelist;
	my $chatupdatestr;
	my($chatroomid) = $_[0];
	my @temparray;
	my $roomname;
	my $tofd;
	my $chatupdate;
	my $sendstring; 
	if (exists($chatdb2{$chatroomid})) {
	my($fd) = $_[2];
	my $myusername = $userdb{$fd};
	unless ($_[1]) {
		$roomname = $chatdb2{$chatid}[1];
	}
	else {
		$roomname = $_[1];
	}
	my $resultvalsize;
	my @resultval = grep (/^($chatid)$/, @{$usersubscribedto{$myusername}});
	$resultvalsize = scalar(@resultval);
	unless ($resultvalsize > 0) {
	$sendstring = "CHAT_JOIN:$chatroomid:$roomname";
	push(@{$chatdb{$chatroomid}}, $myusername);

	# push(@usersubscribedto{$myusername}, $chatroomid);
	# ++$chatdb{"$chatroomid"}[0];
	@temparray = @{$chatdb{$chatroomid}};
	push(@{$chatdb{"$chatroomid"}}, $myusername);
	shift(@temparray);
	$usernamelist = join(":", @temparray);
	$chatupdatestr = "CHAT_UPDATE_BUDDY:$chatroomid:T:$usernamelist";
	serv_send($fd, $sendstring);
	
	foreach my $username (@temparray) {
		
	# $username = $_;
		$tofd = $userdb{$username};
		$chatupdate = "CHAT_UPDATE_BUDDY:$chatroomid:T:$myusername";
		send_sflap($tofd, $chatupdate);
		
	}
	send_sflap($fd, $chatupdatestr);
 	return 1;
	}
	else {
		return 0;
	}
	}
	else {
		return 2;
	}
		
		
	
}

sub sflap_send {
	if($output = syswrite

sub sflap_send {
	my $returnstr;
	my ($fd, $sendstring) = @_;
	my $len = length($sendstring);
	my $seq = $flap_seq{$fd};
	my $ftype = 2;
	$returnstr = serv_send($sendstring, $len, $fd, $seq, $ftype);
	if ($returnstr eq "ERRCODE") {
		return("ERRCODE") {
	++$flap_seq{$fd};
	return($returnstr);
}
sub serv_send {
	my $foo;
	my ($buffer);
	my ($format) = "cCnna*";
	my ($data, $len, $fd, $seq, $ftype) = @_;
	$buffer = pack($format, 42, $ftype, $seq, $len, $data);
	close_connection($fd) unless ($foo = syswrite($fd, $buffer, $len + 6));
	if ($foo <= 0) {
		close_connection($fd);
	}
	if ($foo > 0) {
	return("1");
	}
	if ($foo == "ERRCODE") {
		if ($userinfodb{$myusername}[10] == 1) {
			push(@tosendqueu, $myusername);
		}
		@sendarray=($data, $len, $fd, , $seq, $ftype);
		@usersendqueue{$myusername} = @sendarray;
		return("ERRCODE");
}	

sub serv_recieve { # 1
	my ($fd) = @_;
	# ($len, $type) = '';
	my ($buffer) = '';
	my ($payloadsuccess) = 0;
	my $foo;
	close_connection($fd) unless ($foo = sysread($fd, $buffer, 6));
	if ($foo <= 0) { # 2
		close_connection($fd);
	} # e 2
	my ($ast, $type, $seq, $len) = unpack("aCnn", $buffer);
	print "test";
	if ($type == 1 | 5) { # 2
		print "test1";
		if ($ast eq "*") { # 3
			print "test2";
			if ($seq == $client_seq{$fd}) { # 4
			print "test3";
	++$client_seq{$fd};
	if ($len > 0) { # 5
	close_connection($fd) unless ($foo = sysread($fd, $buffer, $len));
	# ++$client_seq{$fd};
	$payloadsuccess = 1;
	if ($foo <= 0) { # 6
		close_connection($fd);
	} # e 6
	} # e 5
	if ($type == 5) { # 5
	 serv_send("", 0, $fd, $flap_seq{$fd}, 5);
	 ++$flap_seq{$fd};
	 return("keepalive_frame");
	} # e 5
	else { # 5
	if ($payloadsuccess == 1) { # 6
	# print $buffer;
	return($buffer);
	} # e 6
	
	else { # 6
	print ("hmmmm");
	} # e 6
        } # e 5
	
	} # e 4
	
	else { # 4
		close_connection{$fd};
	      } # e 4
	} # e 3
	else { # 3
		
		close_connection{$fd};
	} # e 3
	} # e 2
	else { # 2
		close_connection{$fd};
	} # e 2
}

sub recieve_flapon {
	my $buffer;
	my ($fd) = @_;
	my $foo = sysread($fd, $buffer, 10);
	if ($foo <= 0) {
		close_connection($fd);
	}
	# print $buffer;
}

sub send_flap_signon {

	my ($fd, $ftype, $seqnum, $datlen1, $flapver) = @_;
	my ($datlen) = 4;
	my ($buffer) = pack("cCnnN", 54, $ftype, $seqnum, $datlen, $flapver);
# another way, use flap_send here
#	$buffer = pack(a, $flapver);
#	my ($datlen2) = $datlen1
#	serv_send($buffer, $datlen2, $fd, $seqnum, $ftype)
	my ($foo) = syswrite($fd, $buffer, 10);
	if ($foo <= 0) {
		close_connection($fd);
	}
}	

sub close_connection { # 1
	my ($fha) = @_;
	my $myusername = $userdb{$fha};
	my $thierusername;
	my $unixepoc = 0;
	my $arraycount;
	
	if ($signedon{"$fha"} == 1) { # 2
		# Send logoff update to all chat and im buddies, 
		# and remove db entries
		# chatdb
		# @userlist = 
		foreach $thierusername (@{$listenerslist{$myusername}}) { # 3
			
			
			my $tofd = $userdb{$thierusername};
			my $sendstring = "UPDATE_BUDDY:$myusername:F:0%:$unixepoc:0: O ";
			unless ($thierusername eq $myusername) {
			sflap_send($tofd, $sendstring);
			}
			my @grepreturn = grep(/^($myusername)$/, @{$listenerslist{$thierusername}});
			
			foreach my $incoming (@grepreturn) { # 4
				splice (@{$listenerslist{$thierusername}}, $incoming, 1);
			} # e 4
		} # e 3
		# broadcast_msg(@userlist)
		foreach my $inchatid (@{$usersubscribedto{$myusername}}) { # 3
		   # $inchatid = $_;
		   my @grepvals = grep(/^($myusername)$/, @{$chatdb{$inchatid}});
		   
		   foreach my $invals (@grepvals) {
		   	splice (@{$chatdb{$inchatid}}, $invals, 1);
		   }
		   
		   #foreach my $incoming (@{$chatdb{$inchatid}}) { # 4
		    
		   
		   # if ($myusername eq $incoming) { # 5
		   	# @{$chatdb{$inchatid}} = splice(@{$chatdb1{$inchatid}}, $offsetcnt, 1);
		   # }
		   # else {
		   # 	++$offsetcnt;
		   # } # e 5
		   # } # e 4
		   foreach($chatdb{$inchatid}) { # 4
 		   	my $incoming = $_;
		   	my $sendstring = "CHAT_UPDATE_BUDDY:$inchatid:F:$myusername";
		   	my $tofd = $userdb{$incoming};
		   	unless ($incoming eq $myusername) {
		   	send_sflap($tofd, $sendstring);
			}
	
	
		   } # e 4
	delete $usersubscribedto{$myusername};
	# this shouldnt be deleted
	# delete $listenerslist{$myusername};
	delete $listeningtolist{$myusername};
	
	} # e 3
	
	
	
	
	$readable->remove($fha);
	$fha->close;
	my $username = $userdb1{"$fha"};
	# toc_useroffline($username);
	if ($signedon{$fha} == 1) { # 3
	delete $userdb{"$myusername"};
	delete $userdb1{"$fha"};
	}
	elsif ($signonmode{$fha} > 2) { # 3
	delete $pre_userdb{$myusername};
	delete $pre_userdb1{$fha};
	}
	delete $signonmode{"$fha"};
	delete $connectionmode{"$fha"};
	delete $signedon{"$fha"};
	
	
} # e 2
}

sub recieve_flap_signon { # 1 
	# recieve FLAP SIGNON
	my $flapver;
	my $tlv;
	my $snlen;
	my $snnom;
	# my $datlen;
	# my $seqnum;
	# my $aster;
	
	
	my ($fd) = @_;
	my ($buffer) = '';
	my ($foo) = sysread($fd, $buffer, 6);
	if ($foo <= 0) { # 2
		close_connection($fd);
	} #  e 2
	# print ("$buffer");
	my ($aster, $ftype, $seqnum, $datlen) = unpack("aCnn", $buffer);
	print "test";
	if ($aster eq "*") { # 2
		print "test1";
		if ($ftype == 1) { # 3
			print "test2";
	$client_seq{$fd} = $seqnum;
	++$client_seq{$fd};
	$foo = sysread($fd, $buffer, $datlen);
	if ($foo <= 0) { # 4
		close_connection($fd);
	} # e 4
	($flapver, $tlv, $snlen, $snnom) = unpack("Nnna*", $buffer);
	} # e 3
	
	else { # 3
		close_connection($fd);
	} # e 3
	} # e 2
	else { # 2
		close connection($fd);
	} # e 2
	
	print $snnom;
#	$len = length($buffer);
#	$foo = CORE::sysread($fd, $buffer, $len + 1);
#	($1, $2) = unpack("*aC", $buffer);
}

# if ($useauth == 1) {
# untie %userpassdb;
# }