File Coverage

blib/lib/Net/BitTorrent/Protocol.pm

Criterion	Covered	Total	%
statement	61	62	98.3
branch	14	18	77.7
condition	10	14	71.4
subroutine	15	15	100.0
pod	1	1	100.0
total	101	110	91.8

package Net::BitTorrent::Protocol;
use strict;
use warnings;
our $VERSION = "1.5.1";
use lib '../../../lib';
use Net::BitTorrent::Protocol::BEP03 qw[:all];
use Net::BitTorrent::Protocol::BEP03::Bencode qw[:all];
use Net::BitTorrent::Protocol::BEP05 qw[:all];
use Net::BitTorrent::Protocol::BEP06 qw[:all];
use Net::BitTorrent::Protocol::BEP07 qw[:all];
use Net::BitTorrent::Protocol::BEP09 qw[:all];
use Net::BitTorrent::Protocol::BEP10 qw[:all];
use Net::BitTorrent::Protocol::BEP23 qw[:all];
#use Net::BitTorrent::Protocol::BEP44 qw[:all];
use Carp qw[carp];
use vars qw[@EXPORT_OK %EXPORT_TAGS];
use Exporter qw[];
*import = *import = *Exporter::import;
%EXPORT_TAGS = (
    build => [@{$Net::BitTorrent::Protocol::BEP03::EXPORT_TAGS{build}},
              @{$Net::BitTorrent::Protocol::BEP05::EXPORT_TAGS{build}},
              @{$Net::BitTorrent::Protocol::BEP06::EXPORT_TAGS{build}},
              @{$Net::BitTorrent::Protocol::BEP09::EXPORT_TAGS{build}},
              @{$Net::BitTorrent::Protocol::BEP10::EXPORT_TAGS{build}},
              #@{$Net::BitTorrent::Protocol::BEP44::EXPORT_TAGS{build}}
    ],
    bencode => [@{  $Net::BitTorrent::Protocol::BEP03::Bencode::EXPORT_TAGS{all}
                },
    ],
    compact => [@{$Net::BitTorrent::Protocol::BEP07::EXPORT_TAGS{all}},
                @{$Net::BitTorrent::Protocol::BEP23::EXPORT_TAGS{all}}
    ],
    dht => [@{$Net::BitTorrent::Protocol::BEP05::EXPORT_TAGS{all}},
            #@{$Net::BitTorrent::Protocol::BEP44::EXPORT_TAGS{build}}
    ],
    parse => [@{$Net::BitTorrent::Protocol::BEP03::EXPORT_TAGS{parse}},
              @{$Net::BitTorrent::Protocol::BEP06::EXPORT_TAGS{parse}},
              @{$Net::BitTorrent::Protocol::BEP10::EXPORT_TAGS{parse}},
              qw[parse_packet]
    ],
    types => [@{$Net::BitTorrent::Protocol::BEP03::EXPORT_TAGS{types}},
              @{$Net::BitTorrent::Protocol::BEP06::EXPORT_TAGS{types}},
              @{$Net::BitTorrent::Protocol::BEP10::EXPORT_TAGS{types}}
    ],
    utils => [@{$Net::BitTorrent::Protocol::BEP06::EXPORT_TAGS{utils}}]
);
@EXPORT_OK = sort map { @$_ = sort @$_; @$_ } values %EXPORT_TAGS;
$EXPORT_TAGS{'all'} = \@EXPORT_OK;
my $parse_packet_dispatch;
#
sub parse_packet ($) {
    $parse_packet_dispatch ||= {$KEEPALIVE      => \&parse_keepalive,
                                $CHOKE          => \&parse_choke,
                                $UNCHOKE        => \&parse_unchoke,
                                $INTERESTED     => \&parse_interested,
                                $NOT_INTERESTED => \&parse_not_interested,
                                $HAVE           => \&parse_have,
                                $BITFIELD       => \&parse_bitfield,
                                $REQUEST        => \&parse_request,
                                $PIECE          => \&parse_piece,
                                $CANCEL         => \&parse_cancel,
                                $PORT           => \&parse_port,
                                $SUGGEST        => \&parse_suggest,
                                $HAVE_ALL       => \&parse_have_all,
                                $HAVE_NONE      => \&parse_have_none,
                                $REJECT         => \&parse_reject,
                                $ALLOWED_FAST   => \&parse_allowed_fast,
                                $EXTENDED       => \&parse_extended
    };
    my ($data) = @_;
    if ((!$data) || (ref($data) ne 'SCALAR') || (!$$data)) {
        carp sprintf '%s::parse_packet() needs data to parse', __PACKAGE__;
        return;
    }
    my ($packet);
    if (unpack('c', $$data) == 0x13) {
        my @payload = parse_handshake(substr($$data, 0, 68, ''));
        $packet = {type           => $HANDSHAKE,
                   packet_length  => 68,
                   payload_length => 48,
                   payload        => @payload
            }
            if @payload;
    }
    elsif (    (defined unpack('N', $$data))
           and (unpack('N', $$data) =~ m[\d]))
    {   my $packet_length = unpack('N', $$data);
        if ($packet_length + 4 <= length($$data)) {
            (my ($packet_data), $$data) = unpack('N/aa*', $$data);
            my $packet_length = 4 + length $packet_data;
            (my ($type), $packet_data) = unpack('ca*', $packet_data);
            if (defined $parse_packet_dispatch->{$type}) {
                my $payload = $parse_packet_dispatch->{$type}($packet_data);
                $packet
                    = ref $payload eq 'HASH'
                    && defined $payload->{error} ? $payload
                    : {type          => $type,
                       packet_length => $packet_length,
                       (defined $payload ? (
                                         payload        => $payload,
                                         payload_length => length $packet_data
                            )
                        : (payload_length => 0)
                       ),
                    };
            }
            elsif (eval 'require Data::Dump') {
                carp
                    sprintf
                    <<'END', Data::Dump::pp($type), Data::Dump::pp($packet);
Unhandled/Unknown packet where:
Type   = %s
Packet = %s
END
            }
        }
        else {
            $packet = {packet_length => $packet_length,
                       fatal         => 0,
                       error         => 'Not enough data yet! We need '
                           . $packet_length
                           . ' bytes but have '
                           . length $$data
            };
        }
    }
    return $packet;
}
1;

=pod

=head1 NAME

Net::BitTorrent::Protocol - Basic, Protocol-level BitTorrent Utilities

=head1 Synopsis

    use Net::BitTorrent::Protocol;
    ...

=head1 Functions

In addition to the functions found in L,
L,
L, L,
L, L,
L, L,
TODO..., a function which wraps all the packet parsing functions is provided:

=over

=item C

Attempts to parse any known packet from the data (a scalar ref) passed to it.
On success, the payload and type are returned and the packet is removed from
the incoming data reference. C is returned on failure and the data
in the reference is unchanged.

=back

=head1 Importing from Net::BitTorrent::Protocol

You may import from this module manually...

    use Net::BitTorrent::Protocol 'build_handshake';

...or by using one or more of the provided tags:

    use Net::BitTorrent::Protocol ':all';

Supported tags include...

=over

=item C

Imports everything.

=item C

Imports all packet building functions from
L,
L,
L,
L, and
L.

=item C

Imports the bencode and bdecode functions found in
L.

=item C

Imports the compact and inflation functions for IPv4
(L) and IPv6
(L) peer lists.

=item C

Imports all functions related to L and
L.

=item C

Imports all packet parsing functions from
L,
L, and
L as well as the locally defined
L|/parse_packet( \$data )> function.

=item C

Imports the packet type values from L,
L, and
L.

=item C

Imports the utility functions from L.

=back

=head1 See Also

L - Simple client which uses
L

http://bittorrent.org/beps/bep_0003.html - The BitTorrent Protocol
Specification

http://bittorrent.org/beps/bep_0006.html - Fast Extension

http://bittorrent.org/beps/bep_0009.html - Extension for Peers to Send Metadata Files

http://bittorrent.org/beps/bep_0010.html - Extension Protocol

http://bittorrent.org/beps/bep_0044.html - Storing arbitrary data in the DHT

http://wiki.theory.org/BitTorrentSpecification - An annotated guide to
the BitTorrent protocol

L - by Joshua
McAdams

L - by Tom Molesworth

=head1 Author

Sanko Robinson  - http://sankorobinson.com/

CPAN ID: SANKO

=head1 License and Legal

Copyright (C) 2008-2014 by Sanko Robinson

This program is free software; you can redistribute it and/or modify it under
the terms of
L.
See the F file included with this distribution or
L
for clarification.

When separated from the distribution, all original POD documentation is
covered by the
L.
See the
L.

Neither this module nor the L is affiliated with BitTorrent,
Inc.

=cut