source: perl/modules/AIM/lib/Net/OSCAR/Connection/Server.pm @ 3dcccba

=pod

Net::OSCAR::Connection::Server -- Net::OSCAR server connection

=cut

package Net::OSCAR::Connection::Server;

$VERSION = '1.925';
$REVISION = '$Revision: 1.5 $';
@ISA = qw(Net::OSCAR::Connection);

use strict;
use vars qw($VERSION @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;