line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Protocol::BitTorrent; |
2
|
|
|
|
|
|
|
# ABSTRACT: abstract implementation of the bittorrent p2p protocol |
3
|
4
|
|
|
4
|
|
98746
|
use strict; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
129
|
|
4
|
4
|
|
|
4
|
|
21
|
use warnings; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
146
|
|
5
|
4
|
|
|
4
|
|
3138
|
use parent qw(Protocol::BitTorrent::Bencode); |
|
4
|
|
|
|
|
1168
|
|
|
4
|
|
|
|
|
19
|
|
6
|
|
|
|
|
|
|
use utf8; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '0.004'; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 NAME |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Protocol::BitTorrent - protocol-level support for BitTorrent and .torrent files |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 VERSION |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
version 0.004 |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 SYNOPSIS |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
package BitTorrent::Implementation; |
21
|
|
|
|
|
|
|
use Protocol::BitTorrent; |
22
|
|
|
|
|
|
|
... |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 DESCRIPTION |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
This distribution provides handling for the BitTorrent protocol at an abstract |
27
|
|
|
|
|
|
|
level. Although some utilities are provided for dealing with .torrent files, |
28
|
|
|
|
|
|
|
the intention is for this class to act as a base for building BitTorrent |
29
|
|
|
|
|
|
|
client/server/tracker implementations, rather than a complete independent package. |
30
|
|
|
|
|
|
|
Specifically, no attempt is made to listen or connect to network sockets. |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
See L for information on dealing with |
33
|
|
|
|
|
|
|
.torrent files, and also check the C< examples/ > and C< bin/ > directories |
34
|
|
|
|
|
|
|
for examples of code using these classes. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
An actual working client+tracker implementation can be found in |
37
|
|
|
|
|
|
|
L. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=cut |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
use Protocol::BitTorrent::Metainfo; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
use Convert::Bencode_XS qw(); |
44
|
|
|
|
|
|
|
use Try::Tiny; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head1 METHODS |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=cut |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head2 new |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=cut |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub new { bless {}, shift } |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head2 parse_metainfo |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
Parse .torrent data and return a L instance. |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=cut |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub parse_metainfo { |
63
|
|
|
|
|
|
|
my $self = shift; |
64
|
|
|
|
|
|
|
my $encoded = shift; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
my $decoded = try { |
67
|
|
|
|
|
|
|
$self->bdecode($encoded); |
68
|
|
|
|
|
|
|
} catch { |
69
|
|
|
|
|
|
|
# Ensure we have a recognisable string at the start of the error message |
70
|
|
|
|
|
|
|
die "Parse error: $_\n"; |
71
|
|
|
|
|
|
|
}; |
72
|
|
|
|
|
|
|
return Protocol::BitTorrent::Metainfo->new->parse_info($decoded); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head2 generate_metainfo |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
Wrapper around L for creating new .torrent data. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=cut |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub generate_metainfo { |
82
|
|
|
|
|
|
|
my $self = shift; |
83
|
|
|
|
|
|
|
my %args = @_; |
84
|
|
|
|
|
|
|
return Protocol::BitTorrent::Metainfo->new(%args); |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
{ # peer type mapping |
88
|
|
|
|
|
|
|
my %azureus_peer_types = ( |
89
|
|
|
|
|
|
|
'AG' => 'Ares', |
90
|
|
|
|
|
|
|
'A~' => 'Ares', |
91
|
|
|
|
|
|
|
'AR' => 'Arctic', |
92
|
|
|
|
|
|
|
'AT' => 'Artemis', |
93
|
|
|
|
|
|
|
'AX' => 'BitPump', |
94
|
|
|
|
|
|
|
'AZ' => 'Azureus', |
95
|
|
|
|
|
|
|
'BB' => 'BitBuddy', |
96
|
|
|
|
|
|
|
'BC' => 'BitComet', |
97
|
|
|
|
|
|
|
'BF' => 'Bitflu', |
98
|
|
|
|
|
|
|
'BG' => 'BTG', |
99
|
|
|
|
|
|
|
'BL' => 'BitBlinder', |
100
|
|
|
|
|
|
|
'BP' => 'BitTorrent Pro', |
101
|
|
|
|
|
|
|
'BR' => 'BitRocket', |
102
|
|
|
|
|
|
|
'BS' => 'BTSlave', |
103
|
|
|
|
|
|
|
'BW' => 'BitWombat', |
104
|
|
|
|
|
|
|
'BX' => '~Bittorrent X', |
105
|
|
|
|
|
|
|
'CD' => 'Enhanced CTorrent', |
106
|
|
|
|
|
|
|
'CT' => 'CTorrent', |
107
|
|
|
|
|
|
|
'DE' => 'DelugeTorrent', |
108
|
|
|
|
|
|
|
'DP' => 'Propagate Data Client', |
109
|
|
|
|
|
|
|
'EB' => 'EBit', |
110
|
|
|
|
|
|
|
'ES' => 'electric sheep', |
111
|
|
|
|
|
|
|
'FC' => 'FileCroc', |
112
|
|
|
|
|
|
|
'FT' => 'FoxTorrent', |
113
|
|
|
|
|
|
|
'GS' => 'GSTorrent', |
114
|
|
|
|
|
|
|
'HK' => 'Hekate', |
115
|
|
|
|
|
|
|
'HL' => 'Halite', |
116
|
|
|
|
|
|
|
'HM' => 'hMule', |
117
|
|
|
|
|
|
|
'HN' => 'Hydranode', |
118
|
|
|
|
|
|
|
'KG' => 'KGet', |
119
|
|
|
|
|
|
|
'KT' => 'KTorrent', |
120
|
|
|
|
|
|
|
'LC' => 'LeechCraft', |
121
|
|
|
|
|
|
|
'LH' => 'LH-ABC', |
122
|
|
|
|
|
|
|
'LP' => 'Lphant', |
123
|
|
|
|
|
|
|
'LT' => 'libtorrent', |
124
|
|
|
|
|
|
|
'lt' => 'libTorrent', |
125
|
|
|
|
|
|
|
'LW' => 'LimeWire', |
126
|
|
|
|
|
|
|
'MK' => 'Meerkat', |
127
|
|
|
|
|
|
|
'MO' => 'MonoTorrent', |
128
|
|
|
|
|
|
|
'MP' => 'MooPolice', |
129
|
|
|
|
|
|
|
'MR' => 'Miro', |
130
|
|
|
|
|
|
|
'MT' => 'MoonlightTorrent', |
131
|
|
|
|
|
|
|
'NX' => 'Net Transport', |
132
|
|
|
|
|
|
|
'OS' => 'OneSwarm', |
133
|
|
|
|
|
|
|
'OT' => 'OmegaTorrent', |
134
|
|
|
|
|
|
|
'PD' => 'Pando', |
135
|
|
|
|
|
|
|
'PT' => 'PHPTracker', |
136
|
|
|
|
|
|
|
'qB' => 'qBittorrent', |
137
|
|
|
|
|
|
|
'QD' => 'QQDownload', |
138
|
|
|
|
|
|
|
'QT' => 'Qt 4 Torrent example', |
139
|
|
|
|
|
|
|
'RT' => 'Retriever', |
140
|
|
|
|
|
|
|
'RZ' => 'RezTorrent', |
141
|
|
|
|
|
|
|
'S~' => 'Shareaza alpha/beta', |
142
|
|
|
|
|
|
|
'SB' => '~Swiftbit', |
143
|
|
|
|
|
|
|
'SD' => 'Thunder (aka XunLei)', |
144
|
|
|
|
|
|
|
'SM' => 'SoMud', |
145
|
|
|
|
|
|
|
'SS' => 'SwarmScope', |
146
|
|
|
|
|
|
|
'ST' => 'SymTorrent', |
147
|
|
|
|
|
|
|
'st' => 'sharktorrent', |
148
|
|
|
|
|
|
|
'SZ' => 'Shareaza', |
149
|
|
|
|
|
|
|
'TN' => 'TorrentDotNET', |
150
|
|
|
|
|
|
|
'TR' => 'Transmission', |
151
|
|
|
|
|
|
|
'TS' => 'Torrentstorm', |
152
|
|
|
|
|
|
|
'TT' => 'TuoTu', |
153
|
|
|
|
|
|
|
'UL' => 'uLeecher!', |
154
|
|
|
|
|
|
|
'UM' => 'µTorrent for Mac', |
155
|
|
|
|
|
|
|
'UT' => 'µTorrent', |
156
|
|
|
|
|
|
|
'VG' => 'Vagaa', |
157
|
|
|
|
|
|
|
'WT' => 'BitLet', |
158
|
|
|
|
|
|
|
'WY' => 'FireTorrent', |
159
|
|
|
|
|
|
|
'XL' => 'Xunlei', |
160
|
|
|
|
|
|
|
'XS' => 'XSwifter', |
161
|
|
|
|
|
|
|
'XT' => 'XanTorrent', |
162
|
|
|
|
|
|
|
'XX' => 'Xtorrent', |
163
|
|
|
|
|
|
|
'ZT' => 'ZipTorrent', |
164
|
|
|
|
|
|
|
); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=head2 peer_type_from_id |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
Returns the client type for a given peer_id. |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=cut |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub peer_type_from_id { |
173
|
|
|
|
|
|
|
my $self = shift; |
174
|
|
|
|
|
|
|
my $peer_id = shift; |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# Handle us first |
177
|
|
|
|
|
|
|
return "Protocol::BitTorrent v$1.$2" if $peer_id =~ /^-PB(\d)(\d{3})-/; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# Azureus-style clients |
180
|
|
|
|
|
|
|
if($peer_id =~ /^-(..)(....)-/) { |
181
|
|
|
|
|
|
|
my $type = $azureus_peer_types{$1} || 'Unknown'; |
182
|
|
|
|
|
|
|
my $v = join '.', map hex, split //, $2; |
183
|
|
|
|
|
|
|
return "$type v$v"; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
return 'unknown'; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
1; |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
__END__ |