package Net::MSN;
use strict;
use warnings FATAL => ('all');

# MSN.pm, 0.2, amoe, 23/02/2002

use Digest::MD5 'md5_hex';
use IO::Select;
use IO::Socket;
use URI::Escape;

# remote line terminator
my $n = "\015\012";

# msn protocol versions we support
my %protos = (4 => 1,
              5 => 1,
              6 => 1,
              7 => 1,
             );

# commands that don't send transaction ids
my %exception = (RNG => 1,
                 MSG => 1,
                 );

# default notification server/port combo
my $def_ns = '64.4.13.58:1863';

# Public methods

sub new {
    my $class = shift;
    
    # allow caller to supply an alternative server
    my $notification_server = shift || $def_ns;
    my $socket = IO::Socket::INET->new($notification_server)
        or die "couldn't connect to $notification_server: $!";
    
    return bless {tids         => [-1],            # gets incremented 
+to 1
                  notification => $socket,
                  logged_in    => 0}, $class;
}

sub login {
    my ($self, $email, $password) = @_;
    $self->email($email);                    # stow the email for late
+r
    
    my $res = $self->_authenticate($email);
    
    if ($res->[0] eq 'XFR') {
        # switch server
        my $new_ns = IO::Socket::INET->new($res->[2])
            or die "couldn't connect to $res->[2]: $!";
        $self->notification($new_ns);
        
        # try again
        $res = $self->_authenticate($email);
    }
    
    # hash the combinination of the password
    # and the hash the server sent us
    my $combined = md5_hex($res->[3], $password);
    $res = $self->send_cmd(qw{USR MD5 S}, $combined);
    
    return 0 if $res->[1] ne 'OK';
    
    $self->logged_in(1);
    return uri_unescape($res->[3]);
}

# Building block methods

sub send_cmd {
    my $self   = shift;
    my $setup  = {};
    
    # if the last param is a hashref,
    # pop it and treat it as config
    $setup     = pop if ref $_[-1] eq 'HASH';
    
    # the rest is the raw command
    my @bits   = @_;
    
    # assume a server if not provided
    $setup->{socket} ||= $self->logged_in
        ? $self->switchboard
        : $self->notification;
    $setup->{tid} ||= -1;
    
    my $server = $setup->{socket};
    
    # increment tid
    $self->tids($setup->{tid}, $self->tids($setup->{tid}) + 1);
    
    # put in the transaction id and join
    my $req = join(' ', do { splice @bits, 1, 0, $self->tids($setup->{
+tid}); @bits }) . $n;
    
    print "sending $req";            # for debug
    print $server $req;
    
    my $selecta = IO::Select->new($server);
    my @res;
    while ((my $conn) = $selecta->can_read(1)) {
        defined(my $line = <$conn>) or last;
        my @words = split /\s+/,
                          do { local $/ = $n; chomp $line; $line };
        
        # splice out the tid if it was sent
        splice @words, 1, 1
            if $words[0] && !$exception{$words[0]};
        push @res, @words;
    }
    
    print "received @res\n";            # for debug
    return \@res;
}

# wield() - wait for the server to send us something, then call the cl
+ient

sub wield {
    my ($self, $dispatch, $timeout, @sockets) = @_;
    
    my $selecta = IO::Select->new(@sockets);
    while (1) {
        while (my @ready = $selecta->can_read($timeout)) {
            for (@ready) {
                defined(my $line = <$_>) or next;
                
                # parse
                my @words = split /\s+/,
                      do { local $/ = $n; chomp $line; $line };
                
                my $command = $words[0];
                my $coderef;
                
                # splice out the tid
                splice @words, 1, 1
                    unless $exception{$command};
                
                # call the relavent callback
                $coderef->(@words)
                    if defined($coderef = $dispatch->{$command});
            }
        }
    }
}

# wieldcap() - a wrapper around wield for simple wielding

sub wieldcap {
    my ($self, $command, $timeout) = @_;
    
    # call wield with an instruction to die as soon as we get sent
    # the command. bundle up what we were sent in the die message.
    
    unless (eval {
                $self->wield({$command => sub { die "WIELDCAP: @_" }},
+ $timeout);
                1;
            }) {
            
        # make sure it was really our message
        die unless (my $res = $@) =~ s/^WIELDCAP: //;
        
        # resurrect the message
        return split /\s+/, $res;
    }
    
    return;        # undef
}

# Accessors

# autoload accessors
sub AUTOLOAD {
    my $self = shift;
    my $name = our $AUTOLOAD;
    return if $name =~ /::DESTROY$/;
    $name =~ s/^Net::MSN:://;
    
    return @_
        ? ($self->{$name} = shift)
        : $self->{$name};
}

# select-a-tid

sub tids {
    my $self = shift;
    my $index = shift;
    
    if (defined $index) {
        return @_
            ? ($self->{tids}->[$index] = shift)
            : $self->{tids}->[$index];
    } else { return $self->{tids} }
}

# Private methods

# authenticate someone to some server
sub _authenticate {
    my ($self, $email) = @_;
    
    # agree on a protocol (list operator heaven?)
    my $res = $self->send_cmd('VER',
                              map({ "MSNP$_" } sort { $b <=> $a } keys
+ %protos),
                              'CVRO');
    die "protocol incompatibility: @$res"
        if !grep { $protos{$_} } map { substr($_, 4) } do { shift @$re
+s; @$res };
    
    # agree on an encryption scheme
    $res = $self->send_cmd(qw{INF});
    die "encryption incompatibility: $res->[1]"
        if $res->[1] ne 'MD5';
    
    # ask if this man know who we are
    $res = $self->send_cmd(qw{USR MD5 I}, $email);
    
    # return what he said
    return $res;
}

__END__
pod goes here (or should i splice it in with the code?)
[download]

As background: a transaction id ("tid") is what the client and server send in all their conversations. It gets incremented for each message you send, but you can have more than one at once, hence the arrays. The design of that aspect in particular confuses me, and I wrote the code. The whole protocol is here.

All suggestions welcome. Thanks in advance.