1
2package Net::Address::Ethernet;
3
4use warnings;
5use strict;
6
7=head1 NAME
8
9Net::Address::Ethernet - find hardware ethernet address
10
11=head1 SYNOPSIS
12
13  use Net::Address::Ethernet qw( get_address );
14  my $sAddress = get_address;
15
16=head1 FUNCTIONS
17
18The following functions will be exported to your namespace if you request :all like so:
19
20  use Net::Address::Ethernet qw( :all );
21
22=over
23
24=cut
25
26use Carp;
27use Data::Dumper; # for debugging only
28use Exporter;
29use Net::Domain;
30use Net::Ifconfig::Wrapper qw( Ifconfig );
31use Regexp::Common;
32use Sys::Hostname;
33
34use constant DEBUG_MATCH => 0;
35
36use vars qw( $DEBUG $VERSION @EXPORT_OK %EXPORT_TAGS );
37use base 'Exporter';
38
39$VERSION = 1.128;
40
41$DEBUG = 0 || $ENV{N_A_E_DEBUG};
42
43%EXPORT_TAGS = ( 'all' => [ qw( get_address get_addresses canonical is_address ), ], );
44@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
45
46my @ahInfo;
47
48=item get_address
49
50Returns the 6-byte ethernet address in canonical form.
51For example, '1A:2B:3C:4D:5E:6F'.
52
53When called in array context, returns a 6-element list representing
54the 6 bytes of the address in decimal.  For example,
55(26,43,60,77,94,111).
56
57If any non-zero argument is given,
58debugging information will be printed to STDERR.
59
60=cut
61
62sub get_address
63  {
64  # warn " TTT get_address()";
65  if (0)
66    {
67    # If you know the name of the adapter, you can use this code to
68    # get its IP address:
69    use Socket qw/PF_INET SOCK_DGRAM inet_ntoa sockaddr_in/;
70    if (! socket(SOCKET, PF_INET, SOCK_DGRAM, getprotobyname('ip')))
71      {
72      warn " WWW socket() failed\n";
73      goto IFCONFIG_VERSION;
74      } # if
75    # use ioctl() interface with SIOCGIFADDR.
76    my $ifreq = pack('a32', 'enp1s0');
77    if (! ioctl(SOCKET, 0x8915, $ifreq))
78      {
79      warn " WWW ioctl failed\n";
80      goto IFCONFIG_VERSION;
81      } # if
82    # Format the IP address from the output of ioctl().
83    my $s = inet_ntoa((sockaddr_in((unpack('a16 a16', $ifreq))[1]))[1]);
84    if (! $s)
85      {
86      warn " WWW inet_ntoa failed\n";
87      goto IFCONFIG_VERSION;
88      } # if
89    warn Dumper($s); exit 88; # for debugging
90    } # if 0
91 IFCONFIG_VERSION:
92  my @a = get_addresses(@_);
93  _debug(" DDD in get_address, a is ", Dumper(\@a));
94  # Even if none are active, we'll return the first one:
95  my $sAddr = $a[0]->{sEthernet};
96  # Look through the list, returning the first active one that has a
97  # non-loopback IP address assigned to it:
98 TRY_ADDR:
99  foreach my $rh (@a)
100    {
101    my $sName = $rh->{sAdapter};
102    _debug(" DDD inspecting interface $sName...\n");
103    if (! $rh->{iActive})
104      {
105      _debug(" DDD   but it is not active.\n");
106      next TRY_ADDR;
107      } # if
108    _debug(" DDD   it is active...\n");
109    if (! exists $rh->{sIP})
110      {
111      _debug(" DDD   but it has no IP address.\n");
112      next TRY_ADDR;
113      } # if
114    if (! defined $rh->{sIP})
115      {
116      _debug(" DDD   but its IP address is undefined.\n");
117      next TRY_ADDR;
118      } # if
119    if ($rh->{sIP} eq '')
120      {
121      _debug(" DDD   but its IP address is empty.\n");
122      next TRY_ADDR;
123      } # if
124    if ($rh->{sIP} eq '127.0.0.1')
125      {
126      _debug(" DDD   but it's the loopback.\n");
127      next TRY_ADDR;
128      } # if
129    if (! exists $rh->{sEthernet})
130      {
131      _debug(" DDD   but it has no ethernet address.\n");
132      next TRY_ADDR;
133      } # if
134    if (! defined $rh->{sEthernet})
135      {
136      _debug(" DDD   but its ethernet address is undefined.\n");
137      next TRY_ADDR;
138      } # if
139    if ($rh->{sEthernet} eq q{})
140      {
141      _debug(" DDD   but its ethernet address is empty.\n");
142      next TRY_ADDR;
143      } # if
144    $sAddr = $rh->{sEthernet};
145    _debug(" DDD   and its ethernet address is $sAddr.\n");
146    last TRY_ADDR;
147    } # foreach TRY_ADDR
148  return wantarray ? map { hex } split(/[-:]/, $sAddr) : $sAddr;
149  } # get_address
150
151
152=item get_addresses
153
154Returns an array of hashrefs.
155Each hashref describes one Ethernet adapter found in the current hardware configuration,
156with the following entries filled in to the best of our ability to determine:
157
158=over
159
160=item sEthernet -- The MAC address in canonical form.
161
162=item rasIP -- A reference to an array of all the IP addresses on this adapter.
163
164=item sIP -- The "first" IP address on this adapter.
165
166=item sAdapter -- The name of this adapter.
167
168=item iActive -- Whether this adapter is active.
169
170=back
171
172For example:
173
174  {
175   'sAdapter' => 'Ethernet adapter Local Area Connection',
176   'sEthernet' => '12:34:56:78:9A:BC',
177   'rasIP' => ['111.222.33.44',],
178   'sIP' => '111.222.33.44',
179   'iActive' => 1,
180  },
181
182If any non-zero argument is given,
183debugging information will be printed to STDERR.
184
185=cut
186
187sub get_addresses
188  {
189  # warn " TTT get_addresses()";
190  $DEBUG ||= shift;
191  # Short-circuit if this function has already been called:
192  if (! $DEBUG && @ahInfo)
193    {
194    goto ALL_DONE;
195    } # if
196  my $sAddr = undef;
197  my $rh = Ifconfig('list', '', '', '');
198  if ((! defined $rh) || (! scalar keys %$rh))
199    {
200    # warn " WWW Ifconfig failed: $@";
201    if ($@ =~ m/not found/)
202      {
203      # At this point we might try another method, such as calling /sbin/ip
204      my $sCmdIp = '/sbin/ip';
205      if (! -f $sCmdIp)
206        {
207        warn " DDD $sCmdIp does not exist";
208        }
209      else
210        {
211        $sCmdIp .= q/ addr show/;
212        my @asOutput = qx/$sCmdIp/;
213        # print STDERR " DDD asOutput ==@asOutput";
214        my $sInterface = q//;
215        my %hash;
216        foreach my $sLine (@asOutput)
217          {
218          # print STDERR " DDD sLine ==$sLine";
219          if ($sLine =~ m/\d:\s(.+?):.+,UP/)
220            {
221            # Found an interface that is in UP state
222            push @ahInfo, {%hash} if %hash;
223            $sInterface = $1;
224            # Start a new adapter's info:
225            %hash = ();
226            $hash{sAdapter} = $sInterface;
227            $hash{iActive} = 1;
228            _debug(" DDD   hash is ", Dumper(\%hash));
229            } # if
230          if ($sLine =~ m/ether\s+(([0-9a-f]{2}:){5}[0-9a-f]{2})/)
231            {
232            $hash{sEthernet} = canonical($1);
233            _debug(" DDD   hash is ", Dumper(\%hash));
234            } # if
235          if ($sLine =~ m/inet\s+((\d+\.){3}\d+)/)
236            {
237            $hash{sAdapter} = $sInterface;
238            $hash{sIP} = $1;
239            $hash{rasIP} = [$1];
240            _debug(" DDD   hash is ", Dumper(\%hash));
241            } # if
242          } # foreach
243        push @ahInfo, {%hash} if %hash;
244        } # if
245      } # if
246    # No sense trying to parse non-existent output:
247    goto ALL_DONE;
248    } # if
249  _debug(" DDD raw output from Ifconfig is ", Dumper($rh));
250  # Convert their hashref to our array format:
251  foreach my $key (keys %$rh)
252    {
253    my %hash;
254    _debug(" DDD working on key $key...\n");
255    my $sAdapter = $key;
256    if ($key =~ m!\A\{.+}\z!)
257      {
258      $sAdapter = $rh->{$key}->{descr};
259      } # if
260    $hash{sAdapter} = $sAdapter;
261    my @asIP = keys %{$rh->{$key}->{inet}};
262    # Thanks to Sergey Kotenko for the array idea:
263    $hash{rasIP} = \@asIP;
264    $hash{sIP} = $asIP[0];
265    my $sEther = $rh->{$key}->{ether} || '';
266    if ($sEther eq '')
267      {
268      $sEther = _find_mac($sAdapter, $hash{sIP});
269      } # if
270    $hash{sEthernet} = canonical($sEther);
271    $hash{iActive} = 0;
272    if (defined $rh->{$key}->{status} && ($rh->{$key}->{status} =~ m!\A(1|UP)\z!i))
273      {
274      $hash{iActive} = 1;
275      } # if
276    push @ahInfo, \%hash;
277    } # foreach
278 ALL_DONE:
279  return @ahInfo;
280  } # get_addresses
281
282
283# Attempt other ways of finding the MAC Address:
284sub _find_mac
285  {
286  my $sAdapter = shift || return;
287  my $sIP = shift || '';
288  # No hope on some OSes:
289  return if ($^O eq 'MSWIn32');
290  my @asARP = qw( /usr/sbin/arp /sbin/arp /bin/arp /usr/bin/arp );
291  my $sHostname = hostname || Net::Domain::hostname || '';
292  my $sHostfqdn = Net::Domain::hostfqdn || '';
293  my @asHost = ($sHostname, $sHostfqdn, '');
294 ARP:
295  foreach my $sARP (@asARP)
296    {
297    next ARP if ! -x $sARP;
298 HOSTNAME:
299    foreach my $sHost (@asHost)
300      {
301      $sHost ||= q{};
302      next HOSTNAME if ($sHost eq q{});
303      my $sCmd = qq{$sARP $sHost};
304      # print STDERR " DDD trying ==$sCmd==\n";
305      my @as = qx{$sCmd};
306 LINE_OF_CMD:
307      while (@as)
308        {
309        my $sLine = shift @as;
310        DEBUG_MATCH && print STDERR " DDD output line of cmd ==$sLine==\n";
311        if ($sLine =~ m!\(($RE{net}{IPv4})\)\s+AT\s+($RE{net}{MAC})\b!i)
312          {
313          # Looks like arp on Solaris.
314          my ($sIPFound, $sEtherFound) = ($1, $2);
315          # print STDERR " DDD     found IP =$sIPFound=, found ether =$sEtherFound=\n";
316          return $sEtherFound if ($sIPFound eq $sIP);
317          # print STDERR " DDD     does NOT match the one I wanted =$sIP=\n";
318          } # if
319        if ($sLine =~ m!($RE{net}{IPv4})\s+ETHER\s+($RE{net}{MAC})\b!i)
320          {
321          # Looks like arp on Solaris.
322          return $2 if ($1 eq $sIP);
323          } # if
324        } # while LINE_OF_CMD
325      } # foreach HOSTNAME
326    } # foreach ARP
327  } # _find_mac
328
329=item is_address
330
331Returns a true value if its argument looks like an ethernet address.
332
333=cut
334
335sub is_address
336  {
337  my $s = uc(shift || '');
338  # Convert all non-hex digits to colon:
339  $s =~ s![^0-9A-F]+!:!g;
340  return ($s =~ m!\A$RE{net}{MAC}\Z!i);
341  } # is_address
342
343
344=item canonical
345
346Given a 6-byte ethernet address, converts it to canonical form.
347Canonical form is 2-digit uppercase hexadecimal numbers with colon
348between the bytes.  The address to be converted can have any kind of
349punctuation between the bytes, the bytes can be 1-digit, and the bytes
350can be lowercase; but the bytes must already be hex.
351
352=cut
353
354sub canonical
355  {
356  my $s = shift;
357  return '' if ! is_address($s);
358  # Convert all non-hex digits to colon:
359  $s =~ s![^0-9a-fA-F]+!:!g;
360  my @as = split(':', $s);
361  # Cobble together 2-digit hex bytes:
362  $s = '';
363  map { $s .= length() < 2 ? "0$_" : $_; $s .= ':' } @as;
364  chop $s;
365  return uc $s;
366  } # canonical
367
368sub _debug
369  {
370  return if ! $DEBUG;
371  print STDERR @_;
372  } # _debug
373
374=back
375
376=head1 NOTES
377
378=head1 SEE ALSO
379
380arp, ifconfig, ipconfig
381
382=head1 BUGS
383
384Please tell the author if you find any!  And please show me the output
385of `arp <hostname>`
386or `ifconfig`
387or `ifconfig -a`
388from your system.
389
390=head1 AUTHOR
391
392Martin 'Kingpin' Thurn, C<mthurn at cpan.org>, L<http://tinyurl.com/nn67z>.
393
394=head1 LICENSE
395
396This software is released under the same license as Perl itself.
397
398=cut
399
4001;
401
402__END__
403
404=pod
405
406#### This is an example of @ahInfo on MSWin32:
407(
408   {
409    'sAdapter' => 'Ethernet adapter Local Area Connection',
410    'sEthernet' => '00-0C-F1-EE-F0-39',
411    'sIP' => '16.25.10.14',
412    'iActive' => 1,
413   },
414   {
415    'sAdapter' => 'Ethernet adapter Wireless Network Connection',
416    'sEthernet' => '00-33-BD-F3-33-E3',
417    'sIP' => '19.16.20.12',
418    'iActive' => 1,
419   },
420   {
421    'sAdapter' => '{gobbledy-gook}',
422    'sDesc' => 'PPP adapter Verizon Online',
423    'sEthernet' => '00-53-45-00-00-00',
424    'sIP' => '71.24.23.85',
425    'iActive' => 1,
426   },
427)
428
429#### This is Solaris 8:
430
431> /usr/sbin/arp myhost
432myhost (14.81.16.10) at 03:33:ba:46:f2:ef permanent published
433
434#### This is Solaris 8:
435
436> /usr/sbin/ifconfig -a
437lo0: flags=1000849<UP,LOOPBACK,RUNNING,MULTICAST,IPv4> mtu 8232 index 1
438        inet 127.0.0.1 netmask ff000000
439bge0: flags=1000843<UP,BROADCAST,RUNNING,MULTICAST,IPv4> mtu 1500 index 2
440        inet 14.81.16.10 netmask ffffff00 broadcast 14.81.16.255
441
442#### This is Fedora Core 6:
443
444$ /sbin/arp
445Address         HWtype  HWaddress           Flags  Mask     Iface
44619.16.11.11     ether   03:53:53:e3:43:93   C               eth0
447
448#### This is amd64-freebsd:
449
450$ ifconfig
451fwe0: flags=108802<BROADCAST,SIMPLEX,MULTICAST,NEEDSGIANT> mtu 1500
452        options=8<VLAN_MTU>
453        ether 02:31:38:31:35:35
454        ch 1 dma -1
455vr0: flags=8843<UP,BROADCAST,RUNNING,SIMPLEX,MULTICAST> mtu 1500
456        inet6 fe8d::2500:bafd:fecd:cdcd%vr0 prefixlen 64 scopeid 0x2
457        inet 19.16.12.52 netmask 0xffffff00 broadcast 19.16.12.255
458        ether 00:53:b3:c3:3d:39
459        media: Ethernet autoselect (100baseTX <full-duplex>)
460        status: active
461nfe0: flags=8843<UP,BROADCAST,RUNNING,SIMPLEX,MULTICAST> mtu 1500
462        options=8<VLAN_MTU>
463        inet6 fe8e::21e:31ef:fee1:26eb%nfe0 prefixlen 64 scopeid 0x3
464        ether 00:13:33:53:23:13
465        media: Ethernet autoselect (100baseTX <full-duplex>)
466        status: active
467plip0: flags=108810<POINTOPOINT,SIMPLEX,MULTICAST,NEEDSGIANT> mtu 1500
468lo0: flags=8049<UP,LOOPBACK,RUNNING,MULTICAST> mtu 16384
469        inet6 ::1 prefixlen 128
470        inet6 fe80::1%lo0 prefixlen 64 scopeid 0x5
471        inet 127.0.0.1 netmask 0xff000000
472        inet 127.0.0.2 netmask 0xffffffff
473        inet 127.0.0.3 netmask 0xffffffff
474tun0: flags=8051<UP,POINTOPOINT,RUNNING,MULTICAST> mtu 1492
475        inet 83.173.73.3 --> 233.131.83.3 netmask 0xffffffff
476        Opened by PID 268
477