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