File Coverage

blib/lib/Net/BitTorrent/Protocol.pm
Criterion Covered Total %
statement 232 263 88.2
branch 88 106 83.0
condition 83 120 69.1
subroutine 70 71 98.5
pod 37 37 100.0
total 510 597 85.4


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             package Net::BitTorrent::Protocol;
3             {
4 12     12   413747 use strict;
  12         26  
  12         1712  
5 12     12   68 use warnings;
  12         23  
  12         533  
6 12     12   68 use Carp qw[carp];
  12         24  
  12         705  
7 12     12   64 use lib q[../../../lib];
  12         24  
  12         78  
8 12     12   3128 use Net::BitTorrent::Util qw[:bencode];
  12         27  
  12         1933  
9 12     12   83 use version qw[qv];
  12         48  
  12         82  
10             our $VERSION_BASE = 50; our $UNSTABLE_RELEASE = 0; our $VERSION = sprintf(($UNSTABLE_RELEASE ? q[%.3f_%03d] : q[%.3f]), (version->new(($VERSION_BASE))->numify / 1000), $UNSTABLE_RELEASE);
11 12     12   1580 use vars qw[@EXPORT_OK %EXPORT_TAGS];
  12         24  
  12         595  
12 12     12   69 use Exporter qw[];
  12         24  
  12         56054  
13             *import = *import = *Exporter::import;
14             @EXPORT_OK = qw[build_handshake build_keepalive build_choke build_unchoke
15             build_interested build_not_interested build_have build_bitfield
16             build_request build_piece build_cancel build_port build_suggest
17             build_allowed_fast build_reject build_have_all build_have_none
18             build_extended parse_packet _parse_handshake _parse_keepalive
19             _parse_choke _parse_unchoke _parse_interested _parse_not_interested
20             _parse_have _parse_bitfield _parse_request _parse_piece _parse_cancel
21             _parse_port _parse_suggest _parse_have_all _parse_have_none
22             _parse_reject _parse_allowed_fast _parse_extended HANDSHAKE KEEPALIVE
23             CHOKE UNCHOKE INTERESTED NOT_INTERESTED HAVE BITFIELD REQUEST PIECE
24             CANCEL PORT SUGGEST HAVE_ALL HAVE_NONE REJECT ALLOWED_FAST EXTPROTOCOL
25             _build_dht_reply_get_peers _build_dht_query_get_peers
26             _build_dht_reply_values _build_dht_query_announce
27             _build_dht_reply_ping _build_dht_query_ping
28             _build_dht_reply_find_node _build_dht_query_find_node];
29             %EXPORT_TAGS = (
30             all => [@EXPORT_OK],
31             build => [
32             qw[build_handshake build_keepalive build_choke build_unchoke
33             build_interested build_not_interested build_have
34             build_bitfield build_request build_piece build_cancel
35             build_port build_suggest build_allowed_fast build_reject
36             build_have_all build_have_none build_extended]
37             ],
38             parse => [
39             qw[parse_packet _parse_handshake _parse_keepalive
40             _parse_choke _parse_unchoke _parse_interested
41             _parse_not_interested _parse_have _parse_bitfield
42             _parse_request _parse_piece _parse_cancel _parse_port
43             _parse_suggest _parse_have_all _parse_have_none
44             _parse_reject _parse_allowed_fast _parse_extended]
45             ],
46             types => [
47             qw[HANDSHAKE KEEPALIVE CHOKE UNCHOKE INTERESTED NOT_INTERESTED
48             HAVE BITFIELD REQUEST PIECE CANCEL PORT SUGGEST HAVE_ALL
49             HAVE_NONE REJECT ALLOWED_FAST EXTPROTOCOL]
50             ],
51             dht => [
52             qw[_build_dht_reply_get_peers _build_dht_query_get_peers
53             _build_dht_reply_values _build_dht_query_announce
54             _build_dht_reply_ping _build_dht_query_ping
55             _build_dht_reply_find_node _build_dht_query_find_node]
56             ],
57              
58             # XXX - Move MSE-related functions from N::B::Peer
59             #mse => [qw[ ]]
60             );
61 287     287 1 111008 sub HANDSHAKE {-1}
62 33     33 1 198 sub KEEPALIVE {q[]}
63 25     25 1 96 sub CHOKE {0}
64 60     60 1 336 sub UNCHOKE {1}
65 60     60 1 434 sub INTERESTED {2}
66 30     30 1 127 sub NOT_INTERESTED {3}
67 54     54 1 293 sub HAVE {4}
68 25     25 1 147 sub BITFIELD {5}
69 36     36 1 219 sub REQUEST {6}
70 35     35 1 176 sub PIECE {7}
71 25     25 1 94 sub CANCEL {8}
72 14     14 1 57 sub PORT {9}
73 15     15 1 66 sub SUGGEST {13}
74 45     45 1 239 sub HAVE_ALL {14}
75 114     114 1 666 sub HAVE_NONE {15}
76 26     26 1 99 sub REJECT {16}
77 26     26 1 109 sub ALLOWED_FAST {17}
78 137     137 1 1490 sub EXTPROTOCOL {20}
79              
80             sub build_handshake {
81 101     101 1 295 my ($reserved, $infohash, $peerid) = @_;
82 101 100 100     320 if ( (grep { not defined } @_[0 .. 2])
  303   100     1744  
      100        
83             || (length($reserved) != 8)
84             || (length($infohash) != 20)
85             || (length($peerid) != 20))
86 7         1497 { carp
87             q[Malformed parameters for Net::BitTorrent::Protocol::build_handshake()];
88 7         57 return;
89             }
90             return
91 94         935 pack(q[c/a* a8 a20 a20],
92             q[BitTorrent protocol],
93             $reserved, $infohash, $peerid);
94             }
95 10     10 1 39 sub build_keepalive { return pack(q[N], 0); }
96 2     2 1 14 sub build_choke { return pack(q[Nc], 1, 0); }
97 20     20 1 92 sub build_unchoke { return pack(q[Nc], 1, 1); }
98 20     20 1 92 sub build_interested { return pack(q[Nc], 1, 2); }
99 5     5 1 34 sub build_not_interested { return pack(q[Nc], 1, 3); }
100              
101             sub build_have {
102 43     43 1 58 my ($index) = @_;
103 43 100 66     246 if ((!defined $index) || ($index !~ m[^\d+$])) {
104 3         505 carp
105             q[Net::BitTorrent::Protocol::build_have() requires an integer index parameter];
106 3         23 return;
107             }
108 40         177 return pack(q[NcN], 5, 4, $index);
109             }
110              
111             sub build_bitfield {
112 5     5 1 22 my ($bitfield) = @_;
113 5 100 66     5990 if ((!$bitfield) || (unpack(q[b*], $bitfield) !~ m[^[01]+$])) {
114 2         235 carp
115             q[Malformed bitfield passed to Net::BitTorrent::Protocol::build_bitfield()];
116 2         16 return;
117             }
118 3         331 return pack(q[Nca*], (length($bitfield) + 1), 5, $bitfield);
119             }
120              
121             sub build_request {
122 19     19 1 48 my ($index, $offset, $length) = @_;
123 19 100 66     153 if ((!defined $index) || ($index !~ m[^\d+$])) {
124 4         618 carp
125             q[Net::BitTorrent::Protocol::build_request() requires an integer index parameter];
126 4         28 return;
127             }
128 15 100 66     113 if ((!defined $offset) || ($offset !~ m[^\d+$])) {
129 3         470 carp
130             q[Net::BitTorrent::Protocol::build_request() requires an offset parameter];
131 3         21 return;
132             }
133 12 100 66     99 if ((!defined $length) || ($length !~ m[^\d+$])) {
134 3         382 carp
135             q[Net::BitTorrent::Protocol::build_request() requires an length parameter];
136 3         22 return;
137             }
138 9         43 my $packed = pack(q[NNN], $index, $offset, $length);
139 9         75 return pack(q[Nca*], length($packed) + 1, 6, $packed);
140             }
141              
142             sub build_piece {
143 17     17 1 42 my ($index, $offset, $data) = @_;
144 17 100 66     145 if ((!defined $index) || ($index !~ m[^\d+$])) {
145 3         616 carp
146             q[Net::BitTorrent::Protocol::build_piece() requires an index parameter];
147 3         29 return;
148             }
149 14 100 66     116 if ((!defined $offset) || ($offset !~ m[^\d+$])) {
150 3         623 carp
151             q[Net::BitTorrent::Protocol::build_piece() requires an offset parameter];
152 3         31 return;
153             }
154 11 100 66     72 if (!$data or !$$data) {
155 1         152 carp
156             q[Net::BitTorrent::Protocol::build_piece() requires data to work with];
157 1         11 return;
158             }
159 10         365 my $packed = pack(q[N2a*], $index, $offset, $$data);
160 10         5447 return pack(q[Nca*], length($packed) + 1, 7, $packed);
161             }
162              
163             sub build_cancel {
164 13     13 1 38 my ($index, $offset, $length) = @_;
165 13 100 66     103 if ((!defined $index) || ($index !~ m[^\d+$])) {
166 4         642 carp
167             q[Net::BitTorrent::Protocol::build_cancel() requires an integer index parameter];
168 4         35 return;
169             }
170 9 100 66     72 if ((!defined $offset) || ($offset !~ m[^\d+$])) {
171 3         382 carp
172             q[Net::BitTorrent::Protocol::build_cancel() requires an offset parameter];
173 3         29 return;
174             }
175 6 100 66     51 if ((!defined $length) || ($length !~ m[^\d+$])) {
176 3         406 carp
177             q[Net::BitTorrent::Protocol::build_cancel() requires an length parameter];
178 3         28 return;
179             }
180 3         16 my $packed = pack(q[N3], $index, $offset, $length);
181 3         81 return pack(q[Nca*], length($packed) + 1, 8, $packed);
182             }
183              
184             sub build_port {
185 7     7 1 19 my ($port) = @_;
186 7 100 66     80 if ((!defined $port) || ($port !~ m[^\d+$])) {
187 4         1093 carp
188             q[Net::BitTorrent::Protocol::build_port() requires an index parameter];
189 4         40 return;
190             }
191 3         29 return pack(q[NcN], length($port) + 1, 9, $port);
192             }
193              
194             sub build_suggest {
195 9     9 1 18 my ($index) = @_;
196 9 100 66     84 if ((!defined $index) || ($index !~ m[^\d+$])) {
197 4         683 carp
198             q[Net::BitTorrent::Protocol::build_suggest() requires an index parameter];
199 4         33 return;
200             }
201 5         30 return pack(q[NcN], 5, 13, $index);
202             }
203 13     13 1 67 sub build_have_all { return pack(q[Nc], 1, 14); }
204 52     52 1 234 sub build_have_none { return pack(q[Nc], 1, 15); }
205              
206             sub build_reject {
207 13     13 1 33 my ($index, $offset, $length) = @_;
208 13 100 66     89 if ((!defined $index) || ($index !~ m[^\d+$])) {
209 3         494 carp
210             q[Net::BitTorrent::Protocol::build_reject() requires an index parameter];
211 3         29 return;
212             }
213 10 100 66     64 if ((!defined $offset) || ($offset !~ m[^\d+$])) {
214 3         528 carp
215             q[Net::BitTorrent::Protocol::build_reject() requires an offset parameter];
216 3         27 return;
217             }
218 7 100 66     210 if ((!defined $length) || ($length !~ m[^\d+$])) {
219 3         380 carp
220             q[Net::BitTorrent::Protocol::build_reject() requires an length parameter];
221 3         26 return;
222             }
223 4         15 my $packed = pack(q[N3], $index, $offset, $length);
224 4         68 return pack(q[Nca*], length($packed) + 1, 16, $packed);
225             }
226              
227             sub build_allowed_fast {
228 9     9 1 20 my ($index) = @_;
229 9 100 66     82 if ((!defined $index) || ($index !~ m[^\d+$])) {
230 4         1685 carp
231             q[Net::BitTorrent::Protocol::build_allowed_fast() requires an index parameter];
232 4         46 return;
233             }
234 5         33 return pack(q[NcN], 5, 17, $index);
235             }
236              
237             sub build_extended {
238 76     76 1 155 my ($msgID, $data) = @_;
239 76 100 66     617 if ((!defined $msgID) || ($msgID !~ m[^\d+$])) {
240 4         758 carp
241             q[Net::BitTorrent::Protocol::build_extended() requires a message id parameter];
242 4         121 return;
243             }
244 72 100 100     428 if ((!$data) || (ref($data) ne q[HASH])) {
245 4         455 carp
246             q[Net::BitTorrent::Protocol::build_extended() requires a payload];
247 4         27 return;
248             }
249 68         340 my $packet = pack(q[ca*], $msgID, bencode($data));
250 68         524 return pack(q[Nca*], length($packet) + 1, 20, $packet);
251             }
252             my %parse_packet_dispatch = (&KEEPALIVE => \&_parse_keepalive,
253             &CHOKE => \&_parse_choke,
254             &UNCHOKE => \&_parse_unchoke,
255             &INTERESTED => \&_parse_interested,
256             &NOT_INTERESTED => \&_parse_not_interested,
257             &HAVE => \&_parse_have,
258             &BITFIELD => \&_parse_bitfield,
259             &REQUEST => \&_parse_request,
260             &PIECE => \&_parse_piece,
261             &CANCEL => \&_parse_cancel,
262             &PORT => \&_parse_port,
263             &SUGGEST => \&_parse_suggest,
264             &HAVE_ALL => \&_parse_have_all,
265             &HAVE_NONE => \&_parse_have_none,
266             &REJECT => \&_parse_reject,
267             &ALLOWED_FAST => \&_parse_allowed_fast,
268             &EXTPROTOCOL => \&_parse_extended
269             );
270              
271             sub parse_packet {
272 275     275 1 705 my ($data) = @_;
273 275 100 100     2432 if ((!$data) || (ref($data) ne q[SCALAR]) || (!$$data)) {
      100        
274 6         852 carp
275             q[Net::BitTorrent::Protocol::parse_packet() needs data to parse];
276 6         128 return;
277             }
278 269         489 my ($packet);
279 269 100 33     2490 if (unpack(q[c], $$data) == 0x13) {
    50          
280 66         343 my @payload = _parse_handshake(substr($$data, 0, 68, q[]));
281 66 50       364 $packet = {Type => HANDSHAKE,
282             Payload => @payload
283             }
284             if @payload;
285             }
286             elsif ( (defined unpack(q[N], $$data))
287             and (unpack(q[N], $$data) =~ m[\d]))
288 203 100       580 { if ((unpack(q[N], $$data) <= length($$data))) {
289 202         1723 (my ($packet_data), $$data) = unpack(q[N/aa*], $$data);
290 202         1043 (my ($type), $packet_data) = unpack(q[ca*], $packet_data);
291 202 100       956 if (defined $parse_packet_dispatch{$type}) {
    50          
292 200         662 my $payload = $parse_packet_dispatch{$type}($packet_data);
293 200 100       964 $packet = {Type => $type,
294             (defined $payload
295             ? (Payload => $payload)
296             : ()
297             )
298             };
299             }
300             elsif (eval q[require Data::Dump]) {
301 0         0 carp
302             sprintf
303             <<'END', Data::Dump::pp($type), Data::Dump::pp($packet);
304             Unhandled/Unknown packet where:
305             Type = %s
306             Packet = %s
307             END
308             }
309             }
310             }
311 269         1058 return $packet;
312             }
313              
314             sub _parse_handshake {
315 71     71   124 my ($packet) = @_;
316 71 100 100     527 if (!$packet || (length($packet) < 68)) {
317              
318             #carp q[Not enough data for handshake packet];
319 3         14 return;
320             }
321 68         422 my ($protocol_name, $reserved, $infohash, $peerid)
322             = unpack(q[c/a a8 a20 a20], $packet);
323 68 100       224 if ($protocol_name ne q[BitTorrent protocol]) {
324              
325             #carp sprintf(q[Improper handshake; Bad protocol name (%s)],
326             # $protocol_name);
327 1         6 return;
328             }
329 67         336 return [$reserved, $infohash, $peerid];
330             }
331 10     10   26 sub _parse_keepalive { return; }
332 2     2   7 sub _parse_choke { return; }
333 20     20   55 sub _parse_unchoke { return; }
334 20     20   57 sub _parse_interested { return; }
335 4     4   13 sub _parse_not_interested { return; }
336              
337             sub _parse_have {
338 34     34   69 my ($packet) = @_;
339 34 100 66     1386 if ((!$packet) || (length($packet) < 1)) {
340              
341             #carp q[Incorrect packet length for HAVE];
342 2         9 return;
343             }
344 32         113 return unpack(q[N], $packet);
345             }
346              
347             sub _parse_bitfield {
348 7     7   16 my ($packet) = @_;
349 7 100 66     53 if ((!$packet) || (length($packet) < 1)) {
350              
351             #carp q[Incorrect packet length for BITFIELD];
352 2         10 return;
353             }
354 5         43 return (pack q[b*], unpack q[B*], $packet);
355             }
356              
357             sub _parse_request {
358 13     13   32 my ($packet) = @_;
359 13 100 66     105 if ((!$packet) || (length($packet) < 9)) {
360              
361             #carp
362             # sprintf(
363             # q[Incorrect packet length for REQUEST (%d requires >=9)],
364             # length($packet || q[]));
365 2         10 return;
366             }
367 11         69 return ([unpack(q[N3], $packet)]);
368             }
369              
370             sub _parse_piece {
371 12     12   27 my ($packet) = @_;
372 12 100 100     83 if ((!$packet) || (length($packet) < 9)) {
373              
374             #carp
375             # sprintf(
376             # q[Incorrect packet length for PIECE (%d requires >=9)],
377             # length($packet || q[]));
378 3         14 return;
379             }
380 9         178 return ([unpack(q[N2a*], $packet)]);
381             }
382              
383             sub _parse_cancel {
384 7     7   15 my ($packet) = @_;
385 7 100 66     45 if ((!$packet) || (length($packet) < 9)) {
386              
387             #carp
388             # sprintf(
389             # q[Incorrect packet length for CANCEL (%d requires >=9)],
390             # length($packet || q[]));
391 2         11 return;
392             }
393 5         31 return ([unpack(q[N3], $packet)]);
394             }
395              
396             sub _parse_port {
397 10     10   25 my ($packet) = @_;
398 10 100 66     101 if ((!$packet) || (length($packet) < 1)) {
399              
400             #carp q[Incorrect packet length for PORT];
401 2         9 return;
402             }
403 8         60 return (unpack q[N], $packet);
404             }
405              
406             sub _parse_suggest {
407 11     11   23 my ($packet) = @_;
408 11 100 66     67 if ((!$packet) || (length($packet) < 1)) {
409              
410             #carp q[Incorrect packet length for SUGGEST];
411 2         11 return;
412             }
413 9         52 return unpack(q[N], $packet);
414             }
415 11     11   30 sub _parse_have_all { return; }
416 41     41   81 sub _parse_have_none { return; }
417              
418             sub _parse_reject {
419 8     8   18 my ($packet) = @_;
420 8 100 66     51 if ((!$packet) || (length($packet) < 9)) {
421              
422             #carp
423             # sprintf(
424             # q[Incorrect packet length for REJECT (%d requires >=9)],
425             # length($packet || q[]));
426 2         11 return;
427             }
428 6         45 return ([unpack(q[N3], $packet)]);
429             }
430              
431             sub _parse_allowed_fast {
432 11     11   25 my ($packet) = @_;
433 11 100 66     101 if ((!$packet) || (length($packet) < 1)) {
434              
435             #carp q[Incorrect packet length for FASTSET];
436 2         10 return;
437             }
438 9         54 return unpack(q[N], $packet);
439             }
440              
441             sub _parse_extended {
442 54     54   115 my ($packet) = @_;
443 54 100 66     292 if ((!$packet) || (!length($packet))) { return; }
  2         10  
444 52         148 my ($id, $payload) = unpack(q[ca*], $packet);
445 52         294 return ([$id, scalar bdecode($payload)]);
446             }
447              
448             sub _build_dht_query_ping {
449 0     0   0 my ($tid, $id) = @_;
450 0 0       0 if (!defined $tid) {
451 0         0 carp
452             q[Net::BitTorrent::Protocol::_build_dht_query_ping() requires a 'token id' parameter];
453 0         0 return;
454             }
455 0 0       0 if (!defined $id) {
456 0         0 carp
457             q[Net::BitTorrent::Protocol::_build_dht_query_ping() requires an 'client id' parameter];
458 0         0 return;
459             }
460             return
461 0         0 bencode({t => $tid,
462             y => q[q],
463             q => q[ping],
464             a => {id => $id},
465             v => q[NB00]
466             }
467             );
468             }
469              
470             sub _build_dht_query_announce {
471 18     18   37 my ($tid, $id, $infohash, $token, $port) = @_;
472 18 50       48 if (!defined $tid) {
473 0         0 carp
474             q[Net::BitTorrent::Protocol::_build_dht_query_announce() requires a 'token id' parameter];
475 0         0 return;
476             }
477 18 50       35 if (!defined $id) {
478 0         0 carp
479             q[Net::BitTorrent::Protocol::_build_dht_query_announce() requires an 'client id' parameter];
480 0         0 return;
481             }
482 18 50       35 if (!defined $token) {
483 0         0 carp
484             q[Net::BitTorrent::Protocol::_build_dht_query_announce() requires an 'token' parameter];
485 0         0 return;
486             }
487 18 50 33     96 if ((!defined $infohash) || (length($infohash) != 20)) {
488 0         0 carp
489             q[Net::BitTorrent::Protocol::_build_dht_query_announce() requires an 'infohash' parameter];
490 0         0 return;
491             }
492 18 50 33     166 if ((!defined $tid) || ($port !~ m[^\d+$])) {
493 0         0 carp
494             q[Net::BitTorrent::Protocol::_build_dht_query_ping() requires a 'port' parameter];
495 0         0 return;
496             }
497             return
498 18         167 bencode({t => $tid,
499             y => q[q],
500             q => q[announce_peer],
501             a => {id => $id,
502             port => $port,
503             info_hash => $infohash,
504             token => $token
505             },
506             v => q[NB00]
507             }
508             );
509             }
510              
511             sub _build_dht_query_find_node {
512 47     47   105 my ($tid, $id, $target) = @_;
513 47 50       153 if (!defined $tid) {
514 0         0 carp
515             q[Net::BitTorrent::Protocol::_build_dht_query_find_node() requires a 'token id' parameter];
516 0         0 return;
517             }
518 47 50       120 if (!defined $id) {
519 0         0 carp
520             q[Net::BitTorrent::Protocol::_build_dht_query_find_node() requires an 'client id' parameter];
521 0         0 return;
522             }
523 47 50 33     262 if ((!defined $target) || (length($target) != 20)) {
524 0         0 carp
525             q[Net::BitTorrent::Protocol::_build_dht_query_find_node() requires an 'target' parameter];
526 0         0 return;
527             }
528             return
529 47         553 bencode({t => $tid,
530             y => q[q],
531             q => q[find_node],
532             a => {id => $id,
533             target => $target
534             },
535             v => q[NB00]
536             }
537             );
538             }
539              
540             sub _build_dht_query_get_peers {
541 34     34   80 my ($tid, $id, $info_hash) = @_;
542 34 50       91 if (!defined $tid) {
543 0         0 carp
544             q[Net::BitTorrent::Protocol::_build_dht_query_get_peers() requires a 'token id' parameter];
545 0         0 return;
546             }
547 34 50       241 if (!defined $id) {
548 0         0 carp
549             q[Net::BitTorrent::Protocol::_build_dht_query_get_peers() requires an 'client id' parameter];
550 0         0 return;
551             }
552 34 50 33     311 if ((!defined $info_hash) || (length($info_hash) != 20)) {
553 0         0 Carp::confess
554             q[Net::BitTorrent::Protocol::_build_dht_query_get_peers() requires an 'info_hash' parameter];
555 0         0 return;
556             }
557             return
558 34         455 bencode({t => $tid,
559             y => q[q],
560             q => q[get_peers],
561             a => {id => $id, info_hash => $info_hash},
562             v => q[NB00]
563             }
564             );
565             }
566              
567             sub _build_dht_reply_ping {
568 18     18   45 my ($tid, $id) = @_;
569 18         210 return bencode(
570             {t => $tid, y => q[r], r => {id => $id}, v => q[NB00]});
571             }
572              
573             sub _build_dht_reply_find_node {
574 47     47   109 my ($tid, $id, $nodes) = @_;
575             return
576 47         494 bencode({t => $tid,
577             y => q[r],
578             r => {id => $id, nodes => $nodes},
579             v => q[NB00]
580             }
581             );
582             }
583              
584             sub _build_dht_reply_get_peers {
585 26     26   66 my ($tid, $id, $nodes, $token) = @_;
586             return
587 26         304 bencode({t => $tid,
588             y => q[r],
589             r => {id => $id, token => $token, nodes => $nodes},
590             v => q[NB00]
591             }
592             );
593             }
594              
595             sub _build_dht_reply_values {
596 8     8   20 my ($tid, $id, $values, $token) = @_;
597             return
598 8         97 bencode({t => $tid,
599             y => q[r],
600             r => {id => $id,
601             token => $token,
602             values => $values
603             },
604             v => q[NB00]
605             }
606             );
607             }
608             1;
609             }
610              
611             =pod
612              
613             =head1 NAME
614              
615             Net::BitTorrent::Protocol - Packet utilities for the BitTorrent protocol
616              
617             =head1 Synopsis
618              
619             use Net::BitTorrent::Protocol qw[:build parse_packet];
620              
621             # Tell them what we want...
622             my $handshake = build_handshake(
623             pack('C*', split('', '00000000')),
624             pack('H*', 'ddaa46b1ddbfd3564fca526d1b68420b6cd54201'),
625             'your-peer-id-in-here'
626             );
627              
628             # And the inverse...
629             my ($reserved, $infohash, $peerid) = parse_packet( $handshake );
630              
631             =head1 Description
632              
633             What would BitTorrent be without packets? TCP noise, mostly.
634              
635             For similar work and links to the specifications behind these packets,
636             move on down to the L section.
637              
638             =head1 Exporting from Net::BitTorrent::Protocol
639              
640             There are three tags available for import. To get them all in one go,
641             use the C<:all> tag.
642              
643             =over
644              
645             =item C<:types>
646              
647             Packet types
648              
649             For more on what these packets actually mean, see the BitTorrent Spec.
650             This is a list of the currently supported packet types:
651              
652             =over
653              
654             =item HANDSHAKE
655              
656             =item KEEPALIVE
657              
658             =item CHOKE
659              
660             =item UNCHOKE
661              
662             =item INTERESTED
663              
664             =item NOT_INTERESTED
665              
666             =item HAVE
667              
668             =item BITFIELD
669              
670             =item REQUEST
671              
672             =item PIECE
673              
674             =item CANCEL
675              
676             =item PORT
677              
678             =item SUGGEST
679              
680             =item HAVE_ALL
681              
682             =item HAVE_NONE
683              
684             =item REJECT
685              
686             =item ALLOWED_FAST
687              
688             =item EXTPROTOCOL
689              
690             =back
691              
692             =item C<:build>
693              
694             These create packets ready-to-send to remote peers. See
695             L.
696              
697             =item C<:parse>
698              
699             These are used to parse unknown data into sensible packets.
700              
701             =back
702              
703             =head2 Building Functions
704              
705             =over
706              
707             =item C
708              
709             Creates an initial handshake packet. All parameters must conform to
710             the BitTorrent spec:
711              
712             =over
713              
714             =item C
715              
716             ...is the 8 byte string used to represent a client's capabilities for
717             extensions to the protocol.
718              
719             =item C
720              
721             ...is the 20 byte SHA1 hash of the bencoded info from the metainfo
722             file.
723              
724             =item C
725              
726             ...is 20 bytes.
727              
728             =back
729              
730             =item C
731              
732             Creates a keep-alive packet. The keep-alive packet is zero bytes,
733             specified with the length prefix set to zero. There is no message ID and
734             no payload. Peers may close a connection if they receive no packets
735             (keep-alive or any other packet) for a certain period of time, so a keep-
736             alive packet must be sent to maintain the connection alive if no command
737             have been sent for a given amount of time. This amount of time is
738             generally two minutes.
739              
740             =item C
741              
742             Creates a choke packet. The choke packet is fixed-length and has no
743             payload.
744              
745             See Also: http://tinyurl.com/NB-docs-choking - Choking and Optimistic
746             Unchoking
747              
748             =item C
749              
750             Creates an unchoke packet. The unchoke packet is fixed-length and
751             has no payload.
752              
753             See Also: http://tinyurl.com/NB-docs-choking - Choking and Optimistic
754             Unchoking
755              
756             =item C
757              
758             Creates an interested packet. The interested packet is fixed-length
759             and has no payload.
760              
761             =item C
762              
763             Creates a not interested packet. The not interested packet is
764             fixed-length and has no payload.
765              
766             =item C
767              
768             Creates a have packet. The have packet is fixed length. The
769             payload is the zero-based INDEX of a piece that has just been
770             successfully downloaded and verified via the hash.
771              
772             I
773             In particular because peers are extremely unlikely to download pieces
774             that they already have, a peer may choose not to advertise having a
775             piece to a peer that already has that piece. At a minimum "HAVE
776             suppression" will result in a 50% reduction in the number of HAVE
777             packets, this translates to around a 25-35% reduction in protocol
778             overhead. At the same time, it may be worthwhile to send a HAVE
779             packet to a peer that has that piece already since it will be useful
780             in determining which piece is rare.>
781              
782             I
783             it knows the peer will never download. Due to this attempting to model
784             peers using this information is a bad idea.>
785              
786             =item C
787              
788             Creates a bitfield packet. The bitfield packet is variable length,
789             where C is the length of the C. The payload is a
790             C representing the pieces that have been successfully
791             downloaded. The high bit in the first byte corresponds to piece index
792             0. Bits that are cleared indicated a missing piece, and set bits
793             indicate a valid and available piece. Spare bits at the end are set to
794             zero.
795              
796             A bitfield packet may only be sent immediately after the
797             L
798             sequence is completed, and before any other packets are sent. It is
799             optional, and need not be sent if a client has no pieces or uses one
800             of the Fast Extension packets: L or
801             L.
802              
803             =begin :parser
804              
805             I
806             should drop the connection if they receive bitfields that are not of
807             the correct size, or if the bitfield has any of the spare bits set.>
808              
809             =end :parser
810              
811             =item C
812              
813             Creates a request packet. The request packet is fixed length, and
814             is used to request a block. The payload contains the following
815             information:
816              
817             =over
818              
819             =item C
820              
821             ...is an integer specifying the zero-based piece index.
822              
823             =item C
824              
825             ...is an integer specifying the zero-based byte offset within the
826             piece.
827              
828             =item C
829              
830             ...is an integer specifying the requested length.
831              
832             =back
833              
834             See Also: L
835              
836             =item C
837              
838             Creates a piece packet. The piece packet is variable length, where
839             C is the length of the L. The payload contains the following
840             information:
841              
842             =over
843              
844             =item C
845              
846             ...is an integer specifying the zero-based piece index.
847              
848             =item C
849              
850             ...is an integer specifying the zero-based byte offset within the
851             piece.
852              
853             =item C
854              
855             ...is the block of data, which is a subset of the piece specified by
856             C.
857              
858             =back
859              
860             Before sending pieces to remote peers, the client should verify that
861             the piece matches the SHA1 hash related to it in the .torrent
862             metainfo.
863              
864             =item C
865              
866             Creates a cancel packet. The cancel packet is fixed length, and is
867             used to cancel
868             L. The
869             payload is identical to that of the
870             L packet. It is
871             typically used during 'End Game.'
872              
873             See Also: http://tinyurl.com/NB-docs-EndGame - End Game
874              
875             =item C
876              
877             Creates an extended protocol packet.
878              
879             =back
880              
881             =head3 Legacy Packets
882              
883             The following packets are either part of the base protocol or one of
884             the common extensions but have either been superseded or simply
885             removed from the majority of clients. I have provided them here only
886             for legacy support; they will not be removed in the future.
887              
888             =over
889              
890             =item C
891              
892             Creates a port packet.
893              
894             See also: http://bittorrent.org/beps/bep_0003.html - The BitTorrent
895             Protocol Specification
896              
897             =item C
898              
899             Creates an Allowed Fast packet.
900              
901             uTorrent never advertises a fast set... why should we?
902              
903             See also: http://bittorrent.org/beps/bep_0006.html - Fast Extension
904              
905             =item C
906              
907             Creates a Suggest Piece packet.
908              
909             Super seeding is not supported by Net::BitTorrent. Yet.
910              
911             See also: http://bittorrent.org/beps/bep_0006.html - Fast Extension
912              
913             =item C
914              
915             Creates a Reject Request packet.
916              
917             See also: http://bittorrent.org/beps/bep_0006.html - Fast Extension
918              
919             =item C
920              
921             Creates a Have All packet.
922              
923             See also: http://bittorrent.org/beps/bep_0006.html - Fast Extension
924              
925             =item C
926              
927             Creates a Have None packet.
928              
929             See also: http://bittorrent.org/beps/bep_0006.html - Fast Extension
930              
931             =back
932              
933             =head2 Parsing Function(s)
934              
935             =over
936              
937             =item C
938              
939             Attempts to parse any known packet from the data (a scalar ref) passed to it.
940             On success, the payload and type are returned and the packet is removed from
941             the incoming data ref. C is returned on failure.
942              
943             =back
944              
945             =head1 See Also
946              
947             http://bittorrent.org/beps/bep_0003.html - The BitTorrent Protocol
948             Specification
949              
950             http://bittorrent.org/beps/bep_0006.html - Fast Extension
951              
952             http://bittorrent.org/beps/bep_0010.html - Extension Protocol
953              
954             http://wiki.theory.org/BitTorrentSpecification - An annotated guide to
955             the BitTorrent protocol
956              
957             L - by Joshua
958             McAdams
959              
960             =head1 Author
961              
962             Sanko Robinson - http://sankorobinson.com/
963              
964             CPAN ID: SANKO
965              
966             =head1 License and Legal
967              
968             Copyright (C) 2008-2009 by Sanko Robinson Esanko@cpan.orgE
969              
970             This program is free software; you can redistribute it and/or modify
971             it under the terms of The Artistic License 2.0. See the F
972             file included with this distribution or
973             http://www.perlfoundation.org/artistic_license_2_0. For
974             clarification, see http://www.perlfoundation.org/artistic_2_0_notes.
975              
976             When separated from the distribution, all POD documentation is covered
977             by the Creative Commons Attribution-Share Alike 3.0 License. See
978             http://creativecommons.org/licenses/by-sa/3.0/us/legalcode. For
979             clarification, see http://creativecommons.org/licenses/by-sa/3.0/us/.
980              
981             Neither this module nor the L is affiliated with
982             BitTorrent, Inc.
983              
984             =for svn $Id: Protocol.pm d3c97de 2009-09-12 04:31:46Z sanko@cpan.org $
985              
986             =cut