File Coverage

blib/lib/Net/Frame/Device.pm
Criterion Covered Total %
statement 18 20 90.0
branch n/a
condition 1 2 50.0
subroutine 7 7 100.0
pod n/a
total 26 29 89.6


line stmt bran cond sub pod time code
1             #
2             # $Id: Device.pm 359 2015-01-04 16:49:32Z gomor $
3             #
4             package Net::Frame::Device;
5 3     3   41419 use strict;
  3         5  
  3         137  
6 3     3   17 use warnings;
  3         4  
  3         177  
7              
8             our $VERSION = '1.11';
9              
10 3     3   17 use base qw(Class::Gomor::Array);
  3         17  
  3         2020  
11             our @AS = qw(
12             dev
13             mac
14             ip
15             ip6
16             subnet
17             subnet6
18             gatewayIp
19             gatewayIp6
20             gatewayMac
21             gatewayMac6
22             target
23             target6
24             _dnet
25             );
26             __PACKAGE__->cgBuildIndices;
27             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
28              
29             BEGIN {
30 3     3   83232 my $osname = {
31             cygwin => [ \&_getDevWin32, ],
32             MSWin32 => [ \&_getDevWin32, ],
33             };
34              
35 3   50     116 *_getDev = $osname->{$^O}->[0] || \&_getDevOther;
36             }
37              
38 3     3   29 no strict 'vars';
  3         5  
  3         131  
39              
40 3     3   17 use Data::Dumper;
  3         5  
  3         146  
41 3     3   9031 use Net::Libdnet6;
  0            
  0            
42             use Net::IPv4Addr;
43             use Net::IPv6Addr;
44             use Net::Pcap;
45             use Net::Write::Layer2;
46             use Net::Frame::Dump qw(:consts);
47             use Net::Frame::Dump::Online2;
48             use Net::Frame::Layer qw(:subs);
49             use Net::Frame::Layer::ETH qw(:consts);
50             use Net::Frame::Layer::ARP qw(:consts);
51             use Net::Frame::Layer::IPv6 qw(:consts);
52             use Net::Frame::Layer::ICMPv6 qw(:consts);
53             use Net::Frame::Layer::ICMPv6::NeighborSolicitation;
54             use Net::Frame::Simple;
55              
56             sub new {
57             my $self = shift->SUPER::new(@_);
58              
59             $self->[$__target] && return $self->updateFromTarget;
60             $self->[$__target6] && return $self->updateFromTarget6;
61             $self->[$__dev] && return $self->updateFromDev;
62              
63             return $self->updateFromDefault;
64             }
65              
66             sub _update {
67             my $self = shift;
68             my ($dnet6) = @_;
69              
70             $self->[$__dev] = $self->_getDev;
71             $self->[$__mac] = $self->_getMac;
72             $self->[$__ip] = $self->_getIp;
73             $self->[$__subnet] = $self->_getSubnet;
74             $self->[$__gatewayIp] = $self->_getGatewayIp;
75             $self->[$__gatewayMac] = $self->_getGatewayMac;
76              
77             if ($dnet6) {
78             $self->[$___dnet] = $dnet6;
79             }
80              
81             $self->[$__ip6] = $self->_getIp6;
82             $self->[$__subnet6] = $self->_getSubnet6;
83             $self->[$__gatewayIp6] = $self->_getGatewayIp6;
84              
85             $self->[$___dnet] = undef;
86              
87             return $self;
88             }
89              
90             # By default, we take outgoing device to Internet
91             sub updateFromDefault {
92             my $self = shift;
93              
94             my $dnet = intf_get_dst('1.1.1.1');
95             if (! $dnet || keys %$dnet == 0) {
96             die("Net::Frame::Device: updateFromDefault: unable to get dnet\n");
97             }
98             $self->[$___dnet] = $dnet;
99              
100             my $dnet6 = intf_get6($dnet->{name});
101             if (! $dnet6 || keys %$dnet6 == 0) {
102             return $self;
103             }
104              
105             return $self->_update($dnet6);
106             }
107              
108             sub updateFromDev {
109             my $self = shift;
110             my ($dev) = @_;
111              
112             if (defined($dev)) {
113             $self->[$__dev] = $dev;
114             }
115             else {
116             $dev = $self->[$__dev];
117             }
118              
119             my $dnet = intf_get($dev);
120             if (! $dnet || keys %$dnet == 0) {
121             die("Net::Frame::Device: updateFromDev: unable to get dnet\n");
122             }
123             $self->[$___dnet] = $dnet;
124              
125             my $dnet6 = intf_get6($dev);
126             if (! $dnet6 || keys %$dnet6 == 0) {
127             return $self;
128             }
129              
130             return $self->_update($dnet6);
131             }
132              
133             sub updateFromTarget {
134             my $self = shift;
135             my ($target) = @_;
136              
137             if (defined($target)) {
138             $self->[$__target] = $target;
139             }
140             else {
141             $target = $self->[$__target];
142             }
143              
144             my $dnet = intf_get_dst($target);
145             if (! $dnet || keys %$dnet == 0) {
146             die("Net::Frame::Device: updateFromTarget: unable to get dnet\n");
147             }
148             $self->[$___dnet] = $dnet;
149              
150             my $dnet6 = intf_get6($dnet->{name});
151             if (! $dnet6 || keys %$dnet6 == 0) {
152             return $self;
153             }
154              
155             return $self->_update($dnet6);
156             }
157              
158             sub updateFromTarget6 {
159             my $self = shift;
160             my ($target6) = @_;
161             $self->[$__target6] = $target6 if $target6;
162             my @dnetList = intf_get_dst6($self->[$__target6]);
163             if (@dnetList > 1) {
164             if (! $self->[$__dev]) {
165             die("[-] ".__PACKAGE__.": Multiple possible network interface for ".
166             "target6, choose `dev' manually\n");
167             }
168             $self->[$___dnet] = intf_get6($self->[$__dev])
169             or die("Net::Frame::Device: updateFromTarget6: unable to get dnet\n");
170             }
171             elsif (@dnetList == 1) {
172             $self->[$___dnet] = $dnetList[0];
173             }
174             else {
175             die("Net::Frame::Device: updateFromTarget6: unable to get dnet\n");
176             }
177             return $self->_update;
178             }
179              
180             # Thanx to Maddingue
181             sub _toDotQuad {
182             my ($i) = @_;
183             ($i >> 24 & 255).'.'.($i >> 16 & 255).'.'.($i >> 8 & 255).'.'.($i & 255);
184             }
185              
186             sub _getDevWin32 {
187             my $self = shift;
188              
189             die("[-] ".__PACKAGE__.": unable to find a suitable device\n")
190             unless $self->[$___dnet]->{name};
191              
192             # Get dnet interface name and its subnet
193             my $dnet = $self->[$___dnet]->{name};
194             my $subnet = addr_net($self->[$___dnet]->{addr});
195             die("[-] ".__PACKAGE__.": Net::Libdnet::addr_net() error\n")
196             unless $subnet;
197              
198             my %dev;
199             my $err;
200             Net::Pcap::findalldevs(\%dev, \$err);
201             die("[-] ".__PACKAGE__.": Net::Pcap::findalldevs() error: $err\n")
202             if $err;
203              
204             # Search for corresponding WinPcap interface, via subnet value.
205             # I can't use IP address or MAC address, they are not available
206             # through Net::Pcap (as of version 0.15_01).
207             for my $d (keys %dev) {
208             my $net;
209             my $mask;
210             if (Net::Pcap::lookupnet($d, \$net, \$mask, \$err) < 0) {
211             die("[-] ".__PACKAGE__.": Net::Pcap::lookupnet(): $d: $err\n")
212             }
213             $net = _toDotQuad($net);
214             if ($net eq $subnet) {
215             return $d;
216             }
217             }
218             undef;
219             }
220              
221             sub _getDevOther { shift->[$___dnet]->{name} || undef }
222              
223             sub _getGatewayIp { route_get (shift()->[$__target] || '1.1.1.1') || undef }
224             sub _getGatewayIp6 { route_get6(shift()->[$__target6] || '2001::1') || undef }
225              
226             sub _getMacFromCache { shift; arp_get(shift()) }
227              
228             sub _getGatewayMac {
229             my $self = shift;
230             $self->[$__gatewayIp] && $self->_getMacFromCache($self->[$__gatewayIp])
231             || undef;
232             }
233              
234             sub _getSubnet {
235             my $addr = shift->[$___dnet]->{addr};
236             return unless $addr;
237             if ($addr !~ /\//) {
238             return; # No netmask associated here
239             }
240             my $subnet = addr_net($addr) or return;
241             (my $mask = $addr) =~ s/^.*(\/\d+)$/$1/;
242             $subnet.$mask;
243             }
244              
245             sub _getSubnet6 {
246             my $addr = shift->[$___dnet]->{addr6};
247             return unless $addr;
248             if ($addr !~ /\//) {
249             return; # No netmask associated here
250             }
251             my $subnet = addr_net6($addr) or return;
252             (my $mask = $addr) =~ s/^.*(\/\d+)$/$1/;
253             $subnet.$mask;
254             }
255              
256             sub _getMac { shift->[$___dnet]->{link_addr} || undef }
257              
258             sub _getIp {
259             my $ip = shift->[$___dnet]->{addr} || return undef;
260             $ip =~ s/\/\d+$//;
261             $ip;
262             }
263              
264             sub _getIp6 {
265             my $ip = shift->[$___dnet]->{addr6} || return undef;
266             $ip =~ s/\/\d+$//;
267             $ip;
268             }
269              
270             sub _lookupMac {
271             my $self = shift;
272             my ($ip, $retry, $timeout) = @_;
273              
274             my $oWrite = Net::Write::Layer2->new(dev => $self->[$__dev]);
275             my $oDump = Net::Frame::Dump::Online2->new(
276             dev => $self->[$__dev],
277             filter => 'arp',
278             timeoutOnNext => $timeout,
279             );
280              
281             $oDump->start;
282             if ($oDump->firstLayer ne 'ETH') {
283             $oDump->stop;
284             die("[-] ".__PACKAGE__.": lookupMac: can't do that on non-ethernet ".
285             "link layers\n");
286             }
287              
288             $oWrite->open;
289              
290             my $eth = Net::Frame::Layer::ETH->new(
291             src => $self->[$__mac],
292             dst => NF_ETH_ADDR_BROADCAST,
293             type => NF_ETH_TYPE_ARP,
294             );
295             my $arp = Net::Frame::Layer::ARP->new(
296             src => $self->[$__mac],
297             srcIp => $self->[$__ip],
298             dstIp => $ip,
299             );
300             $eth->pack;
301             $arp->pack;
302              
303             # We retry three times
304             my $mac;
305             for (1..$retry) {
306             $oWrite->send($eth->raw.$arp->raw);
307             until ($oDump->timeout) {
308             if (my $h = $oDump->next) {
309             if ($h->{firstLayer} eq 'ETH') {
310             my $raw = substr($h->{raw}, $eth->getLength);
311             my $rArp = Net::Frame::Layer::ARP->new(raw => $raw);
312             $rArp->unpack;
313             next unless $rArp->srcIp eq $ip;
314             $mac = $rArp->src;
315             last;
316             }
317             }
318             }
319             last if $mac;
320             $oDump->timeoutReset;
321             }
322              
323             $oWrite->close;
324             $oDump->stop;
325              
326             return $mac;
327             }
328              
329             sub lookupMac {
330             my $self = shift;
331             my ($ip, $retry, $timeout) = @_;
332              
333             $retry ||= 1;
334             $timeout ||= 1;
335              
336             # First, lookup the ARP cache table
337             my $mac = $self->_getMacFromCache($ip);
338             return $mac if $mac;
339              
340             # Then, is the target on same subnet, or not ?
341             if (Net::IPv4Addr::ipv4_in_network($self->[$__subnet], $ip)) {
342             return $self->_lookupMac($ip, $retry, $timeout);
343             }
344             # Get gateway MAC
345             else {
346             # If already retrieved
347             return $self->[$__gatewayMac] if $self->[$__gatewayMac];
348              
349             # Else, lookup it, and store it
350             my $gatewayMac = $self->_lookupMac(
351             $self->[$__gatewayIp], $retry, $timeout,
352             );
353             $self->[$__gatewayMac] = $gatewayMac;
354             return $gatewayMac;
355             }
356              
357             return;
358             }
359              
360             sub _lookupMac6 {
361             my $self = shift;
362             my ($ip6, $srcIp6, $retry, $timeout) = @_;
363              
364             my $oWrite = Net::Write::Layer2->new(dev => $self->[$__dev]);
365             my $oDump = Net::Frame::Dump::Online2->new(
366             dev => $self->[$__dev],
367             filter => 'icmp6',
368             timeoutOnNext => $timeout,
369             );
370              
371             $oDump->start;
372             if ($oDump->firstLayer ne 'ETH') {
373             $oDump->stop;
374             die("[-] ".__PACKAGE__.": lookupMac6: can't do that on non-ethernet ".
375             "link layers\n");
376             }
377              
378             $oWrite->open;
379              
380             my $srcMac = $self->[$__mac];
381              
382             # XXX: risky
383             my $target6 = Net::IPv6Addr->new($ip6)->to_string_preferred;
384             my @dst = split(':', $target6);
385             my $str = $dst[-2];
386             $str =~ s/^.*(..)$/$1/;
387             $target6 = 'ff02::1:ff'.$str.':'.$dst[-1];
388              
389             my $eth = Net::Frame::Layer::ETH->new(
390             src => $srcMac,
391             dst => NF_ETH_ADDR_BROADCAST,
392             type => NF_ETH_TYPE_IPv6,
393             );
394             my $ip = Net::Frame::Layer::IPv6->new(
395             src => $srcIp6,
396             dst => $target6,
397             nextHeader => NF_IPv6_PROTOCOL_ICMPv6,
398             );
399             my $icmp = Net::Frame::Layer::ICMPv6->new(
400             type => NF_ICMPv6_TYPE_NEIGHBORSOLICITATION,
401             );
402             my $icmpType = Net::Frame::Layer::ICMPv6::NeighborSolicitation->new(
403             targetAddress => $ip6,
404             options => [
405             Net::Frame::Layer::ICMPv6::Option->new(
406             type => NF_ICMPv6_OPTION_SOURCELINKLAYERADDRESS,
407             length => 1,
408             value => pack('H2H2H2H2H2H2', split(':', $srcMac)),
409             ),
410             ],
411             );
412              
413             my $oSimple = Net::Frame::Simple->new(
414             layers => [ $eth, $ip, $icmp, $icmpType ],
415             );
416              
417             # We retry three times
418             my $mac;
419             FIRST:
420             for (1..$retry) {
421             $oWrite->send($oSimple->raw);
422             until ($oDump->timeout) {
423             if (my $oReply = $oSimple->recv($oDump)) {
424             for ($oReply->ref->{'ICMPv6::NeighborAdvertisement'}->options) {
425             if ($_->type eq NF_ICMPv6_OPTION_TARGETLINKLAYERADDRESS) {
426             $mac = convertMac(unpack('H*', $_->value));
427             if ($mac !~
428             /^[a-f0-9]{2}:[a-f0-9]{2}:[a-f0-9]{2}:[a-f0-9]{2}:[a-f0-9]{2}:[a-f0-9]{2}$/i) {
429             die("[-] ".__PACKAGE__.": lookupMac6: ".
430             "MAC address format error: [$mac]\n");
431             }
432             last FIRST;
433             }
434             }
435             }
436             }
437             $oDump->timeoutReset;
438             }
439              
440             $oWrite->close;
441             $oDump->stop;
442              
443             return $mac;
444             }
445              
446             sub _searchSrcIp6 {
447             my $self = shift;
448             my ($ip6) = @_;
449             my @dnet6 = intf_get_dst6($ip6) or return undef;
450             my $dev = $self->[$__dev];
451             my $dnet6;
452             for (@dnet6) {
453             if ($_->{name} eq $dev) {
454             $dnet6 = $_;
455             last;
456             }
457             }
458             my ($srcIp6) = split('/', $dnet6->{addr6});
459             $srcIp6;
460             }
461              
462             sub lookupMac6 {
463             my $self = shift;
464             my ($ip6, $retry, $timeout) = @_;
465              
466             $retry ||= 1;
467             $timeout ||= 1;
468              
469             # XXX: No ARP6 cache support for now
470              
471             # If target IPv6 begins with fe80, we are on the same subnet,
472             # we lookup its MAC address
473             if ($ip6 =~ /^fe80/i) {
474             # We must change source IPv6 address to the one of same subnet
475             my $srcIp6 = $self->_searchSrcIp6($ip6);
476             return $self->_lookupMac6($ip6, $srcIp6, $retry, $timeout);
477             }
478             # Otherwise, we lookup the gateway MAC address, and store it
479             else {
480             # If already retrieved
481             return $self->[$__gatewayMac6] if $self->[$__gatewayMac6];
482              
483             # No IPv6 gateway?
484             if (! $self->[$__gatewayIp6]) {
485             print("[-] lookupMac6: no IPv6 gateway, no default route?\n");
486             return;
487             }
488              
489             # Else, lookup it, and store it
490             # We must change source IPv6 address to the one of same subnet
491             my $srcIp6 = $self->_searchSrcIp6($self->[$__gatewayIp6]);
492             my $gatewayMac6 = $self->_lookupMac6(
493             $self->[$__gatewayIp6], $srcIp6, $retry, $timeout,
494             );
495             $self->[$__gatewayMac6] = $gatewayMac6;
496             return $gatewayMac6;
497             }
498              
499             return;
500             }
501              
502             sub debugDeviceList {
503             my %dev;
504             my $err;
505             Net::Pcap::findalldevs(\%dev, \$err);
506             print STDERR "findalldevs: error: $err\n" if $err;
507              
508             # Net::Pcap stuff
509             for my $d (keys %dev) {
510             my ($net, $mask);
511             if (Net::Pcap::lookupnet($d, \$net, \$mask, \$err) < 0) {
512             print STDERR "lookupnet: error: $d: $err\n";
513             $err = undef; next;
514             }
515             print STDERR "[$d] => subnet: "._toDotQuad($net)."\n";
516             }
517              
518             # Net::Libdnet stuff
519             for my $i (0..5) {
520             my $eth = 'eth'.$i;
521             my $dnet = intf_get($eth);
522             last unless keys %$dnet > 0;
523             $dnet->{subnet} = addr_net($dnet->{addr})
524             if $dnet->{addr};
525             print STDERR Dumper($dnet)."\n";
526             }
527             }
528              
529             1;
530              
531             __END__