Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Sys::IP

by BlueLines (Hermit)
on Apr 04, 2001 at 08:09 UTC ( #69544=sourcecode: print w/ replies, xml ) Need Help??

Category: Networking Code
Author/Contact Info jon@divisionbyzero.com
Description: This is a rewrite of Sys::IP that actually works on unix systems. It has 3 functions:
  • ip() - returns the first non-127.0.0.1 ip address it can find on the local machine
  • ips() - returns a list of all ips on a local machine.
  • interfaces() - returns a hash of interface/ip address pairs from the local machine
#!/usr/bin/perl -w
#
# File:           IP.pm 
#
# Summary:        
#
# Author:         Jonathan Schatz
# E-Mail:         jon@divisionbyzero.com
# Org:            
#
# Orig-Date:      26-Mar-01 at 01:43:09
# Last-Mod:       03-Apr-01 at 21:06:23 by 

# -*- EOF -*-
package Sys::IP;
use strict;
use vars qw($VERSION @ISA @EXPORT $IFCONFIG_BINARY);
require Exporter;
use Sys::Hostname;
@ISA = qw(Exporter);
@EXPORT= qw($IFCONFIG_BINARY ip ips interfaces);
$VERSION = 1.0 ;

#---------------------------------------------------------------------
+-------#
#we want to die if a system isn't explicitly supported
BEGIN {
  grep /$^O/, SUPPORTED() or die "$^O isn't supported by Sys:IP yet.\n
+";
}
#---------------------------------------------------------------------
+-------# 
#this is where ifconfig lives on systems that i had access too
my %ifconfigLocation = (   'linux' => '/sbin/ifconfig',
            'openbsd' => '/sbin/ifconfig',
            'freebsd' => '/sbin/ifconfig',
            'irix' => '/usr/etc/ifconfig',
            'solaris' => '/sbin/ifconfig',
            'darwin' => '/sbin/ifconfig'
            );

#---------------------------------------------------------------------
+-------#
#these are the os's that are supported at this time
sub SUPPORTED {
  return ('openbsd', 'freebsd', 'linux', 'irix', 'solaris', 'darwin', 
+'MSWin32');
}

#---------------------------------------------------------------------
+-------#
#you can override $IFCONFIG_BINARY if your ifconfig program's location
#differs from the standard ones listed above
$IFCONFIG_BINARY = $ifconfigLocation{$^O};

#---------------------------------------------------------------------
+-------#
sub ip {
  #ok, this will be the default use. we'll take out the loopback entry
+, and
  #return the ip address of the first interface that comes up
  #afterwards. This should be fine for most people, since most machine
+s only
  #have one ip address
  if($^O eq 'MSWin32') {
    #this will change once i can get a win32 machine to fix this code
    return(getWin32InterfaceInfo());
  }
  else {
    my %ifInfo = getUnixInterfaceInfo();
    foreach my $key (sort keys %ifInfo) {
      #we don't want the loopback
      next if ($ifInfo{$key} eq '127.0.0.1');
      #now we return the first one that comes up
      return ($ifInfo{$key});
    }
    #we get here if loopback is the only active device
    return undef;
  }
}
#---------------------------------------------------------------------
+-------# 
sub ips {
  #ips() returns all ip addresses on a machine this is a hack. i don't
+ know
  #how win32 handles multiple ip addresses, so this is broken until i 
+can
  #get a testing machine (or until someone fixes it for me)
  if ($^O eq 'MSWin32') {
    return (getWin32InterfaceInfo());
  }
  else {
    my %ifInfo = getUnixInterfaceInfo();
    my @ips = '';
    foreach my $key (keys %ifInfo) {
      push @ips, $ifInfo{$key};
    }
    return @ips;
  }
}
#---------------------------------------------------------------------
+-------# 
sub interfaces {
  #interfaces returns a hash of interface:ip address pairs.
  #
  #again, the ms code will be fixed when i get a test machine setup
  if ($^O eq 'MSWin32') {
    return ('MSWin32', getWin32InterfaceInfo());
  }
  else {
    return getUnixInterfaceInfo();
  }
}
#---------------------------------------------------------------------
+-------#
sub getWin32InterfaceInfo {
  #this is shamefully stolen from the original Sys::HostIP. I've got t
+o find
  # a win32 machine to test and clean this up on, but for the time bei
+ng
  # we'll just use it (since i assume it works already).
  #
  #begin code that i didn't write:
  #
  #check ipconfig.exe (Whichdoes all the work of checking the registry
+,
  #probably more efficiently than I could.)
  my $nocannon= (split /\./, (my $cannon = hostname))[0];
  my $ip;
  return $ip= $1 if `ipconfig`=~ /(\d+\.\d+\.\d+\.\d+)/;
  
  # check nbtstat.exe 
  # (Which does all the work of checking WINS,
  # more easily than Win32::AdminMisc::GetHostAddress().)
  return $ip= $1 if `nbtstat -a $nocannon`=~ /(\d+\.\d+\.\d+\.\d+)/;
  
  # check /etc/hosts entries 
  if(open HOST, "<$ENV{SystemRoot}\\System32\\drivers\\etc\\hosts")
    {
      while(<HOST>)
    {
      last if /\b$cannon\b/i and /(\d+\.\d+\.\d+\.\d+)/ and $ip= $1;
    }
      close HOST;
      return $ip if $ip;
    }
  
  # check /etc/lmhosts entries 
  # (It will only be here if the file has been modified since the
  # last WINS refresh, which is unlikely, but might as well try.)
  if(open HOST, "<$ENV{SystemRoot}\\System32\\drivers\\etc\\lmhosts")
    {
      while(<HOST>)
    {
      last if /\b$nocannon\b/i and /(\d+\.\d+\.\d+\.\d+)/ and $ip= $1;
    }
      close HOST;
      return $ip if $ip;
    }
}

#---------------------------------------------------------------------
+-------# 

sub getUnixInterfaceInfo {
  my %ifInfo;
  my ($ip, $interface) = undef;
  #this is an attempt to fix tainting problems
  local %ENV;
  # $BASH_ENV must be unset to pass tainting problems if your system u
+ses
  # bash as /bin/sh
  if ($ENV{'BASH_ENV'}) {
    $ENV{'BASH_ENV'} = undef;
  }
  #now we set the local $ENV{'PATH'} to be only the path to ifconfig
  my $newpath = $ifconfigLocation{$^O};
  $newpath =~s/\/\w+$//;
  $ENV{'PATH'} = $newpath;

  my @ifconfig = `$ifconfigLocation{$^O} -a`;
  foreach my $line (@ifconfig) {
    #output from 'ifconfig -a' looks something like this on every *nix
+ i
    #could get my hand on except linux (this one's actually from OpenB
+SD):
    #
    #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
    #
    # 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, i
+t's
    # "inet addr:127.0.0.1" instead of "inet 127.0.0.1" hence the some
+what
    # hairy regexen /(^\w+(?:\d)?(?:\:\d)?)/ (which also handles alias
+ed ip
    # addresses , ie eth0:1) and /inet(?:addr\:)?(\d+\.\d+\.\d+\.\d+)/
    #
    #so we parse through the list returned. if the line starts with so
+me
    #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 fr
+om the
    #interface that we just found, and we stick the contents into %ifI
+nfo
    if ( ($line =~/^\s+/) && ($interface) ) {
      $ifInfo{$interface} .= $line;
    }
    elsif (($interface) = ($line =~/(^\w+(?:\d)?(?:\:\d)?)/)) {
      $line =~s/\w+\d(\:)?\s+//;
      $ifInfo{$interface} = $line;
    }
  }
    foreach my $key (keys %ifInfo) {
      #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 c
+an
      #return even more useful results (netmask, etc).....
      if (my ($ip) = ($ifInfo{$key} =~/inet (?:addr\:)?(\d+\.\d+\.\d+\
+.\d+)/)) {
    $ifInfo{$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 f
+or
    #inactive devices. this is pretty much worthless for us, so we
    #delete it from the hash
    delete $ifInfo{$key};
      }
    }
  #now we do some cleanup by deleting keys that have no associated inf
+o
  #(some os's like openbsd list inactive interfaces when 'ifconfig -a'
+ is
  #used, and we don't care about those
  return %ifInfo;
} 
1;
__END__

=pod

=head1 NAME

Sys::IP - Returns all ip addresses from the local machine in various f
+orms

=head1 SYNOPSIS

=over 4

use Sys::IP;

my $ip = ip();

my @ips = ips();

my %interfaces = interfaces();

=back 4

=head1 DESCRIPTION

  Sys::IP is a rewrite of the original Sys::IP that supports man *NIX 
+systems. The win32 code has been taken from the old SYS::IP, and the 
+unix code was written from scratch. Sys::IP runs on a variety of *NIX
+ flavors (currently freebsd, openbsd, linux, solaris, irix, and darwi
+n). More support will be added when I get more machines to test on :-
+)

=head1 FUNCTIONS

=item ip()

This returns a scalar containing the first non-localhost (127.0.0.1) i
+p address that exists on the local machine.

=item ips()

This returns a list of all ip addresses that exist on the local machin
+e.

=item interfaces()

This returns a hash of all interface/ip address pairs that exist on th
+e local machine

=head1 BUGS

  The interfaces() function doesn't work on Win32 systems. Support is 
+planned when I find some spare time.

=head1 AUTHOR

Jonathan Schatz, jon@divisionbyzero.com

=cut

Comment on Sys::IP
Download Code
Re: Sys::IP
by idnopheq (Chaplain) on Apr 04, 2001 at 14:32 UTC
    I tested this on a RedHat 7 box w/ 5.6.0. It failed with

    Undefined subroutine &Sys::IP::SUPPORTED called at /usr/lib/perl5/site_perl/5.6.0/Sys/IP.pm line 27. BEGIN failed--compilation aborted at /usr/lib/perl5/site_perl/5.6.0/Sys/IP.pm line 28. Compilation failed in require at ./getip.pl line 5. BEGIN failed--compilation aborted at ./getip.pl line 5.

    I think the BEGIN block doesn't like looking for a sub not included in the block. So, I tested my theory with the following adjustment:

    #--------------------------------------------------------------------- +-------# #we want to die if a system isn't explicitly supported BEGIN { #these are the os's that are supported at this time my @Supported = ( 'openbsd', 'freebsd', 'linux', 'irix', 'solaris', 'darwin', 'MSWin32' ); grep /$^O/, @Supported or die "$^O isn't supported by Sys:IP yet.\n"; }

    I've been up all night, so this could be made better, but it works. Here is my test code:

    #!/usr/bin/perl -w #-*-perl-*- use strict; use Sys::IP; use diagnostics; my $ip = ip(); my @ips = ips(); print $ip , "\n"; foreach ( @ips ) { print $_ , "\n"; }

    BTW, MSWin32 uses 'ipconfig /all' for the type of data you need. I think it sits in %SystemRoot%/system32 on NT/2k and %SystemRoot%/command on 98/ME, but I could be wrong. By default, if networking is installed, ipconfig should reside in the PATH env var. I'll check it for you when I get in to work.

    HTH
    Dex

      heh, i _knew_ that BEGIN foolishness wasn't going to do what i thought it would. I was constantly doing the following:
      nooky:~$ sudo cp IP.pm /usr/lib/perl5/5.6.0/i386-linux/Sys/ nooky:~$ perl -MSys::IP -e 'print ips()'
      over and over again. I must not have tested the BEGIN version (I originally did what you did). But thanks for the feedback. I'm fixing that, and I'll try the new Win32 stuff, and if all goes well, I'll ship it off to CPAN.

      BlueLines

      Disclaimer: This post may contain inaccurate information, be habit forming, cause atomic warfare between peaceful countries, speed up male pattern baldness, interfere with your cable reception, exile you from certain third world countries, ruin your marriage, and generally spoil your day. No batteries included, no strings attached, your mileage may vary.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://69544]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (5)
As of 2014-11-20 23:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (103 votes), past polls