Net-Frame-Device-1.12000755001750001750 012624330260 14037 5ustar00gomorgomor000000000000Net-Frame-Device-1.12/MANIFEST000444001750001750 63712624330260 15313 0ustar00gomorgomor000000000000Build.PL bin/nfd-debug-devices.pl bin/nfd-print-routes6.pl Changes examples/get-mac6.pl examples/get-mac.pl examples/new-default.pl examples/new-from-dev.pl examples/new-from-target6.pl examples/new-from-target.pl lib/Net/Frame/Device.pm LICENSE LICENSE.Artistic Makefile.PL MANIFEST This list of files README t/01-use.t t/02-pod-coverage.t t/03-test-pod.t t/04-new-default.t t/05-new-target.t META.yml META.json Net-Frame-Device-1.12/README000444001750001750 146312624330260 15060 0ustar00gomorgomor000000000000Net::Frame::Device ================== INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: Perl v5.6.1 Class::Gomor Net::Libdnet Net::Libdnet6 Net::IPv4Addr Net::IPv6Addr Net::Pcap Net::Write Net::Frame Net::Frame::Dump Net::Frame::Layer::IPv6 Net::Frame::Layer::ICMPv6 Net::Frame::Simple GETTING HELP A mailing list is available for all questions concerning Net::Frame::*: https://www.secure-side.com/lists/mailman/listinfo/netframe COPYRIGHT AND LICENSE You may distribute this module under the terms of the Artistic license. See LICENSE.Artistic file in the source distribution archive. Copyright (c) 2006-2015, Patrice Auffret Net-Frame-Device-1.12/Makefile.PL000444001750001750 201112624330260 16140 0ustar00gomorgomor000000000000# # $Id: Makefile.PL 359 2015-01-04 16:49:32Z gomor $ # use ExtUtils::MakeMaker; require v5.6.1; WriteMakefile( NAME => 'Net::Frame::Device', VERSION_FROM => 'lib/Net/Frame/Device.pm', LICENSE => 'artistic', ABSTRACT_FROM => 'lib/Net/Frame/Device.pm', AUTHOR => 'GomoR ', PREREQ_PM => { Class::Gomor => '1.00', Net::Libdnet => 0, Net::Libdnet6 => 0, Net::IPv4Addr => 0, Net::IPv6Addr => 0, Net::Pcap => '0.12', Net::Write => '1.00', Net::Frame => 0, Net::Frame::Dump => '1.08', # For Dump::Online2 Net::Frame::Layer::IPv6 => 0, Net::Frame::Layer::ICMPv6 => 0, Net::Frame::Simple => '1.05', # Cause of a bug in ICMPv6 unpacking }, MIN_PERL_VERSION => '5.6.1', EXE_FILES => [ 'bin/nfd-debug-devices.pl', 'bin/nfd-print-routes6.pl', ], ); Net-Frame-Device-1.12/Build.PL000444001750001750 156012624330260 15472 0ustar00gomorgomor000000000000# # $Id: Build.PL 359 2015-01-04 16:49:32Z gomor $ # use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Net::Frame::Device', license => 'artistic', dist_author => 'GomoR ', dist_version_from => 'lib/Net/Frame/Device.pm', requires => { 'perl' => '5.6.1', 'Class::Gomor' => '1.00', 'Net::Libdnet' => 0, 'Net::Libdnet6' => 0, 'Net::IPv4Addr' => 0, 'Net::IPv6Addr' => 0, 'Net::Pcap' => '0.12', 'Net::Write' => '1.00', 'Net::Frame' => 0, 'Net::Frame::Dump' => '1.08', # For Dump::Online2 'Net::Frame::Layer::IPv6' => 0, 'Net::Frame::Layer::ICMPv6' => 0, 'Net::Frame::Simple' => '1.05', # Cause of a bug in ICMPv6 unpacking }, configure_requires => { 'Module::Build' => 0, }, ); $builder->create_build_script; Net-Frame-Device-1.12/LICENSE000444001750001750 26512624330260 15164 0ustar00gomorgomor000000000000LICENSE This program is free software. You can redistribute it and/or modify it under the following terms: - the Perl Artistic License (in the file LICENSE.Artistic), Net-Frame-Device-1.12/Changes000444001750001750 411612624330260 15471 0ustar00gomorgomor000000000000Revision history for Perl extension Net::Frame::Device. 1.12 Sun Nov 22 13:07:50 CET 2015 - bugfix: add Build.PL to manifest file 1.11 Sun Jan 4 17:47:17 CET 2015 - bugfix: some code was never reached in new() and made a warning to be printed - copyright: 2015 1.10 Sun Dec 2 17:08:27 CET 2012 - bugfix: analyze response to lookupMac6 to check MAC address is valid 1.09 Fri Nov 16 16:28:14 CET 2012 - new: bin/nfd-print-routes6.pl - bugfix: install bin/nfd-debug-devices.pl and bin/nfd-print-routes6.pl - bugfix: Perl kwalitee 1.08 Wed Sep 12 20:26:23 CEST 2012 - bugfix: Don't try lookupMac6() if gatewayIp6 has not been found - update: dependance on Net::Frame::Simple 1.05 forced - update: error message scheme - update: copyright notice 1.07 Wed Nov 16 23:32:20 CET 2011 - bugfix: correctly check return status from dnet calls - bugfix: check if an address has a correct netmask (or ignore subnet attribute) 1.06 Sat Mar 26 19:01:23 CET 2011 - feature: lookupMac() and lookupMac6() takes two additionnal parameters: retry count and timeout in seconds. 1.05 Thu Jan 13 11:04:32 CET 2011 - bugfix: load Net::Frame::Layer::ICMPv6::NeighborSolicitation - bugfix: make lookupMac6() work - bugfix: update interface information on IPv6 stuff - update: copyright notice 1.04 Thu Jun 3 15:44:42 CEST 2010 - bugfix: die() on fatal errors from dnet - bugfix: new() returns undef on error - update: mailing list URL, see README - update: copyright notice and email address 1.03 Wed Feb 28 22:07:28 CET 2007 - bugfix: lookupMac*(): check for link layer type before building frame 1.02 Thu Dec 28 17:05:27 CET 2006 - NEW: IPv6 support (*BSD and Linux systems for now) - new: methods: lookupMac6(), updateFromTarget6() - new: attributes: subnet6, gatewayIp6, gatewayMac6, target6 - new examples - new dependances 1.01 Sun Dec 17 17:22:29 CET 2006 - NEW: debug-devices.pl in bin/ directory - UPDATE: all layers moved to Net::Frame::Layer::* namespace 1.00 Sat Dec 9 19:03:24 CET 2006 - first public release Net-Frame-Device-1.12/META.yml000444001750001750 155612624330260 15454 0ustar00gomorgomor000000000000--- abstract: 'get network device information and gateway' author: - 'GomoR ' build_requires: {} configure_requires: Module::Build: '0' dynamic_config: 1 generated_by: 'Module::Build version 0.421, CPAN::Meta::Converter version 2.142690' license: artistic meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Net-Frame-Device provides: Net::Frame::Device: file: lib/Net/Frame/Device.pm version: '1.12' requires: Class::Gomor: '1.00' Net::Frame: '0' Net::Frame::Dump: '1.08' Net::Frame::Layer::ICMPv6: '0' Net::Frame::Layer::IPv6: '0' Net::Frame::Simple: '1.05' Net::IPv4Addr: '0' Net::IPv6Addr: '0' Net::Libdnet: '0' Net::Libdnet6: '0' Net::Pcap: '0.12' Net::Write: '1.00' perl: v5.6.1 resources: license: http://www.perlfoundation.org/artistic_license_1_0 version: '1.12' Net-Frame-Device-1.12/META.json000444001750001750 251612624330260 15621 0ustar00gomorgomor000000000000{ "abstract" : "get network device information and gateway", "author" : [ "GomoR " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.421", "license" : [ "artistic_1" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-Frame-Device", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0" } }, "runtime" : { "requires" : { "Class::Gomor" : "1.00", "Net::Frame" : "0", "Net::Frame::Dump" : "1.08", "Net::Frame::Layer::ICMPv6" : "0", "Net::Frame::Layer::IPv6" : "0", "Net::Frame::Simple" : "1.05", "Net::IPv4Addr" : "0", "Net::IPv6Addr" : "0", "Net::Libdnet" : "0", "Net::Libdnet6" : "0", "Net::Pcap" : "0.12", "Net::Write" : "1.00", "perl" : "v5.6.1" } } }, "provides" : { "Net::Frame::Device" : { "file" : "lib/Net/Frame/Device.pm", "version" : "1.12" } }, "release_status" : "stable", "resources" : { "license" : [ "http://www.perlfoundation.org/artistic_license_1_0" ] }, "version" : "1.12" } Net-Frame-Device-1.12/LICENSE.Artistic000444001750001750 1373412624330260 17012 0ustar00gomorgomor000000000000 The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Net-Frame-Device-1.12/lib000755001750001750 012624330260 14605 5ustar00gomorgomor000000000000Net-Frame-Device-1.12/lib/Net000755001750001750 012624330260 15333 5ustar00gomorgomor000000000000Net-Frame-Device-1.12/lib/Net/Frame000755001750001750 012624330260 16365 5ustar00gomorgomor000000000000Net-Frame-Device-1.12/lib/Net/Frame/Device.pm000444001750001750 4267112624330260 20311 0ustar00gomorgomor000000000000# # $Id: Device.pm 361 2015-11-22 12:13:39Z gomor $ # package Net::Frame::Device; use strict; use warnings; our $VERSION = '1.12'; use base qw(Class::Gomor::Array); our @AS = qw( dev mac ip ip6 subnet subnet6 gatewayIp gatewayIp6 gatewayMac gatewayMac6 target target6 _dnet ); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); BEGIN { my $osname = { cygwin => [ \&_getDevWin32, ], MSWin32 => [ \&_getDevWin32, ], }; *_getDev = $osname->{$^O}->[0] || \&_getDevOther; } no strict 'vars'; use Data::Dumper; use Net::Libdnet6; use Net::IPv4Addr; use Net::IPv6Addr; use Net::Pcap; use Net::Write::Layer2; use Net::Frame::Dump qw(:consts); use Net::Frame::Dump::Online2; use Net::Frame::Layer qw(:subs); use Net::Frame::Layer::ETH qw(:consts); use Net::Frame::Layer::ARP qw(:consts); use Net::Frame::Layer::IPv6 qw(:consts); use Net::Frame::Layer::ICMPv6 qw(:consts); use Net::Frame::Layer::ICMPv6::NeighborSolicitation; use Net::Frame::Simple; sub new { my $self = shift->SUPER::new(@_); $self->[$__target] && return $self->updateFromTarget; $self->[$__target6] && return $self->updateFromTarget6; $self->[$__dev] && return $self->updateFromDev; return $self->updateFromDefault; } sub _update { my $self = shift; my ($dnet6) = @_; $self->[$__dev] = $self->_getDev; $self->[$__mac] = $self->_getMac; $self->[$__ip] = $self->_getIp; $self->[$__subnet] = $self->_getSubnet; $self->[$__gatewayIp] = $self->_getGatewayIp; $self->[$__gatewayMac] = $self->_getGatewayMac; if ($dnet6) { $self->[$___dnet] = $dnet6; } $self->[$__ip6] = $self->_getIp6; $self->[$__subnet6] = $self->_getSubnet6; $self->[$__gatewayIp6] = $self->_getGatewayIp6; $self->[$___dnet] = undef; return $self; } # By default, we take outgoing device to Internet sub updateFromDefault { my $self = shift; my $dnet = intf_get_dst('1.1.1.1'); if (! $dnet || keys %$dnet == 0) { die("Net::Frame::Device: updateFromDefault: unable to get dnet\n"); } $self->[$___dnet] = $dnet; my $dnet6 = intf_get6($dnet->{name}); if (! $dnet6 || keys %$dnet6 == 0) { return $self; } return $self->_update($dnet6); } sub updateFromDev { my $self = shift; my ($dev) = @_; if (defined($dev)) { $self->[$__dev] = $dev; } else { $dev = $self->[$__dev]; } my $dnet = intf_get($dev); if (! $dnet || keys %$dnet == 0) { die("Net::Frame::Device: updateFromDev: unable to get dnet\n"); } $self->[$___dnet] = $dnet; my $dnet6 = intf_get6($dev); if (! $dnet6 || keys %$dnet6 == 0) { return $self; } return $self->_update($dnet6); } sub updateFromTarget { my $self = shift; my ($target) = @_; if (defined($target)) { $self->[$__target] = $target; } else { $target = $self->[$__target]; } my $dnet = intf_get_dst($target); if (! $dnet || keys %$dnet == 0) { die("Net::Frame::Device: updateFromTarget: unable to get dnet\n"); } $self->[$___dnet] = $dnet; my $dnet6 = intf_get6($dnet->{name}); if (! $dnet6 || keys %$dnet6 == 0) { return $self; } return $self->_update($dnet6); } sub updateFromTarget6 { my $self = shift; my ($target6) = @_; $self->[$__target6] = $target6 if $target6; my @dnetList = intf_get_dst6($self->[$__target6]); if (@dnetList > 1) { if (! $self->[$__dev]) { die("[-] ".__PACKAGE__.": Multiple possible network interface for ". "target6, choose `dev' manually\n"); } $self->[$___dnet] = intf_get6($self->[$__dev]) or die("Net::Frame::Device: updateFromTarget6: unable to get dnet\n"); } elsif (@dnetList == 1) { $self->[$___dnet] = $dnetList[0]; } else { die("Net::Frame::Device: updateFromTarget6: unable to get dnet\n"); } return $self->_update; } # Thanx to Maddingue sub _toDotQuad { my ($i) = @_; ($i >> 24 & 255).'.'.($i >> 16 & 255).'.'.($i >> 8 & 255).'.'.($i & 255); } sub _getDevWin32 { my $self = shift; die("[-] ".__PACKAGE__.": unable to find a suitable device\n") unless $self->[$___dnet]->{name}; # Get dnet interface name and its subnet my $dnet = $self->[$___dnet]->{name}; my $subnet = addr_net($self->[$___dnet]->{addr}); die("[-] ".__PACKAGE__.": Net::Libdnet::addr_net() error\n") unless $subnet; my %dev; my $err; Net::Pcap::findalldevs(\%dev, \$err); die("[-] ".__PACKAGE__.": Net::Pcap::findalldevs() error: $err\n") if $err; # Search for corresponding WinPcap interface, via subnet value. # I can't use IP address or MAC address, they are not available # through Net::Pcap (as of version 0.15_01). for my $d (keys %dev) { my $net; my $mask; if (Net::Pcap::lookupnet($d, \$net, \$mask, \$err) < 0) { die("[-] ".__PACKAGE__.": Net::Pcap::lookupnet(): $d: $err\n") } $net = _toDotQuad($net); if ($net eq $subnet) { return $d; } } undef; } sub _getDevOther { shift->[$___dnet]->{name} || undef } sub _getGatewayIp { route_get (shift()->[$__target] || '1.1.1.1') || undef } sub _getGatewayIp6 { route_get6(shift()->[$__target6] || '2001::1') || undef } sub _getMacFromCache { shift; arp_get(shift()) } sub _getGatewayMac { my $self = shift; $self->[$__gatewayIp] && $self->_getMacFromCache($self->[$__gatewayIp]) || undef; } sub _getSubnet { my $addr = shift->[$___dnet]->{addr}; return unless $addr; if ($addr !~ /\//) { return; # No netmask associated here } my $subnet = addr_net($addr) or return; (my $mask = $addr) =~ s/^.*(\/\d+)$/$1/; $subnet.$mask; } sub _getSubnet6 { my $addr = shift->[$___dnet]->{addr6}; return unless $addr; if ($addr !~ /\//) { return; # No netmask associated here } my $subnet = addr_net6($addr) or return; (my $mask = $addr) =~ s/^.*(\/\d+)$/$1/; $subnet.$mask; } sub _getMac { shift->[$___dnet]->{link_addr} || undef } sub _getIp { my $ip = shift->[$___dnet]->{addr} || return undef; $ip =~ s/\/\d+$//; $ip; } sub _getIp6 { my $ip = shift->[$___dnet]->{addr6} || return undef; $ip =~ s/\/\d+$//; $ip; } sub _lookupMac { my $self = shift; my ($ip, $retry, $timeout) = @_; my $oWrite = Net::Write::Layer2->new(dev => $self->[$__dev]); my $oDump = Net::Frame::Dump::Online2->new( dev => $self->[$__dev], filter => 'arp', timeoutOnNext => $timeout, ); $oDump->start; if ($oDump->firstLayer ne 'ETH') { $oDump->stop; die("[-] ".__PACKAGE__.": lookupMac: can't do that on non-ethernet ". "link layers\n"); } $oWrite->open; my $eth = Net::Frame::Layer::ETH->new( src => $self->[$__mac], dst => NF_ETH_ADDR_BROADCAST, type => NF_ETH_TYPE_ARP, ); my $arp = Net::Frame::Layer::ARP->new( src => $self->[$__mac], srcIp => $self->[$__ip], dstIp => $ip, ); $eth->pack; $arp->pack; # We retry three times my $mac; for (1..$retry) { $oWrite->send($eth->raw.$arp->raw); until ($oDump->timeout) { if (my $h = $oDump->next) { if ($h->{firstLayer} eq 'ETH') { my $raw = substr($h->{raw}, $eth->getLength); my $rArp = Net::Frame::Layer::ARP->new(raw => $raw); $rArp->unpack; next unless $rArp->srcIp eq $ip; $mac = $rArp->src; last; } } } last if $mac; $oDump->timeoutReset; } $oWrite->close; $oDump->stop; return $mac; } sub lookupMac { my $self = shift; my ($ip, $retry, $timeout) = @_; $retry ||= 1; $timeout ||= 1; # First, lookup the ARP cache table my $mac = $self->_getMacFromCache($ip); return $mac if $mac; # Then, is the target on same subnet, or not ? if (Net::IPv4Addr::ipv4_in_network($self->[$__subnet], $ip)) { return $self->_lookupMac($ip, $retry, $timeout); } # Get gateway MAC else { # If already retrieved return $self->[$__gatewayMac] if $self->[$__gatewayMac]; # Else, lookup it, and store it my $gatewayMac = $self->_lookupMac( $self->[$__gatewayIp], $retry, $timeout, ); $self->[$__gatewayMac] = $gatewayMac; return $gatewayMac; } return; } sub _lookupMac6 { my $self = shift; my ($ip6, $srcIp6, $retry, $timeout) = @_; my $oWrite = Net::Write::Layer2->new(dev => $self->[$__dev]); my $oDump = Net::Frame::Dump::Online2->new( dev => $self->[$__dev], filter => 'icmp6', timeoutOnNext => $timeout, ); $oDump->start; if ($oDump->firstLayer ne 'ETH') { $oDump->stop; die("[-] ".__PACKAGE__.": lookupMac6: can't do that on non-ethernet ". "link layers\n"); } $oWrite->open; my $srcMac = $self->[$__mac]; # XXX: risky my $target6 = Net::IPv6Addr->new($ip6)->to_string_preferred; my @dst = split(':', $target6); my $str = $dst[-2]; $str =~ s/^.*(..)$/$1/; $target6 = 'ff02::1:ff'.$str.':'.$dst[-1]; my $eth = Net::Frame::Layer::ETH->new( src => $srcMac, dst => NF_ETH_ADDR_BROADCAST, type => NF_ETH_TYPE_IPv6, ); my $ip = Net::Frame::Layer::IPv6->new( src => $srcIp6, dst => $target6, nextHeader => NF_IPv6_PROTOCOL_ICMPv6, ); my $icmp = Net::Frame::Layer::ICMPv6->new( type => NF_ICMPv6_TYPE_NEIGHBORSOLICITATION, ); my $icmpType = Net::Frame::Layer::ICMPv6::NeighborSolicitation->new( targetAddress => $ip6, options => [ Net::Frame::Layer::ICMPv6::Option->new( type => NF_ICMPv6_OPTION_SOURCELINKLAYERADDRESS, length => 1, value => pack('H2H2H2H2H2H2', split(':', $srcMac)), ), ], ); my $oSimple = Net::Frame::Simple->new( layers => [ $eth, $ip, $icmp, $icmpType ], ); # We retry three times my $mac; FIRST: for (1..$retry) { $oWrite->send($oSimple->raw); until ($oDump->timeout) { if (my $oReply = $oSimple->recv($oDump)) { for ($oReply->ref->{'ICMPv6::NeighborAdvertisement'}->options) { if ($_->type eq NF_ICMPv6_OPTION_TARGETLINKLAYERADDRESS) { $mac = convertMac(unpack('H*', $_->value)); if ($mac !~ /^[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) { die("[-] ".__PACKAGE__.": lookupMac6: ". "MAC address format error: [$mac]\n"); } last FIRST; } } } } $oDump->timeoutReset; } $oWrite->close; $oDump->stop; return $mac; } sub _searchSrcIp6 { my $self = shift; my ($ip6) = @_; my @dnet6 = intf_get_dst6($ip6) or return undef; my $dev = $self->[$__dev]; my $dnet6; for (@dnet6) { if ($_->{name} eq $dev) { $dnet6 = $_; last; } } my ($srcIp6) = split('/', $dnet6->{addr6}); $srcIp6; } sub lookupMac6 { my $self = shift; my ($ip6, $retry, $timeout) = @_; $retry ||= 1; $timeout ||= 1; # XXX: No ARP6 cache support for now # If target IPv6 begins with fe80, we are on the same subnet, # we lookup its MAC address if ($ip6 =~ /^fe80/i) { # We must change source IPv6 address to the one of same subnet my $srcIp6 = $self->_searchSrcIp6($ip6); return $self->_lookupMac6($ip6, $srcIp6, $retry, $timeout); } # Otherwise, we lookup the gateway MAC address, and store it else { # If already retrieved return $self->[$__gatewayMac6] if $self->[$__gatewayMac6]; # No IPv6 gateway? if (! $self->[$__gatewayIp6]) { print("[-] lookupMac6: no IPv6 gateway, no default route?\n"); return; } # Else, lookup it, and store it # We must change source IPv6 address to the one of same subnet my $srcIp6 = $self->_searchSrcIp6($self->[$__gatewayIp6]); my $gatewayMac6 = $self->_lookupMac6( $self->[$__gatewayIp6], $srcIp6, $retry, $timeout, ); $self->[$__gatewayMac6] = $gatewayMac6; return $gatewayMac6; } return; } sub debugDeviceList { my %dev; my $err; Net::Pcap::findalldevs(\%dev, \$err); print STDERR "findalldevs: error: $err\n" if $err; # Net::Pcap stuff for my $d (keys %dev) { my ($net, $mask); if (Net::Pcap::lookupnet($d, \$net, \$mask, \$err) < 0) { print STDERR "lookupnet: error: $d: $err\n"; $err = undef; next; } print STDERR "[$d] => subnet: "._toDotQuad($net)."\n"; } # Net::Libdnet stuff for my $i (0..5) { my $eth = 'eth'.$i; my $dnet = intf_get($eth); last unless keys %$dnet > 0; $dnet->{subnet} = addr_net($dnet->{addr}) if $dnet->{addr}; print STDERR Dumper($dnet)."\n"; } } 1; __END__ =head1 NAME Net::Frame::Device - get network device information and gateway =head1 SYNOPSIS use Net::Frame::Device; # Get default values from system my $device = Net::Frame::Device->new; # Get values from a specific device my $device2 = Net::Frame::Device->new(dev => 'vmnet1'); # Get values from a specific target my $device3 = Net::Frame::Device->new(target => '192.168.10.2'); print "dev: ", $device->dev, "\n"; print "mac: ", $device->mac, "\n"; print "ip : ", $device->ip, "\n"; print "ip6: ", $device->ip6, "\n"; print "gatewayIp: ", $device->gatewayIp, "\n" if $device->gatewayIp; print "gatewayMac: ", $device->gatewayMac, "\n" if $device->gatewayMac; # Get values from a specific target my $device5 = Net::Frame::Device->new(target6 => '2001::1'); print "dev: ", $device5->dev, "\n"; print "mac: ", $device5->mac, "\n"; print "ip6: ", $device5->ip6, "\n"; print "gatewayIp6: ", $device5->gatewayIp6, "\n" if $device5->gatewayIp6; =head1 DESCRIPTION This module is used to get network information, and is especially useful when you want to do low-level network programming. It also provides useful functions to lookup network MAC addresses. =head1 ATTRIBUTES =over 4 =item B The network device. undef if none found. =item B The IPv4 address of B. undef if none found. =item B The IPv6 address of B. undef if none found. =item B The MAC address of B. undef if none found. =item B The subnet of IPv4 address B. undef if none found. =item B The subnet of IPv6 address B. undef if none found. =item B The gateway IPv4 address. It defaults to default gateway that let you access Internet. If none found, or not required in the usage context, it defaults to undef. =item B The gateway IPv6 address. It defaults to default gateway that let you access Internet. If none found, or not required in the usage context, it defaults to undef. =item B The MAC address B. See B method. =item B The MAC address B. See B method. =item B This attribute is used when you want to detect which B, B, B attributes to use for a specific target. See B. =item B This attribute is used when you want to detect which B, B, B attributes to use for a specific target. See B. =back =head1 METHODS =over 4 =item B =item B (hash) Object constructor. See B for default values. =item B Will update attributes according to the default interface that has access to Internet. =item B =item B (dev) Will update attributes according to B attribute, or if you specify 'dev' as a parameter, it will use it for updating (and will also set B to this new value). =item B =item B (target) Will update attributes according to B attribute, or if you specify 'target' as a parameter, it will use it for updating (and will also set B to this new value). =item B =item B (target6) Will update attributes according to B attribute, or if you specify 'target6' as a parameter, it will use it for updating (and will also set B to this new value). =item B (IPv4 address, [ retry, timeout ]) Will try to get the MAC address of the specified IPv4 address. First, it checks against ARP cache table. Then, verify the target is on the same subnet as we are, and if yes, it does the ARP request. If not on the same subnet, it tries to resolve the gateway MAC address (by using B attribute). You can add optional parameters retry count and timeout in seconds. Returns undef on failure. =item B (IPv6 address, [ retry, timeout ]) Will try to get the MAC address of the specified IPv6 address (using ICMPv6). First, verify the target is on the same subnet as we are, and if yes, it does the ICMPv6 lookup request. If not on the same subnet, it tries to resolve the gateway MAC address (by using B attribute). You can add optional parameters retry count and timeout in seconds. Returns undef on failure. =item B Just for debugging purposes, especially on Windows systems. =back =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2015, Patrice EGomoRE Auffret You may distribute this module under the terms of the Artistic license. See LICENSE.Artistic file in the source distribution archive. =cut Net-Frame-Device-1.12/t000755001750001750 012624330260 14302 5ustar00gomorgomor000000000000Net-Frame-Device-1.12/t/01-use.t000444001750001750 10612624330260 15613 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Frame::Device; ok(1); Net-Frame-Device-1.12/t/04-new-default.t000444001750001750 25012624330260 17235 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Frame::Device; my $d = Net::Frame::Device->new or die("Device::new"); print $d->cgDumper if $d->can('cgDumper'); ok(1); Net-Frame-Device-1.12/t/05-new-target.t000444001750001750 27512624330260 17107 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Frame::Device; my $d = Net::Frame::Device->new(target => '2.2.2.2') or die("Device::new"); print $d->cgDumper if $d->can('cgDumper'); ok(1); Net-Frame-Device-1.12/t/02-pod-coverage.t000444001750001750 30112624330260 17370 0ustar00gomorgomor000000000000eval "use Test::Pod::Coverage tests => 1"; if ($@) { use Test; plan(tests => 1); skip("Test::Pod::Coverage required for testing"); } else { pod_coverage_ok("Net::Frame::Device"); } Net-Frame-Device-1.12/t/03-test-pod.t000444001750001750 23112624330260 16557 0ustar00gomorgomor000000000000eval "use Test::Pod 1.00"; if ($@) { use Test; plan(tests => 1); skip("Test::Pod 1.00 required for testing"); } else { all_pod_files_ok(); } Net-Frame-Device-1.12/examples000755001750001750 012624330260 15655 5ustar00gomorgomor000000000000Net-Frame-Device-1.12/examples/new-from-target6.pl000444001750001750 64712624330260 21442 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; my $target = shift || die("Specify target\n"); my $dev = shift; use Net::Frame::Layer qw(:subs); $target = getHostIpv6Addr($target) or die("lookup\n"); use Net::Frame::Device; my $d; if ($dev) { $d = Net::Frame::Device->new( dev => $dev, target6 => $target, ); } else { $d = Net::Frame::Device->new(target6 => $target); } print $d->cgDumper."\n"; Net-Frame-Device-1.12/examples/new-default.pl000444001750001750 17612624330260 20546 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; use Net::Frame::Device; my $d = Net::Frame::Device->new; print $d->cgDumper."\n"; Net-Frame-Device-1.12/examples/new-from-dev.pl000444001750001750 30312624330260 20631 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; my $dev = shift || die("Specify network interface\n"); use Net::Frame::Device; my $d = Net::Frame::Device->new(dev => $dev); print $d->cgDumper."\n"; Net-Frame-Device-1.12/examples/get-mac.pl000444001750001750 42312624330260 17643 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; my $target = shift || die("Specify target\n"); use Net::Frame::Device; my $oDevice = Net::Frame::Device->new(target => $target); print $oDevice->cgDumper."\n"; my $mac = $oDevice->lookupMac($target); print "MAC: $mac\n" if $mac; Net-Frame-Device-1.12/examples/new-from-target.pl000444001750001750 30112624330260 21337 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; my $target = shift || die("Specify target\n"); use Net::Frame::Device; my $d = Net::Frame::Device->new(target => $target); print $d->cgDumper."\n"; Net-Frame-Device-1.12/examples/get-mac6.pl000444001750001750 75412624330260 17740 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; my $target = shift || die("Specify target\n"); my $dev = shift; use Net::Frame::Layer qw(:subs); $target = getHostIpv6Addr($target) or die("lookup\n"); use Net::Frame::Device; my $d; if ($dev) { $d = Net::Frame::Device->new( dev => $dev, target6 => $target, ); } else { $d = Net::Frame::Device->new(target6 => $target); } my $mac = $d->lookupMac6($target); print 'MAC: '.$mac."\n" if $mac; print $d->cgDumper."\n"; Net-Frame-Device-1.12/bin000755001750001750 012624330260 14607 5ustar00gomorgomor000000000000Net-Frame-Device-1.12/bin/nfd-debug-devices.pl000555001750001750 26612624330260 20543 0ustar00gomorgomor000000000000#!/usr/bin/perl # # $Id: nfd-debug-devices.pl 354 2012-11-16 15:28:51Z gomor $ # use strict; use warnings; use Net::Frame::Device; Net::Frame::Device::debugDeviceList; print "\n"; Net-Frame-Device-1.12/bin/nfd-print-routes6.pl000444001750001750 254512624330260 20615 0ustar00gomorgomor000000000000#!/usr/bin/perl # # $Id: nfd-print-routes6.pl 354 2012-11-16 15:28:51Z gomor $ # use strict; use warnings; require Net::IPv6Addr; sub _getIp6 { my ($dev) = @_; my $buf = `/sbin/ifconfig $dev 2> /dev/null`; my $ip6; if ($buf) { for (split('\n', $buf)) { for (split(/\s+/)) { s/(?:%[a-z0-9]+)$//; # This removes %lnc0 on BSD systems $ip6 = $_ if Net::IPv6Addr::is_ipv6($_); last if $ip6; } last if $ip6; } } $ip6 =~ s/\/[0-9]+$// if $ip6; ($ip6 && lc($ip6)) || '::1'; } sub _getRoutesLinux { my %ifRoutes; my $buf = `netstat -rnA inet6`; my %devIps; if ($buf) { my @lines = split('\n', $buf); for (@lines) { my @elts = split(/\s+/); if (Net::IPv6Addr::is_ipv6($elts[0])) { unless (exists $devIps{interface}) { $devIps{$elts[-1]} = _getIp6($elts[-1]); } my $route = { destination => $elts[0], nextHop => $elts[1], interface => $elts[-1], ip6 => $devIps{$elts[-1]}, }; push @{$ifRoutes{$elts[-1]}}, $route; } } } else { carp("Unable to get routes\n"); return undef; } \%ifRoutes; } my $h = _getRoutesLinux(); use Data::Dumper; print Dumper($h)."\n";