#
# FNET/ICB CLIENT 1.4   11/9/97
# John M Vinopal        banshee@resort.com
#
# Copyright (C) 1996, 1997, The Resort, All Rights Reserved.
# Permission is granted to copy and modify this program for
# non-commercial purposes, so long as this copyright notice is
# preserved.  This software is distributed without warranty.
#
=head1 NAME

FNET -- provide an object oriented interface to an fnet server.

=head1 SYNOPSIS

        use FNET;
        
		$obj = new FNET(connection vars);
		$FNET->csendopen($msg);
		($type, @msg) = $FNET->readit();

=head1 DESCRIPTION

FNET or ICB is an old chat protocol dating back to 1987.  The original
code was written in fortran on some godforsaken machine in UKY by Sean
Casey.  After the server was rewritten in C, servers sprung up and died
over the years.  As of 1997, approximately 4 public servers run, the most
popular of which peaks at ~150 people.

Connections are to port 7326.  The westcoast server is icb.evolve.com.

=cut

package FNET;

require 5.000;
use strict;
use IO::Socket;
use Carp;
use vars qw($M_LOGIN $M_LOGINOK $M_OPEN $M_PERSONAL $M_STATUS $M_ERROR
			$M_IMPORTANT $M_EXIT $M_COMMAND $M_CMDOUT $M_PROTO
			$M_BEEP $M_PING $M_PONG $M_OOPEN $M_OPERSONAL);
#use diagnostics;
require Exporter;

@FNET::ISA = qw(Exporter);
@FNET::EXPORT = qw(	$M_LOGIN $M_LOGINOK $M_OPEN $M_PERSONAL $M_STATUS $M_ERROR
				$M_IMPORTANT $M_EXIT $M_COMMAND $M_CMDOUT $M_PROTO $M_BEEP
				$M_PING $M_PONG $M_OOPEN $M_OPERSONAL );

my $fhcnt = 0;	# File handle counter, to insure unique socket.
my $A = "\001";	# Packet argument delimiter.

$M_LOGIN		= 'a';     # login packet 
$M_LOGINOK		= 'a';     # login packet 
$M_OPEN			= 'b';     # open msg to group 
$M_PERSONAL		= 'c';     # personal msg 
$M_STATUS		= 'd';     # status update message 
$M_ERROR		= 'e';     # error message 
$M_IMPORTANT	= 'f';     # special important announcement 
$M_EXIT			= 'g';     # tell other side to exit 
$M_COMMAND		= 'h';     # send a command from user 
$M_CMDOUT		= 'i';     # output from a command 
$M_PROTO	 	= 'j';     # protocol version information 
$M_BEEP			= 'k';     # beeps 
$M_PING			= 'l';     # ping packet 
$M_PONG			= 'm';     # return for ping packet 
$M_OOPEN		= 'n';     # for own open messages 
$M_OPERSONAL	= 'o';     # for own personal messages 

# Create a new fnet socket and connect to a server.
# new($class,$hostname,$portnumber,$id,$nick,$group,$cmd,$passwd)
sub new
{
	my $class = shift;
	my $self = {};
	bless $self, $class;
	$self->{'SOCK'} = 'SOCK'.$fhcnt++;
	if ($self->login(@_)) {
		return ($self);
	}
}

sub DESTROY {
    my ($self) = @_;
    close($self->{'SOCK'});
	undef $self;
}

# Open the tcp connection and send our login packet.
# login($self, $hostname,$portnumber,$id,$nick,$group,$cmd,$passwd)
#
sub	login
{
	my $self = shift;
	my $hostname = shift;
	my $portnumber = shift;

	if (not ($self->{'SOCK'} = $self->tcpopen($hostname,$portnumber))) {
		carp "Failed to connect: ";
		return;
	}
	if (not ($self->sendlogin(@_))) {
		carp "Login failed: ";
		return;
	}
	return 1;
}

#sub	sendlogin(self, id, nick, group, command, passwd)
# Sends a login packet to the server.  It specifies our login name,
# nickname, active group, a command "login" or "w", and our passwd.
sub	sendlogin
{
	my	$self = shift;
# Just pack them up; these are the vars.
#	my	($self, $id, $nick, $group, $cmd, $passwd) = @_;
	my	($pbuf);
	
	$pbuf = $M_LOGIN . join($A, @_);
	if ($self->sendit($pbuf)) {
		return "ok";
	}
}

# Open packet.
sub	csendopen
{
	my	($self, $txt) = @_;
	my	($pbuf);
	
	$pbuf = $M_OPEN.$txt;
	if ($self->sendit($pbuf)) {
		return "ok";
	}
}

# Ping reply.
sub	sendpong
{
	my	($self) = @_;
	my	($pbuf) = $M_PONG;

	if ($self->sendit($pbuf)) {
		return "ok";
	}
}


# Server command.
#sub	sendcmd(cmd, args)
sub	sendcmd
{
	my	($self, $cmd, $args) = @_;
	my	($pbuf);

	$pbuf = $M_COMMAND.$cmd.$A;
	if (defined($args)) {
		$pbuf .= $args;
	}

	if ($self->sendit($pbuf)) {
		return "ok";
	}
}


#
# Send a packet over a connected socket.
#
sub	sendit
{
	my	($self, $packet) = @_;
	my  ($socket) = $self->{'SOCK'};
	my	($plen) = length($packet) + 1;	# Size plus null.
	my	($wrotelen);

	# Add the packet length to the packet head.
	$packet = chr($plen).$packet."\0";
	$plen = length($packet);

	$wrotelen = send($socket, $packet, 0);
	if (not defined($wrotelen)) {
		carp "error on send: ";
	} elsif ($wrotelen != $plen) {
		carp "error: wrote $wrotelen of $plen: ";
	} else {
		return "ok";
	}
	return;
}


#
# Read from the connected socket any pending data.
#
sub	readit
{
	my ($self) = @_;
	my ($socket) = $self->{'SOCK'};
	my ($sbuf, $buffer, $pbuf, $ret) = ('', '', '', 0);

	$ret = recv($socket, $sbuf, 1, 0);		# Read a byte of packet length.
	if (not defined($ret)) {
		carp "error on size read: ";
	} elsif (length($sbuf) != 1) {
		carp "error: size read ", length($sbuf), " of 1: ";
	} else {
		# Convert char to integer.
		$sbuf = ord($sbuf);
		while ($sbuf) {						# Read the entire packet.
			$ret = recv($socket, $pbuf, $sbuf, 0);
			if (not defined($ret)) {
				carp "error on msg read: ";
			} else {
				$sbuf -= length($pbuf);
				$buffer = $buffer.$pbuf;
			}
		}
		my ($type, $buf) = unpack("aa*", $buffer);
		my @split = splitpacket($buf);
		return ($type, @split);
	}
	return;
}

# Split packet on delimiter.
sub	splitpacket
{
	return(split($A, $_[0]));
}

#	tcpopen(hostname,portnumber);
#	Returns a connected socket if all goes well.
sub	tcpopen
{
	my ($self,$hostname,$portnumber) = @_;

	my $SOCK = new IO::Socket::INET(
								PeerAddr => $hostname,
								PeerPort => "($portnumber)",
								Proto	 => 'tcp');

	return $SOCK;
}

1;
