#
 # Copyright (c) 2001 Uiewera 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 ($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);
	 $chatid = 0;
	 



	while(1) { # 1
          # $client->autoflush(1);
 	my ($ready) = IO::Select->select($readable, undef, undef, undef);
 	foreach my $s (@$ready)
 	{ # 2
          # $hostinfo = gethostbyaddr($client->peeraddr);
 	# printf "[Connect from %s]\n", $hostinfo->name || $client->peerhost;                                                      

	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
	{ # 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);
my @parse_toc_signon_str = MISC::parse_tocclientmsg($toc_signon_str);


if ($parse_toc_signon_str[1] eq "toc_signon") {
	#toc_cmd auth_host auth_port username pass lang ver
   my $toc_passwd = TOCUNRST::toc_unroast($parse_toc_signon_str[5]);
   print("123");
   print($parse_toc_signon_str[4]);
   print("123");
   $pre_userdb{$parse_toc_signon_str[4]} = $s;
   $pre_userdb1{$s} = $parse_toc_signon_str[4];
   # toc_useronline($parse_toc_signon_str[4]);
}
else {
   close_connection($s);
}

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;

# client to server toc_cmd
# server to client IM_IN fromuser autorespT/F msg
if ($userdb{$parsedtoc[2]}) { # 2
	$tofd = $userdb{$parsedtoc[2]};
	$username = $userdb1{$tofd};
	if ($username eq $parsedtoc[2]) { # 3
# $recvbuffer2 ="IM_IN:System\@mydomain.com:F:{$parsedtoc[1]}{$parsedtoc[2]}message:{$parsedtoc[3]}";
$fromuser = $userdb1{$s};
$tofd = $userdb{$parsedtoc[2]};
$tosend1="IM_IN:$fromuser:$parsedtoc[3]:$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);
# ++$seq11;
# $len11 = length($recvbuffer2);
# ++$flap_seq{$s} if serv_send($recvbuffer2, $len11, $fd, $flap_seq{$s}, 2);
# ++$seq11;
} # e 3
else { # 3
	#db not right
} # e 3
} # e 2
else { # 2
	print "user doesnt exist";
	#user doesnt exist
} # 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;
	$userdb{$myusername} = $pre_userdb{$myusername};
	delete $pre_userdb{$myusername};
	$userdb1{$s} = $pre_userdb1{$s};
	delete $pre_userdb1{$s};
	$signedon{$fd} = 1;
	print("tocinit");
	print("$userdb1{$s}");
	print("tocinit");
	if (@listenerslist{$myusername}) { # 2
	foreach my $incoming (@listenerslist{$myusername}) { # 3
		# my $incoming;
		# $incoming = $_;
		my ($tofd) = $userdb{"$myusername"};
		# $signedon{$fd} = 1;
		my ($sendstring) = "UPDATE_BUDDY:$myusername:T:0%:$unixepoc:0: O ";
		sflap_send($tofd, $sendstring);
 	} # e 3
	} # e 2	
	if (@listeningtolist{$myusername}) { # 2
	foreach my $inusername (@listeningtolist{$myusername}) { # 3
		# $incoming = $_;
		if ($userdb{$inusername}) { # 4
		my ($sendstring) = "UPDATE_BUDDY:$inusername:T:0%:$unixepoc:0: O ";
		sflap_send($s, $sendstring);
		} # e 4
	} # 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;
	shift(@userlist);
	foreach $buddy2 (@userlist) {
	# $buddy2 = $_;
	
	
	push(@{$listenerslist{$buddy2}}, $myusername);
	push(@{$listeningtolist{$myusername}}, $buddy2);
	if ($signedon{$s} == 1) {
	if ($userdb{$buddy2}) {
	
	my $sendstring = "UPDATE_BUDDY:$buddy2:T:0%:$unixepoc:0: O ";
	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";	
}

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

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

elsif ($parsedtoc[1] eq "toc_chat_join") {
	my $chatid;
	my $chatroomid;
	my $chatupdate;
	my $chatupdatestr;
	my @temparray;
	my $usernamelist;
	my $sendstring;
	my $tofd;
	
	#exchange roomname
	if (exists($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);
	
	foreach my $username (@temparray) {
		
	# $username = $_;
		$tofd = $userdb{$username};
		$chatupdate = "CHAT_UPDATE:$chatroomid:T:$myusername";
		sflap_send($tofd, $chatupdate);
		
	}
	sflap_send($fd, $chatupdatestr);
}

elsif ($parsedtoc[1] eq "toc_chat_send") { # 1
my $bgcnt;
my $message;
my $auto;
my $chatid;
my @userlist;
my $split1;
my $split2;
my @rollarray;
my $rollsize;
my $dice;
my $sides;
my $rollarg1len;
my $rolltestchar;
my $dicestring;
my $diceval;
my $chatroomid;

$bgcnt = 0;
$message = $parsedtoc[2];
$auto = $parsedtoc[3];
$chatid = $parsedtoc[2];
$chatroomid = $chatid;
@userlist = @chatdb{$chatid};
shift(@userlist);
	
($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) {
				$dice = 2;
				$sides = 6;
			}
			else {
				
				$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";	
			}
			my $i;
			for ($i=0;$i<$dice;$i++) {
			$diceval = rand $sides;
			$dicestring = $dicestring . $diceval;
			}
			
	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;
	
	$chatid = $parsedtoc[2];
	$dstuser = $parsedtoc[3];
	$message = $parsedtoc[4];
	
	$tofd = $userdb{$dstuser};
	$sendstring = "CHAT_IN:$chatid:$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 = $_;
		my $tofd = $userdb{$username};
		
		$sendstring = "CHAT_INVITE:$roomname:$roomid:$myusername:$message";
		sflap_send($tofd, $sendstring);
	}
}

elsif ($parsedtoc[1] eq "toc_chat_leave") {
	my $chat_left;
	my @chatarray;
	my $bgcnt;
	my $arraycount = 0;
	my $chatupdate;
	my $chatroomid = $parsedtoc[2];
	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);
	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") {
# $tocustatusdb{"$myusername"}[8] = " OA"
# $sendstring = "UPDATE_BUDDY:$username

}

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") {
	# $tocustatusdb{"$myusername"}[10] = $awaytime;
	# $sendstring = "UPDATE_BUDDY:";
	# 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 "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 broadcast_msg {
	my @incomingarray = @_;
	my $sendstring = pop(@incomingarray);
	
	foreach my $incoming (@incomingarray) {
		# $incoming = $_;
		my $tofd = $userdb{"$incoming"};
		sflap_send($tofd, $sendstring);
	}
}	

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

sub toc_useronline {
	print("hmmm");
}

sub tocuseroffline {
	print("hmmm");
	
}

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 $resultval = grep (/^($chatid)$/, @usersubscribedto{$myusername});
	unless ($resultval > 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 {
	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);
	++$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);
	}
	
}	

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);
			}
			foreach my $incoming (@listenerslist{$thierusername}) { # 4
				my $offset;
				$offset = $arraycount;
				# $incoming = $_;
				if ($incoming eq $myusername) { # 5
				  @listenerslist{$thierusername} = splice(@{$listenerslist{$thierusername}}, $offset, 1);
				}
				else {
					++$arraycount;
				} # e 5
			} # e 4
		} # e 3
		# broadcast_msg(@userlist)
		foreach my $inchatid (@usersubscribedto{$myusername}) { # 3
		   # $inchatid = $_;
		   foreach($chatdb{$inchatid}) { # 4
		   my $offsetcnt = 0; 
		   my $incoming = $_;
		   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};
	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);
}