For *NIX-type platforms, there is the IO::Interface module which allows local interfaces to be enumerated via additional methods added to IO::Socket objects. These methods allow interface information to be both retrieved and modified.
For example ...
use IO::Interface;
use IO::Socket;
my $sock = IO::Socket::INET->new( 'Proto' => 'udp' );
foreach my $iface ( $sock->if_list ) {
print $iface, " ",
$sock->if_addr, "/",
$sock->if_netmask, "\n";
}
| [reply] [Watch: Dir/Any] [d/l] |
well, if you just need IP addresses, this works on Win32 and Linux and doesn't require any external module:
my @ip = ();
my($name,$aliases,$addrtype,$length,@addrs) = gethostbyname('localhost
+');
# @addrs should contain the loopback - 127.0.0.1
# you can skip it if you want
foreach my $addr (@addrs) {
push(@ip, join('.', unpack('C4', $addr)));
}
($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($name);
# @addrs contains our public IP address(es)
foreach my $addr (@addrs) {
push(@ip, join('.', unpack('C4', $addr)));
}
foreach my $ip (@ip) {
print $ip, "\n";
}
| [reply] [Watch: Dir/Any] [d/l] |
# GetIP.pl
# --------
# This will retrieve all IP Addresses that are bound
# to network devices on a specified machine. This includes IPs that
+are
# bound to any NIC (network card, RAS dail up, etc).
# If a particular NIC specifies 0.0.0.0 (typically to indicate that
+the
# NIC will request an IP via DHCP, PPP, etc) it will be ignored.
# ALL IPs are discovered even on cards that are disabled.
#
# Syntax:
# perl GetIP.pl [Machine Name]
#
# Examples:
# perl GetIP.pl
# perl GetIP.pl \\server
#
# 1999.03.09 roth
#
# Permission is granted to redistribute and modify this code as long
+ as
# the below copyright is included.
#
# Copyright © 1999 by Dave Roth
# Courtesty of Roth Consulting
# http://www.roth.net/
use Win32::Registry;
%KeyName = (
serviceroot => 'System\CurrentControlSet\Services',
tcplink => 'Tcpip\Linkage',
tcplink_disabled => 'Tcpip\Linkage\Disabled',
tcpparam => 'Tcpip\Parameters',
deviceparam_tcp => 'Parameters\Tcpip',
);
$Root = $HKEY_LOCAL_MACHINE;
if( $Machine = $ARGV[0] )
{
$HKEY_LOCAL_MACHINE->Connect( $Machine, $Root ) || die "Could not
+connect to the registry on '$Machine'\n";
}
if( $Root->Open( $KeyName{serviceroot}, $ServiceRoot ) )
{
# Get the device names of the cards tcp is bound to...
if( $ServiceRoot->Open( $KeyName{tcplink}, $Links ) )
{
my( $Data );
if( $Links->QueryValueEx( "Bind", $DataType, $Data ) )
{
$Data =~ s/\n/ /gs;
$Data =~ s/\\Device\\//gis;
$Data =~ s/^\s+(.*)\s+$/$1/gs;
push( @Devices, ( split( /\c@/, $Data ) ) );
}
$Links->Close();
}
# Get the device names of cards that tcp is bound to but disabled.
+..
if( $ServiceRoot->Open( $KeyName{tcplink_disabled}, $Links ) )
{
my( $Data );
if( $Links->QueryValueEx( "Bind", $DataType, $Data ) )
{
$Data =~ s/\s+//gs;
$Data =~ s/\\Device\\//gis;
push( @Devices, ( split( /\c@/, $Data ) ) );
}
$Links->Close();
}
foreach $DeviceName ( @Devices )
{
my( $DeviceTCPKey );
if( $ServiceRoot->Open( "$DeviceName\\$KeyName{deviceparam_tcp
+}", $DeviceTCPKey ) )
{
my( @CardIPs, @CardSubNets );
my( $Data, $iCount, $IPAddress );
# Get the IP addresses...
if( $DeviceTCPKey->QueryValueEx( "IPAddress", $DataType, $
+Data ) )
{
$Data =~ s/\s+//gm;
push( @CardIPs, ( split( /\c@/, $Data ) ) );
}
# Get the Subnet masks...
if( $DeviceTCPKey->QueryValueEx( "SubnetMask", $DataType,
+$Data ) )
{
$Data =~ s/\s+//gm;
push( @CardSubNets, ( split( /\c@/, $Data ) ) );
}
# Push our new found data onto the stack...
$iCount = 0;
map
{
my( %Hash );
# We don't want 0.0.0.0 since it means the IP will be
+procured via DHCP or something...
next if( $_ eq '0.0.0.0' );
$Hash{ip} = $_;
$Hash{subnet} = $CardSubNets[$iCount];
push( @IP, \%Hash );
$iCount++;
} ( @CardIPs );
$DeviceTCPKey->Close();
}
}
print "This machine $Machine has the following IP addresses:\n";
foreach $IPStruct ( @IP )
{
print "\t$IPStruct->{ip} \t(subnet: $IPStruct->{subnet})\n";
}
$ServiceRoot->Close();
}
| [reply] [Watch: Dir/Any] [d/l] |
if you *really* want to list the network interfaces of your machine, here is a (not so) small script that exploits some system APIs to emulate ifconfig -a on a Win32 machine. should work for Windoze versions 98 and later or NT SP4 and later (2000/XP/...).
it's all fair to me except that the operational status seems to always report UNREACHABLE. go figure...
#!perl -w
#### if_info.pl
#### ----------
#### a quasi-replacement for Unix's 'ifconfig -a' under Win32
####
#### written by Aldo Calpini <dada@perl.it> on a sunny 2002.05.16
use strict;
use Win32::API 0.20;
use vars qw(
$size $unpack
$if_table $ifs @if_data
$ip_table $ips @ip_data
);
my $VERSION = "0.01";
my $GetIfTable = new Win32::API(
'IpHlpAPI', 'GetIfTable', 'PPI', 'N'
) or die $^E;
my $GetIpAddrTable = new Win32::API(
'IpHlpAPI', 'GetIpAddrTable', 'PPI', 'N'
) or die $^E;
#### from the MSDN library
my @MIB_IFROW = (
[ wszName => 'a512' ],
[ dwIndex => 'L' ],
[ dwType => 'L' ],
[ dwMtu => 'L' ],
[ dwSpeed => 'L' ],
[ dwPhysAddrLen => 'L' ],
[ bPhysAddr => 'a8' ],
[ dwAdminStatus => 'L' ],
[ dwOperStatus => 'L' ],
[ dwLastChange => 'L' ],
[ dwInOctets => 'L' ],
[ dwInUcastPkts => 'L' ],
[ dwInNUcastPkts => 'L' ],
[ dwInDiscards => 'L' ],
[ dwInErrors => 'L' ],
[ dwInUnknownProtos => 'L' ],
[ dwOutOctets => 'L' ],
[ dwOutUcastPkts => 'L' ],
[ dwOutNUcastPkts => 'L' ],
[ dwOutDiscards => 'L' ],
[ dwOutErrors => 'L' ],
[ dwOutQLen => 'L' ],
[ dwDescrLen => 'L' ],
[ bDescr => 'a256' ],
);
my @MIB_IPADDRROW = (
[ dwAddr => 'L' ],
[ dwIndex => 'L' ],
[ dwMask => 'L' ],
[ dwBCastAddr => 'L' ],
[ dwReasmSize => 'L' ],
[ unused1 => 'S' ],
[ unused2 => 'S' ],
);
#### first call to get number of bytes needed
$size = pack("L", 0);
$GetIpAddrTable->Call(0, $size, 1);
#### real call
$ip_table = "\0" x unpack("L", $size);
$GetIpAddrTable->Call($ip_table, $size, 1);
#### unpack the MIB_IPADDRROW structure(s) in ip_table
$ips = unpack("L", $ip_table);
$unpack = "L";
for my $i (0..$ips-1) {
foreach my $member (@MIB_IPADDRROW) {
$unpack .= $member->[1];
}
}
@ip_data = unpack($unpack, $ip_table);
#### store ip and mask for interface index
my %ip_data = ();
shift @ip_data;
for my $i (0..$ips-1) {
my %struct;
foreach my $member (@MIB_IPADDRROW) {
$struct{$member->[0]} = shift @ip_data;
}
my $ip = if_ipaddr($struct{dwAddr});
my $if = $struct{dwIndex};
my $mask = if_ipaddr($struct{dwMask});
$ip_data{$if} = [ $ip, $mask ] if $ip ne '0.0.0.0';
}
#### first call to get number of bytes needed
$size = pack("L", 0);
$GetIfTable->Call(0, $size, 1);
#### real call
$if_table = "\0" x unpack("L", $size);
$GetIfTable->Call($if_table, $size, 1);
#### unpack the MIB_IFROW structure(s) in if_table
$ifs = unpack("L", $if_table);
$unpack = "L";
for my $i (0..$ifs-1) {
foreach my $member (@MIB_IFROW) {
$unpack .= $member->[1];
}
}
@if_data = unpack($unpack, $if_table);
#### dump the information
shift @if_data;
for my $i (0..$ifs-1) {
my %struct;
foreach my $member (@MIB_IFROW) {
$struct{$member->[0]} = shift @if_data;
}
my $if_index = $struct{dwIndex};
printf "\n0x%08x", $if_index;
printf " Link encap:%s ", if_type($struct{dwType});
my $hwaddr = if_hwaddr($struct{dwPhysAddrLen}, $struct{bPhysAddr})
+;
printf "HWaddr %s", $hwaddr if $hwaddr;
print "\n";
#### lookup inet addr and Mask from the GetIpAddrTable call
if(exists $ip_data{$if_index}) {
printf " inet addr:%s Mask:%s\n",
$ip_data{$if_index}->[0],
$ip_data{$if_index}->[1],
;
}
printf " MTU:%d Speed:%.2f Mbps\n",
$struct{dwMtu},
$struct{dwSpeed}/1000/1000;
printf " Admin status:%s Oper status:%s\n",
if_admin_status($struct{dwAdminStatus}),
if_oper_status($struct{dwOperStatus});
printf " RX packets:%d dropped:%d errors:%d unknown:%d\n
+",
$struct{dwInUcastPkts} + $struct{dwInNUcastPkts},
$struct{dwInDiscards},
$struct{dwInErrors},
$struct{dwInUnknownProtos},
;
printf " TX packets:%d dropped:%d errors:%d txqueuelen:%
+d\n",
$struct{dwOutUcastPkts} + $struct{dwOutNUcastPkts},
$struct{dwOutDiscards},
$struct{dwOutErrors},
$struct{dwOutQLen},
;
print " Descr: \"", unpack("Z*", $struct{bDescr}), "\"\n
+";
}
#### helper functions
sub if_hwaddr {
my($len, $addr) = @_;
return join(':', map {sprintf '%02x', $_ } unpack('C' x $len, $add
+r));
}
sub if_type {
my($type) = @_;
if($type == 1) { return "Other"; }
if($type == 6) { return "Ethernet"; }
if($type == 9) { return "Tokenring"; }
if($type == 15) { return "FDDI"; }
if($type == 23) { return "PPP"; }
if($type == 24) { return "Local loopback"; }
if($type == 28) { return "SLIP"; }
return "UNKNOWN($type)";
}
sub if_admin_status {
my($status) = @_;
if($status == 1) { return "UP"; }
if($status == 2) { return "DOWN"; }
if($status == 3) { return "TESTING"; }
return "UNKNOWN($status)";
}
sub if_oper_status {
my($status) = @_;
if($status == 0) { return "NON_OPERATIONAL"; }
if($status == 1) { return "UNREACHABLE"; }
if($status == 2) { return "DISCONNECTED"; }
if($status == 3) { return "CONNECTING"; }
if($status == 4) { return "CONNECTED"; }
if($status == 5) { return "OPERATIONAL"; }
return "UNKNOWN($status)";
}
sub if_ipaddr {
my($addr) = @_;
return join(".", unpack("C4", pack("L", $addr)));
}
__END__
PS. there's some error checking here and there to be added, but it's only $VERSION 0.01 ;-) | [reply] [Watch: Dir/Any] [d/l] |
To find the mac addresses of active network interface cards on the current machine,
you can use the (non-standard) Net::Interface module:
use Net::Interface qw( mac_bin2hex );
my @all_ifs = Net::Interface->interfaces;
print "Mac addresses of ethernet interfaces on this machine:\n";
for ( grep { $_->name =~ m/^eth\d/ } @all_ifs )
{
print mac_bin2hex( scalar $_->hwaddress ),"\n";
}
| [reply] [Watch: Dir/Any] [d/l] |