File: //usr/local/share/perl5/Net/OSCAR/Connection/Server.pm
=pod
Net::OSCAR::Connection::Server -- Net::OSCAR server connection
=cut
package Net::OSCAR::Connection::Server;
BEGIN {
$Net::OSCAR::Connection::Server::VERSION = '1.928';
}
$REVISION = '$Revision$';
@ISA = qw(Net::OSCAR::Connection);
use strict;
use vars qw(@ISA);
use Carp;
use Socket;
use Symbol;
use Net::OSCAR::Common qw(:all);
use Net::OSCAR::Constants;
use Net::OSCAR::Connection;
use Net::OSCAR::ServerCallbacks;
sub new($@) {
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->listen($self->{session}->{port}) unless exists($self->{socket});
$self->{oscar_state} = "listening";
$self->{signon_done} = 0;
return $self;
}
sub process_one($;$$$) {
my($self, $read, $write, $error) = @_;
my $snac;
if($error) {
$self->{sockerr} = 1;
return $self->disconnect();
}
if($write && $self->{outbuff}) {
$self->log_print(OSCAR_DBG_DEBUG, "Flushing output buffer.");
$self->flap_put();
}
if($read && !$self->{connected}) {
$self->log_print(OSCAR_DBG_NOTICE, "Incoming connection.");
my $socket = gensym();
accept($socket, $self->{socket});
my $peer = $self->{session}->addconn(socket => $socket, conntype => CONNTYPE_SERVER, description => "new peer");
$peer->set_blocking(0);
$peer->{connected} = 1;
$peer->{state} = "write";
$peer->{oscar_state} = "new";
$self->{session}->callback_connection_changed($peer, "write");
return 1;
} elsif($write and $self->{oscar_state} eq "new") {
$self->log_print(OSCAR_DBG_DEBUG, "Putting connack.");
$self->flap_put(pack("N", 1), FLAP_CHAN_NEWCONN);
$self->{state} = "readwrite";
$self->{session}->callback_connection_changed($self, "readwrite");
$self->{oscar_state} = "ready";
$self->{families} = {};
$self->{families}->{$_} = 1 foreach (1..30);
} elsif($read) {
my $no_reread = 0;
while(1) {
my $flap = $self->flap_get($no_reread) or return 0;
next if length($flap) == 4;
my $snac = $self->snac_decode($flap) or return 0;
Net::OSCAR::ServerCallbacks::process_snac($self, $snac);
} continue {
$no_reread = 1;
}
}
}
1;