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


line stmt bran cond sub pod time code
1             package Net::BitTorrent::Protocol::BEP06;
2             our $VERSION = "1.5.1";
3 2     2   557 use Carp qw[carp];
  2         6  
  2         88  
4 2     2   7 use vars qw[@EXPORT_OK %EXPORT_TAGS];
  2         2  
  2         84  
5 2     2   7 use Exporter qw[];
  2         1  
  2         1437  
6             *import = *import = *Exporter::import;
7             %EXPORT_TAGS = (
8             build => [
9             qw[ build_suggest build_allowed_fast build_reject
10             build_have_all build_have_none ]
11             ],
12             parse => [
13             qw[ parse_suggest parse_have_all parse_have_none
14             parse_reject parse_allowed_fast ]
15             ],
16             types => [qw[ $SUGGEST $HAVE_ALL $HAVE_NONE $REJECT $ALLOWED_FAST ]],
17             utils => [qw[generate_fast_set]]
18             );
19             @EXPORT_OK = sort map { @$_ = sort @$_; @$_ } values %EXPORT_TAGS;
20             $EXPORT_TAGS{'all'} = \@EXPORT_OK;
21             our $SUGGEST = 13;
22             our $HAVE_ALL = 14;
23             our $HAVE_NONE = 15;
24             our $REJECT = 16;
25             our $ALLOWED_FAST = 17;
26              
27             sub build_suggest {
28 2     2 1 2 my ($index) = @_;
29 2 50 33     12 if ((!defined $index) || ($index !~ m[^\d+$])) {
30 0         0 carp sprintf '%s::build_suggest() requires an index parameter',
31             __PACKAGE__;
32 0         0 return;
33             }
34 2         6 return pack('NcN', 5, 13, $index);
35             }
36 1     1 1 3 sub build_have_all { pack('Nc', 1, 14); }
37 1     1 1 3 sub build_have_none { pack('Nc', 1, 15); }
38              
39             sub build_reject {
40 2     2 1 3 my ($index, $offset, $length) = @_;
41 2 50 33     11 if ((!defined $index) || ($index !~ m[^\d+$])) {
42 0         0 carp sprintf '%s::build_reject() requires an index parameter',
43             __PACKAGE__;
44 0         0 return;
45             }
46 2 50 33     8 if ((!defined $offset) || ($offset !~ m[^\d+$])) {
47 0         0 carp sprintf '%s::build_reject() requires an offset parameter',
48             __PACKAGE__;
49 0         0 return;
50             }
51 2 50 33     8 if ((!defined $length) || ($length !~ m[^\d+$])) {
52 0         0 carp sprintf '%s::build_reject() requires an length parameter',
53             __PACKAGE__;
54 0         0 return;
55             }
56 2         5 my $packed = pack('N3', $index, $offset, $length);
57 2         21 return pack('Nca*', length($packed) + 1, 16, $packed);
58             }
59              
60             sub build_allowed_fast {
61 2     2 1 3 my ($index) = @_;
62 2 50 33     7 if ((!defined $index) || ($index !~ m[^\d+$])) {
63 0         0 carp sprintf
64             '%s::build_allowed_fast() requires an index parameter',
65             __PACKAGE__;
66 0         0 return;
67             }
68 2         6 return pack('NcN', 5, 17, $index);
69             }
70              
71             # Parsing functions
72             sub parse_suggest {
73 11     11 1 1627 my ($packet) = @_;
74 11 100 66     49 if ((!$packet) || (length($packet) < 1)) {
75 2         11 return {error => 'Incorrect packet length for SUGGEST'};
76             }
77 9         39 return unpack('N', $packet);
78             }
79 2     2 1 4 sub parse_have_all { return; }
80 2     2 1 4 sub parse_have_none { return; }
81              
82             sub parse_reject {
83 8     8 1 10 my ($packet) = @_;
84 8 100 66     35 if ((!$packet) || (length($packet) < 9)) {
85 2   50     16 return {error =>
86             sprintf(
87             'Incorrect packet length for REJECT (%d requires >=9)',
88             length($packet || ''))
89             };
90             }
91 6         23 return ([unpack('N3', $packet)]);
92             }
93              
94             sub parse_allowed_fast {
95 11     11 1 15 my ($packet) = @_;
96 11 100 66     46 if ((!$packet) || (length($packet) < 1)) {
97 2         7 return {error => 'Incorrect packet length for FASTSET'};
98             }
99 9         34 return unpack('N', $packet);
100             }
101              
102             #
103             sub generate_fast_set {
104 2     2 1 3 my ($k, $sz, $infohash, $ip) = @_;
105 2         2 my @a;
106 2         15 my $x = pack('C3', (split(/\./, $ip))) . "\0" . $infohash;
107 2         2 while (1) {
108 4         484 require Digest::SHA;
109 4         2652 $x = Digest::SHA::sha1($x);
110 4         7 for my $i (0 .. 4) {
111 18 100       34 return @a if scalar @a == $k;
112 16         32 my $index = hex(unpack('H*', substr($x, $i * 4, 4))) % $sz;
113 16 50       18 push @a, $index if !grep { $_ == $index } @a;
  57         58  
114             }
115             }
116 0           @a;
117             }
118              
119             #
120             1;
121              
122             =pod
123              
124             =head1 NAME
125              
126             Net::BitTorrent::Protocol::BEP06 - Packet Utilities for BEP06: Fast Extension
127              
128             =head1 Synopsis
129              
130             use Net::BitTorrent::Protocol::BEP06 qw[all];
131             my $index = parse_allowed_fast($data);
132              
133             =head1 Description
134              
135             The Fast Extension modifies the semantics of the
136             L,
137             L,
138             L, and
139             L,
140             and adds a L Request.
141             Now, every request is guaranteed to result in I response which is
142             either the corresponding reject or corresponding piece message. Even when a
143             request is cancelled, the peer receiving the cancel should respond with either
144             the corresponding reject or the corresponding piece: requests that are being
145             processed are allowed to complete.
146              
147             Choke no longer implicitly rejects all pending requests, thus eliminating some
148             race conditions which could cause pieces to be needlessly requested multiple
149             times.
150              
151             =head1 Importing from Net::BitTorrent::Protocol::BEP06
152              
153             There are four tags available for import. To get them all in one go, use the
154             C<:all> tag.
155              
156             =over
157              
158             =item C<:types>
159              
160             Packet types
161              
162             For more on what these packets actually mean, see the Fast Extension spec.
163             This is a list of the currently supported packet types.
164              
165             =over
166              
167             =item C<$SUGGEST>
168              
169             =item C<$HAVE_ALL>
170              
171             =item C<$HAVE_NONE>
172              
173             =item C<$REJECT>
174              
175             =item C<$ALLOWED_FAST>
176              
177             =back
178              
179             =item C<:build>
180              
181             These create packets ready-to-send to remote peers. See
182             L.
183              
184             =item C<:parse>
185              
186             These are used to parse unknown data into sensible packets. The same packet
187             types we can build, we can also parse. See
188             L.
189              
190             =item C<:utils>
191              
192             Helpful functions listed in the section entitled
193             L.
194              
195             =back
196              
197             =head1 Building Functions
198              
199             =over
200              
201             =item C
202              
203             Creates an advisory packet which claims you have all pieces and can seed.
204              
205             You should send this rather than a bitfield of all true values.
206              
207             =item C
208              
209             Creates an advisory packet which claims you have no data related to the
210             torrent.
211              
212             =item C
213              
214             Creates an advisory message meaning "you might like to download this piece."
215             The intended usage is for 'super-seeding' without throughput reduction, to
216             avoid redundant downloads, and so that a seed which is disk I/O bound can
217             upload contiguous or identical pieces to avoid excessive disk seeks.
218              
219             You should send this instead of a bitfield of nothing but null values.
220              
221             =item C
222              
223             Creates a packet which is used to notify a requesting peer that its request
224             will not be satisfied.
225              
226             =item C
227              
228             Creates an advisory message which means "if you ask for this piece, I'll give
229             it to you even if you're choked."
230              
231             =back
232              
233             =head1 Parsing Functions
234              
235             These are the parsing counterparts for the C functions.
236              
237             When the packet is invalid, a hash reference is returned with a single key:
238             C. The value is a string describing what went wrong.
239              
240             Return values for valid packets are explained below.
241              
242             =over
243              
244             =item C
245              
246             Returns an empty list. HAVE ALL packets do not contain a payload.
247              
248             =item C
249              
250             Returns an empty list. HAVE NONE packets do not contain a payload.
251              
252             =item C
253              
254             Returns an integer.
255              
256             =item C
257              
258             Returns an array reference containing the C<$index>, C<$offset>, and
259             C<$length>.
260              
261             =item C
262              
263             Returns an integer.
264              
265             =back
266              
267             =head1 Utility Functions
268              
269             =over
270              
271             =item C
272              
273             Returns a list of integers. C<$k> is the number of pieces in the set, C<$sz>
274             is the number of pieces in the torrent, C<$infohash> is the packed infohash,
275             C<$ip> is the IPv4 (dotted quad) address of the peer this set will be
276             generated for.
277              
278             my $data = join '',
279             map { build_allowed_fast($_) }
280             generate_fast_set(7, 1313, "\xAA" x 20, '80.4.4.200');
281              
282             =back
283              
284             =head1 See Also
285              
286             http://bittorrent.org/beps/bep_0006.html - Fast Extension
287              
288             =head1 Author
289              
290             Sanko Robinson - http://sankorobinson.com/
291              
292             CPAN ID: SANKO
293              
294             =head1 License and Legal
295              
296             Copyright (C) 2008-2012 by Sanko Robinson
297              
298             This program is free software; you can redistribute it and/or modify it under
299             the terms of
300             L.
301             See the F file included with this distribution or
302             L
303             for clarification.
304              
305             When separated from the distribution, all original POD documentation is
306             covered by the
307             L.
308             See the
309             L.
310              
311             Neither this module nor the L is affiliated with BitTorrent,
312             Inc.
313              
314             =cut