File Coverage

blib/lib/Net/BitTorrent/Protocol/BEP03.pm
Criterion Covered Total %
statement 111 112 99.1
branch 45 46 97.8
condition 46 69 66.6
subroutine 27 27 100.0
pod 24 24 100.0
total 253 278 91.0


line stmt bran cond sub pod time code
1             package Net::BitTorrent::Protocol::BEP03;
2             our $VERSION = "1.5.3";
3 2     2   565 use Carp qw[carp];
  2         2  
  2         90  
4 2     2   6 use vars qw[@EXPORT_OK %EXPORT_TAGS];
  2         2  
  2         86  
5 2     2   6 use Exporter qw[];
  2         2  
  2         2607  
6             *import = *import = *Exporter::import;
7             %EXPORT_TAGS = (
8             build => [
9             qw[ build_handshake build_keepalive build_choke build_unchoke
10             build_interested build_not_interested build_have
11             build_bitfield build_request build_piece build_cancel
12             build_port ]
13             ],
14             parse => [
15             qw[ parse_handshake parse_keepalive
16             parse_choke parse_unchoke parse_interested
17             parse_not_interested parse_have parse_bitfield
18             parse_request parse_piece parse_cancel parse_port ]
19             ],
20             types => [
21             qw[ $HANDSHAKE $KEEPALIVE $CHOKE $UNCHOKE $INTERESTED
22             $NOT_INTERESTED $HAVE $BITFIELD $REQUEST $PIECE $CANCEL $PORT ]
23             ]
24             );
25             @EXPORT_OK = sort map { @$_ = sort @$_; @$_ } values %EXPORT_TAGS;
26             $EXPORT_TAGS{'all'} = \@EXPORT_OK;
27             #
28             our $HANDSHAKE = -1;
29             our $KEEPALIVE = '';
30             our $CHOKE = 0;
31             our $UNCHOKE = 1;
32             our $INTERESTED = 2;
33             our $NOT_INTERESTED = 3;
34             our $HAVE = 4;
35             our $BITFIELD = 5;
36             our $REQUEST = 6;
37             our $PIECE = 7;
38             our $CANCEL = 8;
39             our $PORT = 9;
40             #
41             my $info_hash_constraint;
42              
43             sub build_handshake {
44 9     9 1 3334 my ($reserved, $infohash, $peerid) = @_;
45 9 100 100     46 if ((!defined $reserved) || (length $reserved != 8)) {
46 2         202 carp sprintf
47             '%s::build_handshake() requires 8 bytes of reserved data',
48             __PACKAGE__;
49 2         11 return;
50             }
51 7 100 66     26 if ((!defined $infohash) || (length $infohash != 20)) {
52 2         160 carp sprintf '%s::build_handshake() requires proper infohash',
53             __PACKAGE__;
54 2         48 return;
55             }
56 5 100 66     20 if ((!defined $peerid) || (length $peerid != 20)) {
57 2         179 carp sprintf '%s::build_handshake() requires a well formed peer id',
58             __PACKAGE__;
59 2         10 return;
60             }
61 3         16 return pack 'c/a* a8 a20 a20', 'BitTorrent protocol',
62             $reserved, $infohash,
63             $peerid;
64             }
65 10     10 1 17 sub build_keepalive { return pack('N', 0); }
66 2     2 1 4 sub build_choke { return pack('Nc', 1, 0); }
67 3     3 1 6 sub build_unchoke { return pack('Nc', 1, 1); }
68 3     3 1 7 sub build_interested { return pack('Nc', 1, 2); }
69 2     2 1 6 sub build_not_interested { return pack('Nc', 1, 3); }
70              
71             sub build_have {
72 7     7 1 9 my ($index) = @_;
73 7 100 33     39 if ((!defined $index) || ($index !~ m[^\d+$])) {
74 2         186 carp sprintf
75             '%s::build_have() requires an integer index parameter',
76             __PACKAGE__;
77 2         11 return;
78             }
79 5         18 return pack('NcN', 5, 4, $index);
80             }
81              
82             sub build_bitfield {
83 2     2 1 3 my ($bitfield) = @_;
84 2 100 66     11 if ((!$bitfield) || (unpack('b*', $bitfield) !~ m[^[01]+$])) {
85 1         66 carp sprintf 'Malformed bitfield passed to %s::build_bitfield()',
86             __PACKAGE__;
87 1         5 return;
88             }
89             return
90 1         18 pack('Nca*',
91             (length($bitfield) + 1),
92             5, pack 'B*', unpack 'b*', $bitfield);
93             }
94              
95             sub build_request {
96 13     13 1 15 my ($index, $offset, $length) = @_;
97 13 100 66     60 if ((!defined $index) || ($index !~ m[^\d+$])) {
98 3         201 carp sprintf
99             '%s::build_request() requires an integer index parameter',
100             __PACKAGE__;
101 3         15 return;
102             }
103 10 100 66     29 if ((!defined $offset) || ($offset !~ m[^\d+$])) {
104 3         235 carp sprintf '%s::build_request() requires an offset parameter',
105             __PACKAGE__;
106 3         13 return;
107             }
108 7 100 66     23 if ((!defined $length) || ($length !~ m[^\d+$])) {
109 3         192 carp sprintf '%s::build_request() requires an length parameter',
110             __PACKAGE__;
111 3         11 return;
112             }
113 4         9 my $packed = pack('NNN', $index, $offset, $length);
114 4         18 return pack('Nca*', length($packed) + 1, 6, $packed);
115             }
116              
117             sub build_piece {
118 11     11 1 14 my ($index, $offset, $data) = @_;
119 11 100 66     45 if ((!defined $index) || ($index !~ m[^\d+$])) {
120 3         203 carp sprintf '%s::build_piece() requires an index parameter',
121             __PACKAGE__;
122 3         14 return;
123             }
124 8 100 66     25 if ((!defined $offset) || ($offset !~ m[^\d+$])) {
125 3         199 carp sprintf '%s::build_piece() requires an offset parameter',
126             __PACKAGE__;
127 3         13 return;
128             }
129 5 100       9 if (!defined $data) {
130 1         69 carp sprintf '%s::build_piece() requires data to work with',
131             __PACKAGE__;
132 1         4 return;
133             }
134 4         9 my $packed = pack('N2a*', $index, $offset, $data);
135 4         11 return pack('Nca*', length($packed) + 1, 7, $packed);
136             }
137              
138             sub build_cancel {
139 12     12 1 16 my ($index, $offset, $length) = @_;
140 12 100 66     56 if ((!defined $index) || ($index !~ m[^\d+$])) {
141 3         207 carp sprintf
142             '%s::build_cancel() requires an integer index parameter',
143             __PACKAGE__;
144 3         14 return;
145             }
146 9 100 66     36 if ((!defined $offset) || ($offset !~ m[^\d+$])) {
147 3         184 carp sprintf '%s::build_cancel() requires an offset parameter',
148             __PACKAGE__;
149 3         13 return;
150             }
151 6 100 66     23 if ((!defined $length) || ($length !~ m[^\d+$])) {
152 3         192 carp sprintf '%s::build_cancel() requires an length parameter',
153             __PACKAGE__;
154 3         13 return;
155             }
156 3         7 my $packed = pack('N3', $index, $offset, $length);
157 3         11 return pack('Nca*', length($packed) + 1, 8, $packed);
158             }
159              
160             sub build_port {
161 6     6 1 6 my ($port) = @_;
162 6 100 33     38 if ((!defined $port) || ($port !~ m[^\d+$])) {
163 3         228 carp sprintf '%s::build_port() requires an index parameter',
164             __PACKAGE__;
165 3         14 return;
166             }
167 3         15 return pack('Ncnn', length($port) + 1, 9, $port);
168             }
169              
170             sub parse_handshake {
171 5     5 1 8 my ($packet) = @_;
172 5 100 100     27 if (!$packet || (length($packet) < 68)) {
173 2         11 return {fatal => 1, error => 'Not enough data for HANDSHAKE'};
174             }
175 3         11 my ($protocol_name, $reserved, $infohash, $peerid)
176             = unpack('c/a a8 a20 a20', $packet);
177 3 100       7 if ($protocol_name ne 'BitTorrent protocol') {
178 1         6 return {fatal => 1,
179             error => sprintf('Improper HANDSHAKE; Bad protocol name (%s)',
180             $protocol_name)
181             };
182             }
183 2         9 return [$reserved, $infohash, $peerid];
184             }
185 9     9 1 14 sub parse_keepalive { return; }
186 1     1 1 2 sub parse_choke { return; }
187 2     2 1 3 sub parse_unchoke { return; }
188 2     2 1 4 sub parse_interested { return; }
189 1     1 1 1 sub parse_not_interested { return; }
190              
191             sub parse_have {
192 9     9 1 14 my ($packet) = @_;
193 9 100 66     40 if ((!$packet) || (length($packet) < 1)) {
194 1         5 return {fatal => 1, error => 'Incorrect packet length for HAVE'};
195             }
196 8         28 return unpack('N', $packet);
197             }
198              
199             sub parse_bitfield {
200 6     6 1 7 my ($packet) = @_;
201 6 100 66     26 if ((!$packet) || (length($packet) < 1)) {
202 1         5 return {fatal => 1, error => 'Incorrect packet length for BITFIELD'};
203             }
204 5         38 return (pack 'b*', unpack 'B*', $packet);
205             }
206              
207             sub parse_request {
208 7     7 1 10 my ($packet) = @_;
209 7 100 66     32 if ((!$packet) || (length($packet) < 9)) {
210 1   50     11 return {fatal => 1,
211             error =>
212             sprintf(
213             'Incorrect packet length for REQUEST (%d requires >=9)',
214             length($packet || ''))
215             };
216             }
217 6         25 return ([unpack('N3', $packet)]);
218             }
219              
220             sub parse_piece {
221 8     8 1 10 my ($packet) = @_;
222 8 100 100     33 if ((!$packet) || (length($packet) < 9)) {
223             return {
224 2   100     19 fatal => 1,
225             error =>
226             sprintf('Incorrect packet length for PIECE (%d requires >=9)',
227             length($packet || ''))
228             };
229             }
230 6         23 return ([unpack('N2a*', $packet)]);
231             }
232              
233             sub parse_cancel {
234 6     6 1 9 my ($packet) = @_;
235 6 100 66     27 if ((!$packet) || (length($packet) < 9)) {
236 1   50     15 return {fatal => 1,
237             error =>
238             sprintf(
239             'Incorrect packet length for CANCEL (%d requires >=9)',
240             length($packet || ''))
241             };
242             }
243 5         21 return ([unpack('N3', $packet)]);
244             }
245              
246             sub parse_port {
247 2     2 1 3 my ($packet) = @_;
248 2 50 33     8 if ((!$packet) || (length($packet) < 1)) {
249 0         0 return {fatal => 1, error => 'Incorrect packet length for PORT'};
250             }
251 2         6 return (unpack 'nn', $packet);
252             }
253             1;
254              
255             =pod
256              
257             =head1 NAME
258              
259             Net::BitTorrent::Protocol::BEP03 - Packet Utilities for BEP03, the Basic BitTorrent Wire Protocol
260              
261             =head1 Synopsis
262              
263             use Net::BitTorrent::Protocol::BEP03 qw[:build];
264              
265             # Tell them what we want...
266             my $handshake = build_handshake(
267             pack('C*', split('', '00000000')),
268             pack('H*', 'ddaa46b1ddbfd3564fca526d1b68420b6cd54201'),
269             'your-peer-id-in-here'
270             );
271              
272             # And the inverse...
273             use Net::BitTorrent::Protocol::BEP03 qw[:parse];
274             my ($reserved, $infohash, $peerid) = parse_handshake( $handshake );
275              
276             =head1 Description
277              
278             What would BitTorrent be without packets? TCP noise, mostly.
279              
280             For similar work and the specifications behind these packets, move on down to
281             the L section.
282              
283             If you're looking for quick, pure Perl bencode/bdecode functions, you should
284             give L a shot.
285              
286             =head1 Importing from Net::BitTorrent::Protocol::BEP03
287              
288             There are three tags available for import. To get them all in one go, use the
289             C<:all> tag.
290              
291             =over
292              
293             =item C<:types>
294              
295             Packet types
296              
297             For more on what these packets actually mean, see the BitTorrent Spec. This is
298             a list of the currently supported packet types:
299              
300             =over
301              
302             =item C<$HANDSHAKE>
303              
304             =item C<$KEEPALIVE>
305              
306             =item C<$CHOKE>
307              
308             =item C<$UNCHOKE>
309              
310             =item C<$INTERESTED>
311              
312             =item C<$NOT_INTERESTED>
313              
314             =item C<$HAVE>
315              
316             =item C<$BITFIELD>
317              
318             =item C<$REQUEST>
319              
320             =item C<$PIECE>
321              
322             =item C<$CANCEL>
323              
324             =item C<$PORT>
325              
326             =back
327              
328             =item C<:build>
329              
330             These create packets ready-to-send to remote peers. See
331             L.
332              
333             =item C<:parse>
334              
335             These are used to parse unknown data into sensible packets. The same packet
336             types we can build, we can also parse. See
337             L.
338              
339             =back
340              
341             =head2 Building Functions
342              
343             =over
344              
345             =item C
346              
347             Creates an initial handshake packet. All parameters must conform to the
348             BitTorrent spec:
349              
350             =over
351              
352             =item C<$reserved>
353              
354             ...is the 8 byte string used to represent a client's capabilities for
355             extensions to the protocol.
356              
357             =item C<$infohash>
358              
359             ...is the 20 byte SHA1 hash of the bencoded info from the metainfo file.
360              
361             =item C<$peerid>
362              
363             ...is 20 bytes. Be creative.
364              
365             =back
366              
367             =item C
368              
369             Creates a keep-alive packet. The keep-alive packet is zero bytes, specified
370             with the length prefix set to zero. There is no message ID and no payload.
371             Peers may close a connection if they receive no packets (keep-alive or any
372             other packet) for a certain period of time, so a keep-alive packet must be
373             sent to maintain the connection alive if no command have been sent for a given
374             amount of time. This amount of time is generally two minutes.
375              
376             =item C
377              
378             Creates a choke packet. The choke packet is fixed-length and has no payload.
379              
380             See Also: http://tinyurl.com/NB-docs-choking - Choking and Optimistic
381             Unchoking
382              
383             =item C
384              
385             Creates an unchoke packet. The unchoke packet is fixed-length and has no
386             payload.
387              
388             See Also: http://tinyurl.com/NB-docs-choking - Choking and Optimistic
389             Unchoking
390              
391             =item C
392              
393             Creates an interested packet. The interested packet is fixed-length and has
394             no payload.
395              
396             =item C
397              
398             Creates a not interested packet. The not interested packet is fixed-length
399             and has no payload.
400              
401             =item C
402              
403             Creates a have packet. The have packet is fixed length. The payload is the
404             zero-based INDEX of a piece that has just been successfully downloaded and
405             verified via the hash.
406              
407             I
408             particular because peers are extremely unlikely to download pieces that they
409             already have, a peer may choose not to advertise having a piece to a peer that
410             already has that piece. At a minimum "HAVE suppression" will result in a 50%
411             reduction in the number of HAVE packets, this translates to around a 25-35%
412             reduction in protocol overhead. At the same time, it may be worthwhile to send
413             a HAVE packet to a peer that has that piece already since it will be useful in
414             determining which piece is rare.>
415              
416             I
417             the peer will never download. Due to this, attempting to model peers using
418             this information is a bad idea.>
419              
420             =item C
421              
422             Creates a bitfield packet. The bitfield packet is variable length, where C
423             is the length of the C<$bitfield>. The payload is a C<$bitfield> representing
424             the pieces that have been successfully downloaded. The high bit in the first
425             byte corresponds to piece index 0. Bits that are cleared indicated a missing
426             piece, and set bits indicate a valid and available piece. Spare bits at the
427             end are set to zero.
428              
429             A bitfield packet may only be sent immediately after the
430             L sequence is
431             completed, and before any other packets are sent. It is optional, and need not
432             be sent if a client has no pieces or uses one of the Fast Extension packets:
433             L or
434             L.
435              
436             =begin :parser
437              
438             I
439             the connection if they receive bitfields that are not of the correct size, or
440             if the bitfield has any of the spare bits set.>
441              
442             =end :parser
443              
444             =item C
445              
446             Creates a request packet. The request packet is fixed length, and is used to
447             request a block. The payload contains the following information:
448              
449             =over
450              
451             =item C<$index>
452              
453             ...is an integer specifying the zero-based piece index.
454              
455             =item C<$offset>
456              
457             ...is an integer specifying the zero-based byte offset within the piece.
458              
459             =item C<$length>
460              
461             ...is an integer specifying the requested length.
462              
463             =back
464              
465             See Also: L
466              
467             =item C
468              
469             Creates a piece packet. The piece packet is variable length, where C is
470             the length of the C<$data>. The payload contains the following information:
471              
472             =over
473              
474             =item C<$index>
475              
476             ...is an integer specifying the zero-based piece index.
477              
478             =item C<$offset>
479              
480             ...is an integer specifying the zero-based byte offset within the piece.
481              
482             =item C<$data>
483              
484             ...is the block of data, which is a subset of the piece specified by C<$index>.
485              
486             =back
487              
488             Before sending pieces to remote peers, the client should verify that the piece
489             matches the SHA1 hash related to it in the .torrent metainfo.
490              
491             =item C
492              
493             Creates a cancel packet. The cancel packet is fixed length, and is used to
494             cancel L. The
495             payload is identical to that of the
496             L packet. It is
497             typically used during 'End Game.'
498              
499             See Also: http://tinyurl.com/NB-docs-EndGame - End Game
500              
501             =item C
502              
503             Creates a packet containing the listen port a peer's DHT node is listening on.
504              
505             Please note that the port packet has been replaced by parts of the
506             L and is no longer used
507             by a majority of modern clients. I have provided it here only for legacy
508             support; it will not be removed from this module unless it is removed from the
509             official specification.
510              
511             =back
512              
513             =head2 Parsing Functions
514              
515             These are the parsing counterparts for the C functions.
516              
517             When the packet is invalid, a hash reference is returned with the following
518             keys:
519              
520             =over
521              
522             =item C
523              
524             The value is a string describing what went wrong.
525              
526             =item C
527              
528             If parsing the packet is impossible, this is true. For other problems (not
529             enough data, etc.), an untrue value is here.
530              
531             =back
532              
533              
534             Return values for valid packets are explained below.
535              
536             =over
537              
538             =item C
539              
540             Returns an array reference containing the C<$reserved_bytes>, C<$infohash>,
541             and C<$peerid]>.
542              
543             =item C
544              
545             Returns an empty list. Keepalive packets do not contain a playload.
546              
547             =item C
548              
549             Returns an empty list. Choke packets do not contain a playload.
550              
551             =item C
552              
553             Returns an empty list. Unchoke packets do not contain a playload.
554              
555             =item C
556              
557             Returns an empty list. Interested packets do not contain a playload.
558              
559             =item C
560              
561             Returns an empty list. Not interested packets do not contain a playload.
562              
563             =item C
564              
565             Returns an integer.
566              
567             =item C
568              
569             Returns the packed bitfield in ascending order. This makes things easy when
570             working with C.
571              
572             =item C
573              
574             Returns an array reference containing the C<$index>, C<$offset>, and
575             C<$length>.
576              
577             =item C
578              
579             Returns an array reference containing teh C<$index>, C<$offset>, and
580             C<$block>.
581              
582             =item C
583              
584             Returns an array reference containing the C<$index>, C<$offset>, and
585             C<$length>.
586              
587             =item C
588              
589             Returns a single integer containing the listen port a peer's DHT node is
590             listening on.
591              
592             =back
593              
594             =head1 See Also
595              
596             http://bittorrent.org/beps/bep_0003.html - The BitTorrent Protocol
597             Specification
598              
599             http://wiki.theory.org/BitTorrentSpecification - An annotated guide to the
600             BitTorrent protocol
601              
602             =head1 Author
603              
604             Sanko Robinson - http://sankorobinson.com/
605              
606             CPAN ID: SANKO
607              
608             =head1 License and Legal
609              
610             Copyright (C) 2008-2016 by Sanko Robinson
611              
612             This program is free software; you can redistribute it and/or modify it under
613             the terms of
614             L.
615             See the F file included with this distribution or
616             L
617             for clarification.
618              
619             When separated from the distribution, all original POD documentation is
620             covered by the
621             L.
622             See the
623             L.
624              
625             Neither this module nor the L is affiliated with BitTorrent,
626             Inc.
627              
628             =cut