Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

sockets and object-oriented design with Net::MSN

by Amoe (Friar)
on Mar 16, 2002 at 16:36 UTC ( #152194=perlquestion: print w/ replies, xml ) Need Help??
Amoe has asked for the wisdom of the Perl Monks concerning the following question:

I've been receiving help (read: "leeching") from the Perl community so long that I thought it was probably time to give something back. I'm a regular user of the M$ hellspawn MSN Instant Messenger, and I know the protocol due to the fact that a friend of mine developed his own client for it, and I helped. I thought this might be a good thing to make a CPAN module of. Trouble is, this is my first real foray into the (ultra-cool) world of object-oriented programming, and I don't have a lot of experience with sockets either.

Not to be discouraged, I struggled bravely on. I finished a kind of really early version, but it kept on mysteriously failing; actually, about one-third of the time it worked, and two-thirds of the time it gave errors. I decided to rewrite the whole thing, and so far I seem to have made a progress. The login sub seems to work reliably now. I'm having doubts, though. I've tried to put in most of the functionality I'll need later (when receiving messages) in earlier this time, so I don't have to retrofit it into the design. Basically, I have hardly any experience in this field, and I want to know if this is a solid base to build on, so I don't have to rewrite it all over again if I carry on. I've tried to study other people's modules, but I find them hard to decipher. Could you please take a cursory glance over this code and tell me any glaring problems you see?

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?)

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.


--
my one true love

Comment on sockets and object-oriented design with Net::MSN
Download Code
Re: sockets and object-oriented design with Net::MSN
by Juerd (Abbot) on Mar 16, 2002 at 18:12 UTC

    Just as a side note, there's an object oriented MSN.pm module shipped with the console client jMSN.

    U28geW91IGNhbiBhbGwgcm90MTMgY
    W5kIHBhY2soKS4gQnV0IGRvIHlvdS
    ByZWNvZ25pc2UgQmFzZTY0IHdoZW4
    geW91IHNlZSBpdD8gIC0tIEp1ZXJk
    

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://152194]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (8)
As of 2014-07-29 22:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (229 votes), past polls