File Coverage

blib/lib/Net/BitTorrent/Protocol/BEP06.pm

Criterion	Covered	Total	%
statement	48	59	81.3
branch	14	20	70.0
condition	12	26	46.1
subroutine	14	14	100.0
pod	11	11	100.0
total	99	130	76.1

package Net::BitTorrent::Protocol::BEP06;
our $VERSION = "1.5.1";
use Carp qw[carp];
use vars qw[@EXPORT_OK %EXPORT_TAGS];
use Exporter qw[];
*import = *import = *Exporter::import;
%EXPORT_TAGS = (
    build => [
        qw[ build_suggest build_allowed_fast build_reject
            build_have_all build_have_none ]
    ],
    parse => [
        qw[ parse_suggest parse_have_all parse_have_none
            parse_reject parse_allowed_fast ]
    ],
    types => [qw[ $SUGGEST $HAVE_ALL $HAVE_NONE $REJECT $ALLOWED_FAST ]],
    utils => [qw[generate_fast_set]]
);
@EXPORT_OK = sort map { @$_ = sort @$_; @$_ } values %EXPORT_TAGS;
$EXPORT_TAGS{'all'} = \@EXPORT_OK;
our $SUGGEST      = 13;
our $HAVE_ALL     = 14;
our $HAVE_NONE    = 15;
our $REJECT       = 16;
our $ALLOWED_FAST = 17;

sub build_suggest {
    my ($index) = @_;
    if ((!defined $index) || ($index !~ m[^\d+$])) {
        carp sprintf '%s::build_suggest() requires an index parameter',
            __PACKAGE__;
        return;
    }
    return pack('NcN', 5, 13, $index);
}
sub build_have_all  { pack('Nc', 1, 14); }
sub build_have_none { pack('Nc', 1, 15); }

sub build_reject {
    my ($index, $offset, $length) = @_;
    if ((!defined $index) || ($index !~ m[^\d+$])) {
        carp sprintf '%s::build_reject() requires an index parameter',
            __PACKAGE__;
        return;
    }
    if ((!defined $offset) || ($offset !~ m[^\d+$])) {
        carp sprintf '%s::build_reject() requires an offset parameter',
            __PACKAGE__;
        return;
    }
    if ((!defined $length) || ($length !~ m[^\d+$])) {
        carp sprintf '%s::build_reject() requires an length parameter',
            __PACKAGE__;
        return;
    }
    my $packed = pack('N3', $index, $offset, $length);
    return pack('Nca*', length($packed) + 1, 16, $packed);
}

sub build_allowed_fast {
    my ($index) = @_;
    if ((!defined $index) || ($index !~ m[^\d+$])) {
        carp sprintf
            '%s::build_allowed_fast() requires an index parameter',
            __PACKAGE__;
        return;
    }
    return pack('NcN', 5, 17, $index);
}

# Parsing functions
sub parse_suggest {
    my ($packet) = @_;
    if ((!$packet) || (length($packet) < 1)) {
        return {error => 'Incorrect packet length for SUGGEST'};
    }
    return unpack('N', $packet);
}
sub parse_have_all  { return; }
sub parse_have_none { return; }

sub parse_reject {
    my ($packet) = @_;
    if ((!$packet) || (length($packet) < 9)) {
        return {error =>
                    sprintf(
                       'Incorrect packet length for REJECT (%d requires >=9)',
                       length($packet || ''))
        };
    }
    return ([unpack('N3', $packet)]);
}

sub parse_allowed_fast {
    my ($packet) = @_;
    if ((!$packet) || (length($packet) < 1)) {
        return {error => 'Incorrect packet length for FASTSET'};
    }
    return unpack('N', $packet);
}

#
sub generate_fast_set {
    my ($k, $sz, $infohash, $ip) = @_;
    my @a;
    my $x = pack('C3', (split(/\./, $ip))) . "\0" . $infohash;
    while (1) {
        require Digest::SHA;
        $x = Digest::SHA::sha1($x);
        for my $i (0 .. 4) {
            return @a if scalar @a == $k;
            my $index = hex(unpack('H*', substr($x, $i * 4, 4))) % $sz;
            push @a, $index if !grep { $_ == $index } @a;
        }
    }
    @a;
}

#
1;

=pod

=head1 NAME

Net::BitTorrent::Protocol::BEP06 - Packet Utilities for BEP06: Fast Extension

=head1 Synopsis

    use Net::BitTorrent::Protocol::BEP06 qw[all];
    my $index = parse_allowed_fast($data);

=head1 Description

The Fast Extension modifies the semantics of the
L,
L,
L, and
L,
and adds a L Request.
Now, every request is guaranteed to result in I response which is
either the corresponding reject or corresponding piece message. Even when a
request is cancelled, the peer receiving the cancel should respond with either
the corresponding reject or the corresponding piece: requests that are being
processed are allowed to complete.

Choke no longer implicitly rejects all pending requests, thus eliminating some
race conditions which could cause pieces to be needlessly requested multiple
times.

=head1 Importing from Net::BitTorrent::Protocol::BEP06

There are four tags available for import. To get them all in one go, use the
C<:all> tag.

=over

=item C<:types>

Packet types

For more on what these packets actually mean, see the Fast Extension spec.
This is a list of the currently supported packet types.

=over

=item C<$SUGGEST>

=item C<$HAVE_ALL>

=item C<$HAVE_NONE>

=item C<$REJECT>

=item C<$ALLOWED_FAST>

=back

=item C<:build>

These create packets ready-to-send to remote peers. See
L.

=item C<:parse>

These are used to parse unknown data into sensible packets. The same packet
types we can build, we can also parse. See
L.

=item C<:utils>

Helpful functions listed in the section entitled
L.

=back

=head1 Building Functions

=over

=item C

Creates an advisory packet which claims you have all pieces and can seed.

You should send this rather than a bitfield of all true values.

=item C

Creates an advisory packet which claims you have no data related to the
torrent.

=item C

Creates an advisory message meaning "you might like to download this piece."
The intended usage is for 'super-seeding' without throughput reduction, to
avoid redundant downloads, and so that a seed which is disk I/O bound can
upload contiguous or identical pieces to avoid excessive disk seeks.

You should send this instead of a bitfield of nothing but null values.

=item C

Creates a packet which is used to notify a requesting peer that its request
will not be satisfied.

=item C

Creates an advisory message which means "if you ask for this piece, I'll give
it to you even if you're choked."

=back

=head1 Parsing Functions

These are the parsing counterparts for the C functions.

When the packet is invalid, a hash reference is returned with a single key:
C. The value is a string describing what went wrong.

Return values for valid packets are explained below.

=over

=item C

Returns an empty list. HAVE ALL packets do not contain a payload.

=item C

Returns an empty list. HAVE NONE packets do not contain a payload.

=item C

Returns an integer.

=item C

Returns an array reference containing the C<$index>, C<$offset>, and
C<$length>.

=item C

Returns an integer.

=back

=head1 Utility Functions

=over

=item C

Returns a list of integers. C<$k> is the number of pieces in the set, C<$sz>
is the number of pieces in the torrent, C<$infohash> is the packed infohash,
C<$ip> is the IPv4 (dotted quad) address of the peer this set will be
generated for.

    my $data = join '',
        map { build_allowed_fast($_) }
        generate_fast_set(7, 1313, "\xAA" x 20, '80.4.4.200');

=back

=head1 See Also

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

=head1 Author

Sanko Robinson  - http://sankorobinson.com/

CPAN ID: SANKO

=head1 License and Legal

Copyright (C) 2008-2012 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