view release on metacpan or  search on metacpan

HostAddr.pm  view on Meta::CPAN

            }elsif($self->{ipv} eq '6' && $line =~ m#(/\d{1,3})$#){
                $netmask = $1;
            }else{
                die "unknown netmask for $addr on $interface\n";
            }
            push @{$data{$interface}}, { address => $addr, netmask => $netmask };
        }elsif($line =~ /^\s+Description[\s\.]+:\s([^\r\n]+)/){
            $interface = $1;
        }elsif($line =~ /^\s+${ipv}[\s\.]+:\s+([a-f0-9:\.]{3,40})/){
            $addr = $1; # win7
        }elsif($line =~ /^\s+IP Address[\s\.]+:\s+(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/){
            $addr = $1 if($self->{ipv} eq '4'); # winXP IPv4
        }elsif($line =~ /^\s+IP Address[\s\.]+:\s+([a-f0-9:\.]{3,40})/){
            $addr = $1 if($self->{ipv} eq '6'); # winXP IPv6
        }elsif($line =~ /^\s+Subnet Mask[\s\.]+:\s+(\S+)/){
            $netmask = $1;
            #this handles multiple ip addrs on same interface (tested on XP, anyway)
            push @{$data{$interface}}, { address => $addr, netmask => $netmask };
        }
    }
    return \%data;
}

sub first_ip {
    my $self = shift;
    my $getint = shift || $self->{interface};

    my $cfg_aref = $self->ifconfig( $getint );

    for (@{$cfg_aref}){
        my $addr;
        if(/^\s+${ipv}\s+(?:addr:)?(\S+)\s/){
            $addr = $1; # unix
        }elsif(/^\s+${ipv}[\s\.]+:\s+([a-f0-9:\.]{3,40})/){
            $addr = $1; # windows 7 win32
        }elsif(/^\s+IP Address[\s\.]+:\s+(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/){
            $addr = $1 if($self->{ipv} eq '4'); # winxp ipv4
        }elsif(/^\s+IP Address[\s\.]+:\s+([a-f0-9:\.]{3,40})/){
            $addr = $1 if($self->{ipv} eq '6'); # winxp ipv6
        }
        if($addr){
            next if($addr =~ /^(?:127\.|::1)/); # never say ln is first
            return( $addr );
        }
    }

    die "couldnt find first $ipv IP Address\n";
}

sub ifconfig {
    my $self = shift;
    my $getint = shift || $self->{interface};

    my ($cmd,$param);
    if($^O eq 'MSWin32' || $^O eq 'cygwin'){
        $cmd = 'ipconfig';
        $param = '/all';
    }else{
        $cmd = 'ifconfig';
        $param = $getint || '-a';
        $param .= ' inet6' if($self->{ipv} eq '6' && $^O eq 'solaris');
    }
    my @config = $self->_get_stdout($cmd, $param);
    
    return( \@config );
}

sub main_ip {
    my $self = shift;
    my $method = shift || 'auto';

    if( $method eq 'preferred' && ($^O ne 'MSWin32' && $^O ne 'cygwin') ){ 
        die "'preferred' method to main_ip available on MSWin32/cygwin only.\n";
    }
    unless($method =~ /^(?:dns|route|preferred|auto)$/){
        die "invalid method given to main_ip\n";
    }
 
    if($method eq 'dns' || $method eq 'auto'){  
        my $addr;
        my $hostname = hostname();
        $self->_debug( "attempting hostname lookup in main_ip: $hostname" );
        eval {
            local $SIG{ALRM} = sub { die "timeout on $hostname\n" };
            alarm(3);
            my @x = ( gethostbyname($hostname) )[4];
            alarm(0);
    
            verbose( "multiple ip addrs found for $hostname" ) if(@x > 1);
            $addr = join( '.', unpack('C4', $x[0]) );
        };
        alarm(0);
        if($@){
            $self->_warn($@);
        }    
        if( $addr ){
            return $addr unless($addr =~ /^(?:127\.|::1)/); # never say lo is main
        }
        $self->_debug( "DNS lookup did not yield an IP addr." );
    }

    if($method eq 'route' || $method eq 'auto'){
        # if dns method failed us, check for default route, find local ip
        # addr(s) in same subnet -"first" one listed will be called "main"
        
        my ($cmd,$param);
        if($^O eq 'solaris'){
            $cmd = 'route';
            $param = 'get 0.0.0.0';
        }else{
            $cmd = 'netstat'; # works with MSWin32, too
            $param = '-nr';
        }
    
        my @data = $self->_get_stdout($cmd, $param);
        for my $line (@data){
            chomp $line;
            if($line =~ /^\s+0\.0\.0\.0\s+0\.0\.0\.0\s+\S+\s+(\S+)\s+/){
                return( $1 ); # mswin32
            }elsif($line =~ /^(?:0\.0\.0\.0|default)\s.*\s(\S+)$/){
                # 0.0.0.0 = debian linux, default = freebsd
                return( $self->first_ip($1) );
            }elsif($line =~ /^\s+interface:\s+(\S+)$/){
                return( $self->first_ip($1) ); # solaris
            }
        }
    }

    if($^O eq 'MSWin32' || $^O eq 'cygwin'){
        if($method eq 'preferred' || $method eq 'auto'){
            my $cfg_aref = $self->ifconfig();
            foreach (@{$cfg_aref}){
                if(/^\s+${ipv}[\s\.]+:\s+(\S+)\(Preferred\)/){
                    return($1);
                }
            }
        }
    }
 
    die "could not determine main ip address\n"; # we dont pick one at random
}

sub _mkipv {
    my $self = shift;

    return ( ($^O eq 'MSWin32' || $^O eq 'cygwin') && $self->{ipv} eq '6' ) ? 'IPv6 Address' :
             ($^O eq 'MSWin32' || $^O eq 'cygwin')  ? 'IPv4 Address' :
             ($self->{ipv} eq '6') ? 'inet6' :
                                     'inet';
}

sub _get_stdout {
    my $self = shift;
    my $cmd = shift || die "get_stdout syntax error1\n";
    my $params = join(' ', @_);

    $self->_debug( "running cmd: [$cmd] params: [$params]" );

    open(my $fh, "$cmd $params |") || die "cannot fork $cmd: $!\n"; # -| is 5.8+
    my @data = <$fh>;
    close $fh;

    return( @data );
}

sub _warn {
    my $self = shift;
    my $msg = join('', @_);

    warn "$self->{class}: $msg\n";
}

sub _debug {
    my $self = shift;

    $self->_warn(@_) if($self->{debug});
}


1;

__END__

=pod

=head1 NAME

Sys::HostAddr - Get IP address information about this host

=head1 SYNOPSIS

use Sys::HostAddr;

my $sysaddr = Sys::HostAddr->new();

my $string = $sysaddr->public();

my $aref = $sysaddr->interfaces();

my $aref = $sysaddr->addresses();

my $href = $sysaddr->ip();

my $ip = $sysaddr->first_ip();

my $main = $sysaddr->main_ip();