view release on metacpan or  search on metacpan

lib/Sys/HostIP.pm  view on Meta::CPAN

    delete $ENV{'BASH_ENV'};

    # now we set the local $ENV{'PATH'} to be only the path to ifconfig
    # We have localized %ENV in the call to this, so we disable critic warning
    ## no critic qw(Variables::RequireLocalizedPunctuationVars)
    my $ifconfig = $self->ifconfig;
    $ENV{'PATH'} = dirname $ifconfig;

    return $ifconfig;
}

sub _get_unix_interface_info {
    my $self = shift;

    # localize the environment
    local %ENV;

    # make sure nothing else has touched $/
    local $/ = "\n";

    my ( $ip, $interface, %if_info );

    # clean environment for taint mode
    my $ifconfig_bin = $self->_clean_ifconfig_env();
    my @ifconfig     = `$ifconfig_bin`;

    foreach my $line (@ifconfig) {

        # TODO: refactor this into tests
        # output from 'ifconfig -a' looks something like this on every *nix i
        # could get my hand on except linux (this one's actually from OpenBSD):
        #
        # gershiwin:~# /sbin/ifconfig -a
        # lo0: flags=8009<UP,LOOPBACK,MULTICAST>
        #         inet 127.0.0.1 netmask 0xff000000
        # lo1: flags=8008<LOOPBACK,MULTICAST>
        # xl0: flags=8843<UP,BROADCAST,RUNNING,SIMPLEX,MULTICAST>
        #         media: Ethernet autoselect (100baseTX full-duplex)
        #         status: active
        #         inet 10.0.0.2 netmask 0xfffffff0 broadcast 10.0.0.255
        # sl0: flags=c010<POINTOPOINT,LINK2,MULTICAST>
        # sl1: flags=c010<POINTOPOINT,LINK2,MULTICAST>
        #
        # in linux it's a little bit different:
        #
        # [jschatz@nooky Sys-IP]$ /sbin/ifconfig
        #  eth0      Link encap:Ethernet  HWaddr 00:C0:4F:60:6F:C2
        #           inet addr:10.0.3.82  Bcast:10.0.255.255  Mask:255.255.0.0
        #           UP BROADCAST RUNNING MULTICAST  MTU:1500  Metric:1
        #           Interrupt:19 Base address:0xec00
        #  lo        Link encap:Local Loopback
        #           inet addr:127.0.0.1  Mask:255.0.0.0
        #           UP LOOPBACK RUNNING  MTU:3924  Metric:1
        #
        # In linux, using /sbin/ip it looks like:
        # [goldenboy:~] adamb $ ip address
        # 1: lo:   <LOOPBACK,UP,LOWER_UP> mtu 65536 qdisc noqueue state UNKNOWN group default
        #     link/loopback 00:00:00:00:00:00 brd 00:00:00:00:00:00
        #     inet 127.0.0.1/8 scope host lo
        #        valid_lft forever preferred_lft forever
        #     inet6 ::1/128 scope host
        #        valid_lft forever preferred_lft forever
        # 2: eth0: <NO-CARRIER,BROADCAST,MULTICAST,UP> mtu 1500 qdisc pfifo_fast state DOWN group default qlen 1000
        #     link/ether 9c:b6:54:a5:64:60 brd ff:ff:ff:ff:ff:ff
        #
        # so the regexen involved here have to deal with the following: 1)
        # there's no ':' after an interface's name in linux 2) in linux, it's
        # "inet addr:127.0.0.1" instead of "inet 127.0.0.1" hence the somewhat
        # hairy regexen /(^\w+(?:\d)?(?:\:\d)?)/ (which also handles aliased ip
        # addresses , ie eth0:1) and /inet(?:addr\:)?(\d+\.\d+\.\d+\.\d+)/
        #
        # so we parse through the list returned. if the line starts with some
        # letters followed (possibly) by an number and a colon, then we've got an
        # interface. if the line starts with a space, then it's the info from the
        # interface that we just found, and we stick the contents into %if_info
        if ( ( $line =~ /^\s+/x ) && ($interface) ) {
            $if_info{$interface} .= $line;
        }

        # FIXME: refactor this regex
        elsif ( ($interface) = ( $line =~ /^(?:\d+\:\s){0,1}(\w+(?:\d)?(?:\.\d+)?(?:\:\d+)?)/x ))
        {
            $line =~ s/\w+\d(\:)?\s+//x;
            $if_info{$interface} = $line;
        }
    }

    foreach my $key ( keys %if_info ) {

        # now we want to get rid of all the other crap in the ifconfig
        # output. we just want the ip address. perhaps a future version can
        # return even more useful results (netmask, etc).....
        if ( my ($ip)
            = ( $if_info{$key} =~ /inet\s(?:addr\:)?(\d+(?:\.\d+){3})/x ) )
        {
            $if_info{$key} = $ip;
        } else {

            # ok, no ip address here, which means this interface isn't
            # active. some os's (openbsd for instance) spit out ifconfig info for
            # inactive devices. this is pretty much worthless for us, so we
            # delete it from the hash
            delete $if_info{$key};
        }
    }

    # now we do some cleanup by deleting keys that have no associated info
    # (some os's like openbsd list inactive interfaces when 'ifconfig -a' is
    # used, and we don't care about those
    return \%if_info;
}

sub _run_ipconfig {
    return `ipconfig`;
}

sub _get_win32_interface_info {
    my $self    = shift;
    my %regexes = (
        address => qr/
            \s+