http://qs321.pair.com?node_id=167276
Category: Win32 Stuff
Author/Contact Info dada
Description: this script exploits some system APIs to emulate Unix's 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...

this was already posted in reply to List all network interfaces on the local machine?, but I think it deserves a mention in the Code Catacomb (sorry for the duplication :-).
#!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__
Replies are listed 'Best First'.
Re: if_info.pl
by grinder (Bishop) on May 17, 2002 at 20:40 UTC
    I have a comment to make about the if_oper_status routine and similar lookup routines. Basically, you want to use a hash, as it makes things much easier to maintain.

    BEGIN { my %oper = ( 0 => 'NON_OPERATIONAL', 1 => 'UNREACHABLE', 2 => 'DISCONNECTED', 3 => 'CONNECTING', 4 => 'AND_SO_ON', ); sub if_oper_status { my $status = shift; $oper{$status} || "UNKNOWN($status)"; } }

    From there, it might be worthwhile to factor the different lookup routines into a single one, to which you pass the status code along with the hash that represents the text representation.

    BEGIN { my %_status_oper = ( 0 => 'NON_OPERATIONAL', 1 => 'UNREACHABLE', 2 => 'DISCONNECTED', 3 => 'CONNECTING', 4 => 'AND_SO_ON', ); my %_status_admin = ( 0 => 'UP', 1 => 'DOWN', 2 => 'TESTING', ); sub _if_status { my $status = shift; my $text = shift; $text->{$status} || "UNKNOWN($status)"; } sub if_oper_status { _if_status( @_, \%_status_oper ) } sub if_admin_status { _if_status( @_, \%_status_admin ) } } printf " Admin status:%s Oper status:%s\n", if_admin_status($struct{dwAdminStatus}), if_oper_status($struct{dwOperStatus});

    The idea I want to show is that all you have to do in this scenario is add another line to a hash and you're done. If you can modify a program simply by changing data structures you stand a better chance of not introducing bugs than if you have to change code.

    Note that the above code would be a perfect use for using the &func method of calling a subroutine, because we want to pass the passed-in arguments down to the child routine without even looking at them. But when I wrote it that way it looked odd, as if I'd forgotten to pass a parameter, which only comforts me in my belief that the &func calling method is to be proscribed.


    print@_{sort keys %_},$/if%_=split//,'= & *a?b:e\f/h^h!j+n,o@o;r$s-t%t#u'