File Coverage

blib/lib/Net/BitTorrent/Protocol/BEP07.pm
Criterion Covered Total %
statement 35 40 87.5
branch 10 24 41.6
condition 4 23 17.3
subroutine 7 7 100.0
pod 2 2 100.0
total 58 96 60.4


line stmt bran cond sub pod time code
1             package Net::BitTorrent::Protocol::BEP07;
2 2     2   517 use strict;
  2         39  
  2         55  
3 2     2   7 use warnings;
  2         2  
  2         46  
4 2     2   6 use Carp qw[carp];
  2         2  
  2         115  
5             our $VERSION = "1.5.3";
6 2     2   6 use vars qw[@EXPORT_OK %EXPORT_TAGS];
  2         2  
  2         78  
7 2     2   6 use Exporter qw[];
  2         2  
  2         817  
8             *import = *import = *Exporter::import;
9             @EXPORT_OK = qw[compact_ipv6 uncompact_ipv6];
10             %EXPORT_TAGS = (all => [@EXPORT_OK], bencode => [@EXPORT_OK]);
11              
12             sub uncompact_ipv6 {
13             return $_[0] ?
14             map {
15 2 50   2 1 9 my (@h) = unpack 'n*', $_;
  3         10  
16 3         33 [sprintf('%X:%X:%X:%X:%X:%X:%X:%X', @h), $h[-1]]
17             } $_[0] =~ m[(.{20})]g
18             : ();
19             }
20              
21             sub compact_ipv6 {
22 2     2 1 398 my $return;
23             my %seen;
24 2   33     18 PEER: for my $peer (grep(defined && !$seen{$_}++, @_)) {
25 4         7 my ($ip, $port) = @$peer;
26 4   50     8 $ip // next;
27 4 50       7 if ($port > 2**16) {
28 0         0 carp 'Port number beyond ephemeral range: ' . $peer;
29             }
30             else {
31 4 50       8 next PEER unless $ip;
32 4 50       20 if ($ip =~ /^(.+):(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
33             { # mixed hex, dot-quad
34 0 0 0     0 next PEER if $2 > 255 || $3 > 255 || $4 > 255 || $5 > 255;
      0        
      0        
35 0         0 $ip = sprintf("%s:%X%02X:%X%02X", $1, $2, $3, $4, $5)
36             ; # convert to pure hex
37             }
38 4         3 my $c;
39             next PEER
40 4 50 33     30 if $ip =~ /[^:0-9a-fA-F]/ || # non-hex character
41             #(($c = $ip) =~ s/::/x/ && $c =~ /(?:x|:):/)
42             #|| # double :: ::?
43             $ip =~ /[0-9a-fA-F]{5,}/; # more than 4 digits
44 4         6 $c = $ip =~ tr/:/:/; # count the colons
45 4 50 33     10 next PEER if $c < 7 && $ip !~ /::/;
46 4 50       6 if ($c > 7) { # strip leading or trailing ::
47 0 0 0     0 next PEER unless $ip =~ s/^::/:/ || $ip =~ s/::$/:/;
48 0 0       0 next PEER if --$c > 7;
49             }
50 4         7 $ip =~ s/::/:::/ while $c++ < 7; # expand compressed fields
51 4 50       8 $ip .= 0 if $ip =~ /:$/;
52 4 100       17 next if $seen{$ip . '|'. $port}++;
53 3         27 $return .= pack('H36', join '', split /:/, $ip) . pack 'n', $port;
54             }
55             }
56 2         11 return $return;
57             }
58             1;
59              
60             =pod
61              
62             =head1 NAME
63              
64             Net::BitTorrent::Protocol::BEP07 - Utility functions for BEP07: IPv6 Tracker Extension
65              
66             =head1 Importing From Net::BitTorrent::Protocol::BEP07
67              
68             By default, nothing is exported.
69              
70             You may import any of the following or use one or more of these tag:
71              
72             =over
73              
74             =item C<:all>
75              
76             Imports the tracker response-related functions
77             L and
78             L.
79              
80             =back
81              
82             =head1 Functions
83              
84             =over
85              
86             =item C
87              
88             Compacts a list of [IPv6, port] values into a single string.
89              
90             A compact peer is 18 bytes; the first 16 bytes are the host and the last two
91             bytes are the port.
92              
93             =item C
94              
95             Inflates a compacted string of peers and returns a list of [IPv6, port]
96             values.
97              
98             =back
99              
100             =head1 See Also
101              
102             =over
103              
104             =item BEP 07: IPv6 Tracker Extension - http://bittorrent.org/beps/bep_0007.html
105              
106             =back
107              
108             =head1 Author
109              
110             Sanko Robinson - http://sankorobinson.com/
111              
112             CPAN ID: SANKO
113              
114             =head1 License and Legal
115              
116             Copyright (C) 2010-2012 by Sanko Robinson
117              
118             This program is free software; you can redistribute it and/or modify it under
119             the terms of
120             L.
121             See the F file included with this distribution or
122             L
123             for clarification.
124              
125             When separated from the distribution, all original POD documentation is
126             covered by the
127             L.
128             See the
129             L.
130              
131             Neither this module nor the L is affiliated with BitTorrent,
132             Inc.
133              
134             =cut