File Coverage

blib/lib/Net/Packet/Utils.pm
Criterion Covered Total %
statement 21 161 13.0
branch 0 46 0.0
condition 0 5 0.0
subroutine 7 30 23.3
pod n/a
total 28 242 11.5


line stmt bran cond sub pod time code
1             #
2             # $Id: Utils.pm 1640 2009-11-09 17:58:27Z gomor $
3             #
4             package Net::Packet::Utils;
5 29     29   166 use strict;
  29         57  
  29         1740  
6 29     29   159 use warnings;
  29         56  
  29         937  
7 29     29   141 use Carp;
  29         50  
  29         5365  
8              
9             require Exporter;
10             our @ISA = qw(Exporter);
11              
12             our @EXPORT_OK = qw(
13             getHostIpv4Addr
14             getHostIpv4Addrs
15             getHostIpv6Addr
16             getRandomHighPort
17             getRandom32bitsInt
18             getRandom16bitsInt
19             convertMac
20             unpackIntFromNet
21             packIntToNet
22             inetChecksum
23             inetAton
24             inetNtoa
25             inet6Aton
26             inet6Ntoa
27             explodeIps
28             explodePorts
29             getGatewayIp
30             getGatewayMac
31             getIpMac
32             debugDeviceList
33             );
34              
35             our %EXPORT_TAGS = (
36             all => [ @EXPORT_OK ],
37             );
38              
39 29     29   52145 use Socket;
  29         203556  
  29         28863  
40 29     29   57110 use Socket6 qw(NI_NUMERICHOST NI_NUMERICSERV inet_pton inet_ntop getaddrinfo getnameinfo);
  29         1046873  
  29         64504  
41             require Net::Libdnet;
42             require Net::IPv4Addr;
43             require Net::IPv6Addr;
44             require Net::Packet::Env;
45              
46             sub getHostIpv4Addr {
47 0     0     my $name = shift;
48              
49 0 0         return undef unless $name;
50 0 0         return $name if $name =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;
51              
52 0           my @addrs = (gethostbyname($name))[4];
53 0 0         @addrs ? return join('.', unpack('C4', $addrs[0]))
54 0           : carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname\n");
55 0           return undef;
56             }
57              
58             sub getHostIpv4Addrs {
59 0     0     my $name = shift;
60              
61 0 0         return undef unless $name;
62 0 0         return $name if $name =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;
63              
64 0           my @addrs = (gethostbyname($name))[4];
65 0 0         @addrs ? return @addrs
66 0           : carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname\n");
67 0           return ();
68             }
69              
70             sub getHostIpv6Addr {
71 0     0     my $name = shift;
72              
73 0 0         return undef unless $name;
74 0 0         return $name if Net::IPv6Addr::is_ipv6($name);
75              
76 0           my @res = getaddrinfo($name, 'ssh', AF_INET6, SOCK_STREAM);
77 0 0         if (@res >= 5) {
78 0           my ($ipv6) = getnameinfo($res[3], NI_NUMERICHOST | NI_NUMERICSERV);
79 0           $ipv6 =~ s/%.*$//;
80 0           return $ipv6;
81             }
82             else {
83 0           carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname\n");
  0            
84             }
85 0           return undef;
86             }
87              
88 0     0     sub inetAton { inet_aton(shift()) }
89 0     0     sub inetNtoa { inet_ntoa(shift()) }
90 0     0     sub inet6Aton { inet_pton(AF_INET6, shift()) }
91 0     0     sub inet6Ntoa { inet_ntop(AF_INET6, shift()) }
92              
93             sub getRandomHighPort {
94 0     0     my $highPort = int rand 0xffff;
95 0 0         $highPort += 1024 if $highPort < 1025;
96 0           return $highPort;
97             }
98              
99 0     0     sub getRandom32bitsInt { int rand 0xffffffff }
100 0     0     sub getRandom16bitsInt { int rand 0xffff }
101              
102             sub convertMac {
103 0     0     my $mac = shift;
104 0           $mac =~ s/(..)/$1:/g;
105 0           $mac =~ s/:$//;
106 0           return lc $mac;
107             }
108              
109             sub unpackIntFromNet {
110 0     0     my ($net, $format, $offset, $pad, $bit) = @_;
111 0           unpack($format, pack('B*', 0 x $pad . substr($net, $offset, $bit)));
112             }
113              
114             sub packIntToNet {
115 0     0     my ($int, $format, $offset, $bit) = @_;
116 0           substr(unpack('B*', pack($format, $int << $bit)), $offset, $bit);
117             }
118              
119             sub inetChecksum {
120 0     0     my $phpkt = shift;
121              
122 0 0         $phpkt .= "\x00" if length($phpkt) % 2;
123 0           my $len = length $phpkt;
124 0           my $nshort = $len / 2;
125 0           my $checksum = 0;
126 0           $checksum += $_ for unpack("S$nshort", $phpkt);
127 0 0         $checksum += unpack('C', substr($phpkt, $len - 1, 1)) if $len % 2;
128 0           $checksum = ($checksum >> 16) + ($checksum & 0xffff);
129              
130 0           unpack('n', pack('S', ~(($checksum >> 16) + $checksum) & 0xffff));
131             }
132              
133             sub explodePorts {
134 0     0     my @ports;
135 0           do { s/-/../g; push @ports, $_ for eval } for split /,/, shift();
  0            
  0            
136 0           @ports;
137             }
138              
139             sub explodeIps {
140 0     0     my @ips;
141 0           for (split(/,/, shift())) {
142 0           my @bytes;
143 0           do { s/-/../g; push @bytes, $_ } for split(/\./);
  0            
  0            
144 0           for my $b1 (eval($bytes[0])) {
145 0           for my $b2 (eval($bytes[1])) {
146 0           for my $b3 (eval($bytes[2])) {
147 0           for my $b4 (eval($bytes[3])) {
148 0           push @ips, "$b1.$b2.$b3.$b4";
149             }
150             }
151             }
152             }
153             }
154 0           @ips;
155             }
156              
157 0     0     sub _getMacFromCache { Net::Libdnet::arp_get(shift()) }
158              
159 0 0 0 0     sub getGatewayIp { Net::Libdnet::route_get(shift() || '1.1.1.1') || '0.0.0.0' }
160              
161             sub getGatewayMac {
162 0     0     my ($ip) = @_;
163 0   0       my $mac = _getMacFromCache($ip) || _arpLookup($ip);
164 0           $mac;
165             }
166              
167             sub getIpMac {
168 0     0     my ($ip) = @_;
169              
170 0           my $mac = _getMacFromCache($ip);
171 0 0         return $mac if $mac;
172              
173 0           my $env = Net::Packet::Env->new;
174 0           $env->updateDevInfo($ip);
175              
176 0 0         if (Net::IPv4Addr::ipv4_in_network($env->subnet, $ip)) {
177 0           $mac = _arpLookup($ip, $env);
178             }
179             else {
180 0           $mac = getGatewayMac($env->gatewayIp);
181             }
182 0           $mac;
183             }
184              
185             sub _arpLookup {
186 0     0     my ($ip, $env) = @_;
187              
188 0           require Net::Packet::DescL2;
189 0           require Net::Packet::Dump;
190 0           require Net::Packet::Frame;
191 0           require Net::Packet::ETH;
192 0           require Net::Packet::ARP;
193 29     29   48759 use Net::Packet::Consts qw(:eth :arp);
  29         98  
  29         29202  
194              
195 0 0         $env = Net::Packet::Env->new unless $env;
196              
197 0           my $pEnv = $env->cgClone;
198 0           $pEnv->updateDevInfo($ip);
199 0           $pEnv->desc(undef);
200 0           $pEnv->dump(undef);
201 0           $pEnv->noFrameAutoDesc(1);
202 0           $pEnv->noFrameAutoDump(1);
203 0           $pEnv->noDescAutoSet(1);
204 0           $pEnv->noDumpAutoSet(1);
205 0           $pEnv->debug(0);
206              
207 0           my $d2 = Net::Packet::DescL2->new(
208             dev => $pEnv->dev,
209             ip => $pEnv->ip,
210             mac => $pEnv->mac,
211             );
212              
213 0           my $dump = Net::Packet::Dump->new(
214             dev => $pEnv->dev,
215             env => $pEnv,
216             overwrite => 1,
217             filter => 'arp and dst '.$pEnv->ip,
218             );
219 0           $dump->start;
220 0           $pEnv->dump($dump);
221              
222 0           my $eth = Net::Packet::ETH->new(
223             src => $pEnv->mac,
224             dst => 'ff:ff:ff:ff:ff:ff',
225             type => NP_ETH_TYPE_ARP,
226             );
227              
228 0           my $arp = Net::Packet::ARP->new(
229             dstIp => $ip,
230             srcIp => $pEnv->ip,
231             hType => NP_ARP_HTYPE_ETH,
232             pType => NP_ARP_PTYPE_IPv4,
233             hSize => NP_ARP_HSIZE_ETH,
234             pSize => NP_ARP_PSIZE_IPv4,
235             opCode => NP_ARP_OPCODE_REQUEST,
236             );
237              
238 0           my $frame = Net::Packet::Frame->new(
239             l2 => $eth,
240             l3 => $arp,
241             );
242              
243 0           my $mac;
244 0           for (1..3) {
245 0           $frame->send;
246 0           until ($dump->timeout) {
247 0 0         if (my $reply = $frame->recv) {
248 0           $mac = $reply->l3->src;
249 0           last;
250             }
251             }
252              
253 0 0         last if $mac;
254 0           $dump->timeoutReset;
255             }
256              
257 0           $d2->close;
258 0           $dump->stop;
259 0           $dump->clean;
260              
261 0 0         if ($mac) {
262 0           Net::Libdnet::arp_add($ip, $mac);
263 0           return $mac;
264             }
265              
266 0           '00:00:00:00:00:00';
267             }
268              
269             # Thanx to Maddingue
270             sub _toDotQuad {
271 0     0     my ($i) = @_;
272 0           ($i >> 24 & 255).'.'.($i >> 16 & 255).'.'.($i >> 8 & 255).'.'.($i & 255);
273             }
274              
275             sub debugDeviceList {
276 29     29   54465 use Data::Dumper;
  29         2894600  
  29         12597  
277 0     0     require Net::Pcap;
278              
279 0           my %dev;
280             my $err;
281 0           Net::Pcap::findalldevs(\%dev, \$err);
282 0 0         print STDERR "findalldevs: error: $err\n" if $err;
283              
284             # Net::Pcap stuff
285 0           for my $d (keys %dev) {
286 0           my ($net, $mask);
287 0 0         if (Net::Pcap::lookupnet($d, \$net, \$mask, \$err) < 0) {
288 0           print STDERR "lookupnet: error: $d: $err\n";
289 0           $err = undef; next;
  0            
290             }
291 0           print STDERR "[$d] => subnet: "._toDotQuad($net)."\n";
292             }
293              
294             # Net::Libdnet stuff
295 0           for my $i (0..5) {
296 0           my $eth = 'eth'.$i;
297 0           my $dnet = Net::Libdnet::intf_get($eth);
298 0 0         last unless keys %$dnet > 0;
299 0 0         $dnet->{subnet} = Net::Libdnet::addr_net($dnet->{addr})
300             if $dnet->{addr};
301 0           print STDERR Dumper($dnet)."\n";
302             }
303             }
304              
305             1;
306              
307             =head1 NAME
308              
309             Net::Packet::Utils - useful subroutines used in Net::Packet
310              
311             =head1 SYNOPSIS
312              
313             # Load all subroutines
314             use Net::Packet::Utils qw(:all);
315              
316             # Load only specific subroutines
317             use Net::Packet::Utils qw(explodeIps explodePorts);
318              
319             my @ips = explodeIps('192.168.0.1-254,192.168.1.1');
320             my @ports = explodePorts('1-1024,6000');
321              
322             print "@ips\n";
323             print "@ports\n";
324              
325             =head1 DESCRIPTION
326              
327             This module is not object oriented, it just implements some utilities used accros Net::Packet framework. They may be useful in other modules too, so here lies their descriptions.
328              
329             =head1 SUBROUTINES
330              
331             =over 4
332              
333             =item B (scalar)
334              
335             Tries to resolve hostname passed as an argument. Returns its IP address.
336              
337             =item B (scalar)
338              
339             Tries to resolve hostname passed as an argument. Returns an array of IP addresses.
340              
341             =item B (scalar)
342              
343             Tries to resolve hostname passed as an argument. Returns its IPv6 address.
344              
345             =item B (scalar)
346              
347             Returns numeric value of IP address passed as an argument.
348              
349             =item B (scalar)
350              
351             Returns IP address of numeric value passed as an argument.
352              
353             =item B (scalar)
354              
355             Returns numeric value of IPv6 address passed as an argument.
356              
357             =item B (scalar)
358              
359             Returns IPv6 address of numeric value passed as an argument.
360              
361             =item B
362              
363             Returns a port number for direct use as source in a TCP or UDP header (that is a port between 1025 and 65535).
364              
365             =item B
366              
367             Returns a random integer of 32 bits in length.
368              
369             =item B
370              
371             Returns a random integer of 16 bits in length.
372              
373             =item B (scalar)
374              
375             Converts a MAC address from network format to human format.
376              
377             =item B (scalar, scalar, scalar, scalar, scalar)
378              
379             Almost used internally, to convert network bits to integers. First argument is what to convert, second is an unpack format, third the offset of first argument where bits to get begins, the fourth are padding bits to achieve the length we need, and the last is the number of bits to get from offset argument.
380              
381             =item B (scalar, scalar, scalar, scalar)
382              
383             Almost used internally, to convert integers to network bits. First argument is what to convert, second is a pack format, third the offset where to store the first argument, and the last the number of bits the integer will be once packed.
384              
385             =item B (scalar)
386              
387             Compute the INET checksum used in various layers.
388              
389             =item B
390              
391             =item B
392              
393             See B.
394              
395             =item B [ (scalar) ]
396              
397             Returns the gateway IP address for IP address passed as a parameter. If none provided, returns the default gateway IP address.
398              
399             =item B (scalar)
400              
401             Returns the gateway MAC address of specified gateway IP address. It first looks up from ARP cache table, then tries an ARP lookup if none was found, and adds it to ARP cache table.
402              
403             =item B (scalar)
404              
405             Returns the MAC address of specified IP address. It first looks up from ARP cache table. If nothing is found, it checks to see if the specified IP address is on the same subnet. If not, it returns the gateway MAC address, otherwise does an ARP lookup. Then, the ARP cache table is updated if an ARP resolution has been necessary.
406              
407             =item B
408              
409             If you have problem under Windows concerning network interfaces, please send me the output of this method.
410              
411             =back
412              
413             =head1 AUTHOR
414              
415             Patrice EGomoRE Auffret
416              
417             =head1 COPYRIGHT AND LICENSE
418              
419             Copyright (c) 2004-2009, Patrice EGomoRE Auffret
420            
421             You may distribute this module under the terms of the Artistic license.
422             See LICENSE.Artistic file in the source distribution archive.
423            
424             =head1 RELATED MODULES
425              
426             L, L, L
427            
428             =cut