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


line stmt bran cond sub pod time code
1             package Net::BitTorrent::Protocol;
2 1     1   587 use strict;
  1         1  
  1         22  
3 1     1   3 use warnings;
  1         1  
  1         34  
4             our $VERSION = "1.5.2";
5 1     1   14 use lib '../../../lib';
  1         1  
  1         5  
6 1     1   583 use Net::BitTorrent::Protocol::BEP03 qw[:all];
  1         2  
  1         258  
7 1     1   452 use Net::BitTorrent::Protocol::BEP03::Bencode qw[:all];
  1         1  
  1         87  
8 1     1   440 use Net::BitTorrent::Protocol::BEP05 qw[:all];
  1         1  
  1         112  
9 1     1   427 use Net::BitTorrent::Protocol::BEP06 qw[:all];
  1         2  
  1         146  
10 1     1   418 use Net::BitTorrent::Protocol::BEP07 qw[:all];
  1         1  
  1         86  
11 1     1   424 use Net::BitTorrent::Protocol::BEP09 qw[:all];
  1         2  
  1         87  
12 1     1   438 use Net::BitTorrent::Protocol::BEP10 qw[:all];
  1         1  
  1         87  
13 1     1   386 use Net::BitTorrent::Protocol::BEP23 qw[:all];
  1         1  
  1         99  
14             #use Net::BitTorrent::Protocol::BEP44 qw[:all];
15 1     1   4 use Carp qw[carp];
  1         1  
  1         29  
16 1     1   3 use vars qw[@EXPORT_OK %EXPORT_TAGS];
  1         1  
  1         28  
17 1     1   3 use Exporter qw[];
  1         0  
  1         500  
18             *import = *import = *Exporter::import;
19             %EXPORT_TAGS = (
20             build => [@{$Net::BitTorrent::Protocol::BEP03::EXPORT_TAGS{build}},
21             @{$Net::BitTorrent::Protocol::BEP05::EXPORT_TAGS{build}},
22             @{$Net::BitTorrent::Protocol::BEP06::EXPORT_TAGS{build}},
23             @{$Net::BitTorrent::Protocol::BEP09::EXPORT_TAGS{build}},
24             @{$Net::BitTorrent::Protocol::BEP10::EXPORT_TAGS{build}},
25             #@{$Net::BitTorrent::Protocol::BEP44::EXPORT_TAGS{build}}
26             ],
27             bencode => [@{ $Net::BitTorrent::Protocol::BEP03::Bencode::EXPORT_TAGS{all}
28             },
29             ],
30             compact => [@{$Net::BitTorrent::Protocol::BEP07::EXPORT_TAGS{all}},
31             @{$Net::BitTorrent::Protocol::BEP23::EXPORT_TAGS{all}}
32             ],
33             dht => [@{$Net::BitTorrent::Protocol::BEP05::EXPORT_TAGS{all}},
34             #@{$Net::BitTorrent::Protocol::BEP44::EXPORT_TAGS{build}}
35             ],
36             parse => [@{$Net::BitTorrent::Protocol::BEP03::EXPORT_TAGS{parse}},
37             @{$Net::BitTorrent::Protocol::BEP06::EXPORT_TAGS{parse}},
38             @{$Net::BitTorrent::Protocol::BEP10::EXPORT_TAGS{parse}},
39             qw[parse_packet]
40             ],
41             types => [@{$Net::BitTorrent::Protocol::BEP03::EXPORT_TAGS{types}},
42             @{$Net::BitTorrent::Protocol::BEP06::EXPORT_TAGS{types}},
43             @{$Net::BitTorrent::Protocol::BEP10::EXPORT_TAGS{types}}
44             ],
45             utils => [@{$Net::BitTorrent::Protocol::BEP06::EXPORT_TAGS{utils}}]
46             );
47             @EXPORT_OK = sort map { @$_ = sort @$_; @$_ } values %EXPORT_TAGS;
48             $EXPORT_TAGS{'all'} = \@EXPORT_OK;
49             my $parse_packet_dispatch;
50             #
51             sub parse_packet ($) {
52 44   100 44 1 12803 $parse_packet_dispatch ||= {$KEEPALIVE => \&parse_keepalive,
53             $CHOKE => \&parse_choke,
54             $UNCHOKE => \&parse_unchoke,
55             $INTERESTED => \&parse_interested,
56             $NOT_INTERESTED => \&parse_not_interested,
57             $HAVE => \&parse_have,
58             $BITFIELD => \&parse_bitfield,
59             $REQUEST => \&parse_request,
60             $PIECE => \&parse_piece,
61             $CANCEL => \&parse_cancel,
62             $PORT => \&parse_port,
63             $SUGGEST => \&parse_suggest,
64             $HAVE_ALL => \&parse_have_all,
65             $HAVE_NONE => \&parse_have_none,
66             $REJECT => \&parse_reject,
67             $ALLOWED_FAST => \&parse_allowed_fast,
68             $EXTENDED => \&parse_extended
69             };
70 44         48 my ($data) = @_;
71 44 100 100     247 if ((!$data) || (ref($data) ne 'SCALAR') || (!$$data)) {
      100        
72 5         532 carp sprintf '%s::parse_packet() needs data to parse', __PACKAGE__;
73 5         85 return;
74             }
75 39         37 my ($packet);
76 39 100 33     295 if (unpack('c', $$data) == 0x13) {
    50          
77 1         5 my @payload = parse_handshake(substr($$data, 0, 68, ''));
78 1 50       7 $packet = {type => $HANDSHAKE,
79             packet_length => 68,
80             payload_length => 48,
81             payload => @payload
82             }
83             if @payload;
84             }
85             elsif ( (defined unpack('N', $$data))
86             and (unpack('N', $$data) =~ m[\d]))
87 38         44 { my $packet_length = unpack('N', $$data);
88 38 100       64 if ($packet_length + 4 <= length($$data)) {
89 37         108 (my ($packet_data), $$data) = unpack('N/aa*', $$data);
90 37         45 my $packet_length = 4 + length $packet_data;
91 37         63 (my ($type), $packet_data) = unpack('ca*', $packet_data);
92 37 100       178 if (defined $parse_packet_dispatch->{$type}) {
    50          
93 35         97 my $payload = $parse_packet_dispatch->{$type}($packet_data);
94             $packet
95             = ref $payload eq 'HASH'
96 35 100 33     178 && defined $payload->{error} ? $payload
    50          
97             : {type => $type,
98             packet_length => $packet_length,
99             (defined $payload ? (
100             payload => $payload,
101             payload_length => length $packet_data
102             )
103             : (payload_length => 0)
104             ),
105             };
106             }
107             elsif (eval 'require Data::Dump') {
108 0         0 carp
109             sprintf
110             <<'END', Data::Dump::pp($type), Data::Dump::pp($packet);
111             Unhandled/Unknown packet where:
112             Type = %s
113             Packet = %s
114             END
115             }
116             }
117             else {
118 1         5 $packet = {packet_length => $packet_length,
119             fatal => 0,
120             error => 'Not enough data yet! We need '
121             . $packet_length
122             . ' bytes but have '
123             . length $$data
124             };
125             }
126             }
127 39         204 return $packet;
128             }
129             1;
130              
131             =pod
132              
133             =head1 NAME
134              
135             Net::BitTorrent::Protocol - Basic, Protocol-level BitTorrent Utilities
136              
137             =head1 Synopsis
138              
139             use Net::BitTorrent::Protocol;
140             ...
141              
142             =head1 Functions
143              
144             In addition to the functions found in L,
145             L,
146             L, L,
147             L, L,
148             L, L,
149             TODO..., a function which wraps all the packet parsing functions is provided:
150              
151             =over
152              
153             =item C
154              
155             Attempts to parse any known packet from the data (a scalar ref) passed to it.
156             On success, the payload and type are returned and the packet is removed from
157             the incoming data reference. C is returned on failure and the data
158             in the reference is unchanged.
159              
160             =back
161              
162             =head1 Importing from Net::BitTorrent::Protocol
163              
164             You may import from this module manually...
165              
166             use Net::BitTorrent::Protocol 'build_handshake';
167              
168             ...or by using one or more of the provided tags:
169              
170             use Net::BitTorrent::Protocol ':all';
171              
172             Supported tags include...
173              
174             =over
175              
176             =item C
177              
178             Imports everything.
179              
180             =item C
181              
182             Imports all packet building functions from
183             L,
184             L,
185             L,
186             L, and
187             L.
188              
189             =item C
190              
191             Imports the bencode and bdecode functions found in
192             L.
193              
194             =item C
195              
196             Imports the compact and inflation functions for IPv4
197             (L) and IPv6
198             (L) peer lists.
199              
200             =item C
201              
202             Imports all functions related to L and
203             L.
204              
205             =item C
206              
207             Imports all packet parsing functions from
208             L,
209             L, and
210             L as well as the locally defined
211             L|/parse_packet( \$data )> function.
212              
213             =item C
214              
215             Imports the packet type values from L,
216             L, and
217             L.
218              
219             =item C
220              
221             Imports the utility functions from L.
222              
223             =back
224              
225             =head1 See Also
226              
227             L - Simple client which uses
228             L
229              
230             http://bittorrent.org/beps/bep_0003.html - The BitTorrent Protocol
231             Specification
232              
233             http://bittorrent.org/beps/bep_0006.html - Fast Extension
234              
235             http://bittorrent.org/beps/bep_0009.html - Extension for Peers to Send Metadata Files
236              
237             http://bittorrent.org/beps/bep_0010.html - Extension Protocol
238              
239             http://bittorrent.org/beps/bep_0044.html - Storing arbitrary data in the DHT
240              
241             http://wiki.theory.org/BitTorrentSpecification - An annotated guide to
242             the BitTorrent protocol
243              
244             L - by Joshua
245             McAdams
246              
247             L - by Tom Molesworth
248              
249             =head1 Author
250              
251             Sanko Robinson - http://sankorobinson.com/
252              
253             CPAN ID: SANKO
254              
255             =head1 License and Legal
256              
257             Copyright (C) 2008-2014 by Sanko Robinson
258              
259             This program is free software; you can redistribute it and/or modify it under
260             the terms of
261             L.
262             See the F file included with this distribution or
263             L
264             for clarification.
265              
266             When separated from the distribution, all original POD documentation is
267             covered by the
268             L.
269             See the
270             L.
271              
272             Neither this module nor the L is affiliated with BitTorrent,
273             Inc.
274              
275             =cut