# $Id: Ethernet.pm,v 1.95 2007/10/20 18:07:27 Daddy Exp $
=head1 NAME
Net::Address::Ethernet - find hardware ethernet address
=head1 SYNOPSIS
use Net::Address::Ethernet qw( get_address );
my $sAddress = get_address;
my $sMethod = &Net::Address::Ethernet::method;
=head1 PLATFORM NOTES
On Windows (MSWin32), before calling this function, you can set
package variable $sIpconfigHome to the folder containing ipconfig.exe
(for example, if ipconfig.exe is not found your PATH, or if you don't
have permission to execute ipconfig.exe in the normal Windows
location).
$Net::Address::Ethernet::sIpconfigHome = 'C:\\my\\bin';
my $sAddr = &Net::Address::Ethernet::get_address;
=head1 FUNCTIONS
The following functions will be exported to your namespace if you request :all like so:
use Net::Address::Ethernet qw( :all );
=over
=cut
package Net::Address::Ethernet;
use Carp;
use Data::Dumper; # for debugging only
use Exporter;
use Env::Path;
use File::Spec::Functions;
use Net::Domain;
use Regexp::Common;
use Sys::Hostname;
use strict;
use constant DEBUG_MATCH => 0;
use constant DEBUG_IPCONFIG => 0 || $ENV{N_A_E_DEBUG};
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );
@ISA = qw( Exporter );
$VERSION = do { my @r = (q$Revision: 1.95 $ =~ /\d+/g); sprintf "%d."."%03d" x $#r, @r };
%EXPORT_TAGS = ( 'all' => [ qw( get_address get_addresses method canonical is_address ), ], );
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@EXPORT = qw( );
my $sIpconfigHome = '';
my $sMethod = 'N/A';
my @ahInfo;
my $qrIPADDRESS = qr{\b(
IP\sAddress # English
|
IP-Adresse # German
|
Adresse\sIP # French
)\b}ix;
sub _parse_ipconfig_output
{
my $ras = shift;
# Clear out and start over:
@ahInfo = ();
my $sAdapterName = '';
my $sEthernet = '';
my $sIP = '';
my $iActive = 0;
foreach my $sLine (@$ras)
{
# Delete trailing whitespace:
$sLine =~ s!\s+\Z!!;
if ($sLine =~ m!\A(\S.+):\Z!)
{
$sAdapterName = $1;
# Reset the other items:
$sEthernet = $sIP = '';
} # if
elsif ($sLine =~ m!\s\.\s?:\s($RE{net}{MAC}{hex}{-sep=>qr/-/})\b!)
{
# Matched the 6-byte ethernet address:
$sEthernet = $1;
}
elsif (($sLine =~ m!$qrIPADDRESS!)
&&
($sLine =~ m!\.\s?:\s($RE{net}{IPv4})!i))
{
$sIP = $1;
$iActive = ($sIP ne q/0.0.0.0/);
push @ahInfo, {
sAdapter => $sAdapterName,
sEthernet => &canonical($sEthernet),
sIP => $sIP,
iActive => $iActive,
};
$sMethod = 'ipconfig';
} # elsif
} # foreach
# print STDERR Dumper(\@ahInfo);
} # _parse_ipconfig_output
=item get_address
Returns the 6-byte ethernet address in canonical form.
For example, '1A:2B:3C:4D:5E:6F'.
When called in array context, returns a 6-element list representing
the 6 bytes of the address in decimal. For example,
(26,43,60,77,94,111).
=cut
sub get_address
{
my @a = &get_addresses;
DEBUG_MATCH && print STDERR " DDD in get_address, a is ", Dumper(\@a);
# Even if none are active, we'll return the first one:
my $sAddr = $a[0]->{sEthernet};
# Look through the list, returning the first active one:
TRY_ADDR:
foreach my $rh (@a)
{
if ($rh->{iActive})
{
next TRY_ADDR if ($rh->{sIP} eq '127.0.0.1');
$sAddr = $rh->{sEthernet};
last TRY_ADDR;
} # if
} # foreach TRY_ADDR
return wantarray ? map { hex } split(/[-:]/, $sAddr) : &canonical($sAddr);
} # get_addresses
=item get_addresses
Returns an array of hashrefs.
Each hashref describes one Ethernet adapter found in the current hardware configuration,
with the following entries filled in to the best of our ability to determine:
=over
=item sEthernet -- The MAC address in canonical form.
=item sIP -- The IP address on this adapter.
=item sAdapter -- The name of this adapter.
=item iActive -- Whether this adapter is active.
=back
For example:
{
'sAdapter' => 'Ethernet adapter Local Area Connection',
'sEthernet' => '12:34:56:78:9A:BC',
'sIP' => '111.222.33.44',
'iActive' => 1,
},
=cut
sub get_addresses
{
my $sAddr = undef;
$sMethod = 'failed';
my @asCmd;
if ($^O =~ m!Win32!i)
{
my @asAddr;
# Find out where ipconfig is:
my $sIpconfig;
TRY_IPCONFIG:
foreach my $sTryDir ($sIpconfigHome,
Env::Path->PATH->List, curdir,
'C:\\windows\\system32', 'C:\\winnt\\system32')
{
$sIpconfig = catfile($sTryDir, 'ipconfig.exe');
if (-x $sIpconfig)
{
last TRY_IPCONFIG;
} # if
undef $sIpconfig;
} # foreach TRY_IPCONFIG
goto ALL_DONE unless $sIpconfig;
print STDERR " DDD found $sIpconfig\n" if DEBUG_IPCONFIG;
# Put double-quotes around it in case the path contains spaces:
my @as = qx{ "$sIpconfig" /all };
&_parse_ipconfig_output(\@as);
} # if Win32
elsif ($^O =~ m!linux!i)
{
DEBUG_MATCH && print STDERR " DDD this is linux.\n";
# I haven't seen any Linux where ifconfig does not give us all the
# info we need, ergo skip arp:
if (0)
{
my $ARP = q{/sbin/arp};
if (-x $ARP)
{
my $re = qr{\sETHER\s+$RE{net}{MAC}{-keep}\s}i;
my $sHostname = hostname || Net::Domain::hostname || '';
my $sHostfqdn = Net::Domain::hostfqdn || '';
LINUX_ARP_TRY:
foreach my $sTry ($sHostname, $sHostfqdn)
{
next LINUX_ARP_TRY if ($sTry eq '');
push @asCmd, qq{$ARP $sTry};
} # foreach LINUX_ARP_TRY
} # if
else
{
# Can not find an executable arp
# warn " WWW your OS is linux but you have no $ARP!?!\n";
}
} # if try arp
my $IFCONFIG = q{/sbin/ifconfig};
if (-x $IFCONFIG)
{
push @asCmd, qq{$IFCONFIG};
} # if
else
{
# Can not find an executable ifconfig
# warn " WWW your OS is linux but you have no $IFCONFIG!?!\n";
}
} # if linux
elsif ($^O =~ m!solaris!i)
{
my $ARP = q{/usr/sbin/arp};
if (-x $ARP)
{
my $sHostname = hostname || Net::Domain::hostname || '';
my $sHostfqdn = Net::Domain::hostfqdn || '';
SOLARIS_ARP_TRY:
foreach my $sTry ($sHostname, $sHostfqdn)
{
next SOLARIS_ARP_TRY if ($sTry eq '');
push @asCmd, qq{$ARP $sTry};
} # foreach SOLARIS_ARP_TRY
} # if
my $IFCONFIG = q{/usr/sbin/ifconfig};
if (-x $IFCONFIG)
{
push @asCmd, qq{ $IFCONFIG -a };
} # if
else
{
# Can not find an executable ifconfig
}
} # if solaris
elsif ($^O =~ m!darwin!i)
{
# Assume it's in the path:
push @asCmd, qq{ ifconfig };
} # if MACINTOSH
elsif ($^O =~ m!cygwin!i)
{
# Assume it's in the path:
push @asCmd, qq{ ipconfig };
} # if MACINTOSH
else
{
# Unknown operating system
}
CMD_TRY:
foreach my $sCmd (@asCmd)
{
&_cmd_output_matches(\@ahInfo, $sCmd);
} # foreach CMD_TRY
DEBUG_MATCH && print STDERR Dumper(\@ahInfo);
ALL_DONE:
return @ahInfo;
} # get_addresses
my %hssMACofIP;
sub _cmd_output_matches
{
# Required arg1 = reference to array of results info:
my $raInfo = shift;
# Required arg2 = command-line to run:
my $sCmd = shift;
return if @ahInfo;
DEBUG_MATCH && print STDERR " DDD running cmd ==$sCmd==...\n";
my @as = qx{ $sCmd };
chomp @as;
LINE_OF_CMD:
while (@as)
{
my $sLine = shift @as;
DEBUG_MATCH && print STDERR " DDD output line of cmd ==$sLine==\n";
if ($sLine =~ m!\(($RE{net}{IPv4})\)\s+AT\s+($RE{net}{MAC})\b!i)
{
# Looks like arp on Solaris. Remember this IP => MAC for later...
$hssMACofIP{$1} = $2;
DEBUG_MATCH && print STDERR " DDD looks like arp on Solaris ($1=>$2)...\n";
$sMethod = 'arp';
} # if
elsif ($sLine =~ m!\A(.+?):\sflags=!)
{
# Looks like ifconfig on Solaris. Remember this adapter name for later...
my $sAdapter = $1;
DEBUG_MATCH && print STDERR " DDD looks like ifconfig line 1 on Solaris ($sAdapter)...\n";
# Look ahead to the IPv4 on the next line:
$sLine = shift @as;
if ($sLine =~ m!\bINET\s($RE{net}{IPv4})\b!i)
{
my $sIP = $1;
DEBUG_MATCH && print STDERR " DDD looks like ifconfig line 2 on Solaris (ip=$sIP)...\n";
# Look ahead and see if ether appears on the next line (as darwin):
$sLine = shift @as;
if ($sLine =~ m!ETHER\s+($RE{net}{MAC})\b!i)
{
$hssMACofIP{$sIP} = $1;
} # if
push @ahInfo, {
sAdapter => $sAdapter,
sEthernet => &canonical($hssMACofIP{$sIP} || ''),
sIP => $sIP,
# ifconfig only reports active addresses?
iActive => 1,
};
$sMethod = 'ifconfig';
} # if
} # elsif
elsif ($sLine =~ m!\A(.+?)\s.+\sHWADDR\s($RE{net}{MAC})!i)
{
# Looks like ifconfig on Fedora Core. Remember this adapter
# name for later...
my $sAdapter = $1;
my $sMAC = $2;
DEBUG_MATCH && print STDERR " DDD looks like ifconfig line 1 on FC6 ($sAdapter,$sMAC)...\n";
# Look ahead to the IPv4 on the next line:
$sLine = shift @as;
if ($sLine =~ m!\sINET\sADDR:($RE{net}{IPv4})\s!i)
{
my $sIP = $1;
DEBUG_MATCH && print STDERR " DDD looks like ifconfig line 2 on FC6 (ip=$sIP)...\n";
push @ahInfo, {
sAdapter => $sAdapter,
sEthernet => &canonical($sMAC),
sIP => $sIP,
# ifconfig only reports active addresses?
iActive => 1,
};
$sMethod = 'ifconfig';
} # if
} # elsif
} # while LINE_OF_CMD
} # _cmd_output_matches
=item method
After a successful call to get_address(), the method() function will
tell you how the information was derived. Currently there are three
possibilities: 'arp' or 'ifconfig' for Unix-like systems, and
'ipconfig' for Win32. If you haven't called get_address(), 'N/A' will
be returned. If something went wrong during get_address(), 'failed'
will be returned by method().
=cut
sub method
{
return $sMethod;
} # method
=item is_address
Returns a true value if its argument looks like an ethernet address.
=cut
sub is_address
{
my $s = uc(shift || '');
# Convert all non-hex digits to colon:
$s =~ s![^0-9A-F]+!:!g;
return ($s =~ m!\A$RE{net}{MAC}\Z!i);
} # is_address
=item canonical
Given a 6-byte ethernet address, converts it to canonical form.
Canonical form is 2-digit uppercase hexadecimal numbers with colon
between the bytes. The address to be converted can have any kind of
punctuation between the bytes, the bytes can be 1-digit, and the bytes
can be lowercase; but the bytes must already be hex.
=cut
sub canonical
{
my $s = shift;
return '' if ! &is_address($s);
# Convert all non-hex digits to colon:
$s =~ s![^0-9a-fA-F]+!:!g;
my @as = split(':', $s);
# Cobble together 2-digit hex bytes:
$s = '';
map { $s .= length() < 2 ? "0$_" : $_; $s .= ':' } @as;
chop $s;
return uc $s;
} # canonical
=back
=head1 NOTES
=head1 SEE ALSO
arp, ifconfig, ipconfig
=head1 BUGS
Please tell the author if you find any! And please show me the output
of `ipconfig /all`
or `arp <hostname>`
or `ifconfig`
or `ifconfig -a`
from your system.
=head1 AUTHOR
Martin Thurn (mthurn@cpan.org). L<http://www.sandcrawler.com/SWB/cpan-modules.html>
=cut
1;
__END__
This is an example of @asInfo on MSWin32:
(
{
'sAdapter' => 'Ethernet adapter Local Area Connection',
'sEthernet' => '00-0C-F1-EE-F0-39',
'sIP' => '16.25.10.14',
'iActive' => 1,
},
{
'sAdapter' => 'Ethernet adapter Wireless Network Connection',
'sEthernet' => '00-33-BD-F3-33-E3',
'sIP' => '19.16.20.12',
'iActive' => 1,
},
{
'sAdapter' => 'PPP adapter Verizon Online',
'sEthernet' => '00-53-45-00-00-00',
'sIP' => '71.24.23.85',
'iActive' => 1,
},
)
> /usr/sbin/arp myhost
myhost (14.81.16.10) at 03:33:ba:46:f2:ef permanent published
> /usr/sbin/ifconfig -a
lo0: flags=1000849<UP,LOOPBACK,RUNNING,MULTICAST,IPv4> mtu 8232 index 1
inet 127.0.0.1 netmask ff000000
bge0: flags=1000843<UP,BROADCAST,RUNNING,MULTICAST,IPv4> mtu 1500 index 2
inet 14.81.16.10 netmask ffffff00 broadcast 14.81.16.255
syntax highlighted by Code2HTML, v. 0.9.1