view release on metacpan or  search on metacpan

lib/AnyEvent/MSN/Protocol.pm  view on Meta::CPAN

package AnyEvent::MSN::Protocol;
{ $AnyEvent::MSN::Protocol::VERSION = 0.002 }
use 5.012;
use AnyEvent;
use MIME::Base64 qw[];
use Digest::HMAC qw[hmac];
use Digest::SHA qw[];
use Digest::MD5 qw[];
use Crypt::CBC qw[];

sub anyevent_read_type {
    my ($handle, $s) = @_;
    sub {
        return if !length $handle->{rbuf};
        $handle->{rbuf} =~ s[^([^\015\012]*)\015?\012][] or return;
        my $line = $1;
        AnyEvent::MSN::DEBUG() && warn 'I: ' . $line;
        $s->(split qr[\s+], $line);    # my ($cmd, $tid, @data)
        $handle->push_read(__PACKAGE__, $s);    # Re-queue
        return 1                                # But remove this one
        }
}

sub anyevent_write_type {    # XXX - Currently... not... right.
    my ($handle, @args) = @_;
    my $out = sprintf shift(@args), grep {defined} @args;
    AnyEvent::MSN::DEBUG() && warn 'O: ' . $out;
    return $out . ($out =~ m[^(QRY|UUX|ADL|PUT|SDG)] ? '' : "\015\012");
}

sub __parse_msn_headers {
    state $hp //= sub {
        map { split qr[\s*:\s*], $_, 2 }
            split qr[\015?\012],
            shift;
    };
    my ($h1, $h2, $h3, $body) = split qr[\015?\012\015?\012], shift, 4;
    ({map { $hp->($_) }
      grep { defined && length } $h1, $h2, $h3
     },
     $body
    );
}

# Auth stuff
sub derive_key {
    my ($key, $magic) = @_;
    $magic = 'WS-SecureConversationSESSION KEY ' . $magic;
    my $hash1 = hmac($magic,          $key, \&Digest::SHA::sha1);
    my $hash2 = hmac($hash1 . $magic, $key, \&Digest::SHA::sha1);
    my $hash3 = hmac($hash1,          $key, \&Digest::SHA::sha1);
    my $hash4 = hmac($hash3 . $magic, $key, \&Digest::SHA::sha1);
    my $derived_key = $hash2;
    $derived_key .= substr($hash4, 0, 4);
    return $derived_key;
}

sub SSO {
    my ($nonce, $secret, $iv) = @_;

    # 1. Base64 decode binary secret
    my $key1 = MIME::Base64::decode_base64($secret);

    # 2a. key2 and key3
    my $key2 = derive_key($key1, 'HASH');
    my $key3 = derive_key($key1, 'ENCRYPTION');

    # 3. hash
    my $hash = Digest::HMAC::hmac($nonce, $key2, \&Digest::SHA::sha1);

    # 4. Pad nonce with 8 bytes of \08
    my $p_nonce = $nonce . (chr(8) x 8);

    # 5. Create 8 bytes of random data as iv
    $iv //= Crypt::CBC->random_bytes(8);

    # 6. TripleDES CBC encryption
    my $encrypted_data =
        Crypt::CBC->new(-literal_key => 1,
                        -key         => $key3,
                        -iv          => $iv,
                        -header      => 'none',
                        -cipher      => 'Crypt::DES_EDE3'
        )->encrypt($p_nonce);

    # 7. Fill in the struct
    my $struct = pack 'I7 A8 A20 A72', 28, 1, 0x6603, 0x8004, 8, 20, 72,
        $iv,