File Coverage

blib/lib/Network/IPv4Addr.pm

Criterion	Covered	Total	%
statement	69	74	93.2
branch	34	46	73.9
condition	9	15	60.0
subroutine	11	11	100.0
pod	6	8	75.0
total	129	154	83.7

#    IPv4Addr.pm - Perl module to manipulate IPv4 addresses.
#
#    Author: Francis J. Lacoste
#
#    Copyright (C) 1999 Francis J. Lacoste, iNsu Innovations Inc.
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms as perl itself.
#

package Network::IPv4Addr;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw();

%EXPORT_TAGS = (
		all => [qw{ ipv4_parse	    ipv4_checkip
			    ipv4_network    ipv4_broadcast
			    ipv4_cidr2msk   ipv4_msk2cidr
			    ipv4_in_network ipv4_dflt_netmask
			  } ],
	       );

@EXPORT_OK = qw();

Exporter::export_ok_tags('all');

$VERSION = '0.05';

# Preloaded methods go here.
use Carp;

# Functions to manipulate IPV4 address
my $ip_rgx = "\\d+\\.\\d+\\.\\d+\\.\\d+";

# Given an IPv4 address in host, ip/netmask or cidr format
# returns a ip / cidr pair.
sub ipv4_parse($;$) {
  my ($ip,$msk);
  # Called with 2 args, assume first is IP address
  if ( defined $_[1] ) {
    $ip = $_[0];
    $msk= $_[1];
  } else {
    ($ip)  = $_[0] =~ /($ip_rgx)/o;
    ($msk) = $_[0] =~ m!/(.+)!o;
  }

  # Remove white spaces
  $ip = ipv4_chkip( $ip ) or
    croak __PACKAGE__, ": invalid IPv4 address: ", $ip, "\n";
  $msk =~ s/\s//g if defined $msk;

  # Check Netmask to see if it is a CIDR or Network
  if (defined $msk ) {
    if ($msk =~ /^\d{1,2}$/) {
      # Check cidr
      croak __PACKAGE__, ": invalid cidr: ", $msk, "\n"
	if $msk < 0 or $msk > 32;
    } elsif ($msk =~ /^$ip_rgx$/o ) {
      $msk = ipv4_msk2cidr($msk);
    } else {
      croak __PACKAGE__, ": invalid netmask specification: ", $msk, "\n";
    }
  } else {
    # Host
    return $ip;
  }
  wantarray ? ($ip,$msk) : "$ip/$msk";
}

sub ipv4_dflt_netmask($) {
  my ($ip) = ipv4_parse($_[0]);

  my ($b1) = split /\./, $ip;

  return "255.0.0.0"	if $b1 <= 127;
  return "255.255.0.0"	if $b1 <= 191;
  return "255.255.255.0";
}

# Check form a valid IPv4 address.
sub ipv4_chkip($) {
  my ($ip) = $_[0] =~ /($ip_rgx)/o;

  return undef unless $ip;

  # Check that bytes are in range
  for (split /\./, $ip ) {
    return undef if $_ < 0 or $_ > 255;
  }
  return $ip;
}

# Transform a netmask in a CIDR mask length
sub ipv4_msk2cidr($) {
  my $msk = ipv4_chkip( $_[0] )
    or croak __PACKAGE__, ": invalid netmask: ", $_[0], "\n";

  my @bytes = split /\./, $msk;

  my $cidr = 0;
  for (@bytes) {
    my $bits = unpack( "B*", pack( "C", $_ ) );
    $cidr +=  $bits =~ tr /1/1/;
  }
  return $cidr;
}

# Transform a CIDR mask length in a netmask
sub ipv4_cidr2msk($) {
  my $cidr = shift;
  croak __PACKAGE__, ": invalid cidr: ", $cidr, "\n"
    if $cidr < 0 or $cidr > 32;

  my $bits = "1" x $cidr . "0" x (32 - $cidr);

  return join ".", (unpack 'CCCC', pack("B*", $bits ));
}

# Return the network address of
# an IPv4 address
sub ipv4_network($;$) {
  my ($ip,$cidr) = ipv4_parse( $_[0], $_[1] );

  # If only an host is given, use the default netmask
  unless ($cidr) {
    $cidr = ipv4_msk2cidr( ipv4_dflt_netmask($ip) );
  }
  my $u32 = unpack "N", pack "CCCC", split /\./, $ip;
  my $bits = "1" x $cidr . "0" x (32 - $cidr );

  my $msk = unpack "N", pack "B*", $bits;

  my $net = join ".", unpack "CCCC", pack "N", $u32 & $msk;

  wantarray ? ( $net, $cidr) : "$net/$cidr";
}

sub ipv4_broadcast($;$) {
  my ($ip,$cidr) = ipv4_parse( $_[0], $_[1] );

  # If only an host is given, use the default netmask
  unless ($cidr) {
    $cidr = ipv4_msk2cidr( ipv4_dflt_netmask($ip) );
  }

  my $u32 = unpack "N", pack "CCCC", split /\./, $ip;
  my $bits = "1" x $cidr . "0" x (32 - $cidr );

  my $msk = unpack "N", pack "B*", $bits;

  my $broadcast = join ".", unpack "CCCC", pack "N", $u32 | ~$msk;

  $broadcast;
}

sub ipv4_in_network($$;$$) {
  my ($ip1,$cidr1,$ip2,$cidr2);
  if ( @_ >= 3) {
    ($ip1,$cidr1) = ipv4_parse( $_[0], $_[1] );
    ($ip2,$cidr2) = ipv4_parse( $_[2], $_[3] );
  } else {
    ($ip1,$cidr1) = ipv4_parse( $_[0]);
    ($ip2,$cidr2) = ipv4_parse( $_[1]);
  }

  # Check for magic addresses.
  return 1 if $ip1 eq "255.255.255.255" or $ip1 eq "0.0.0.0";
  return 1 if $ip2 eq "255.255.255.255" or $ip2 eq "0.0.0.0";

  # Case where first argument is really an host
  return $ip1 eq $ip2 unless ($cidr1);

  # Case where second argument is an host
  if ( not defined $cidr2) {
      return ipv4_network( $ip1, $cidr1) eq ipv4_network( $ip2, $cidr1 );
  } elsif ( $cidr2 > $cidr1 ) {
      # Netmask 2 is more specific than netmask 1
      return ipv4_network( $ip1, $cidr2) eq ipv4_network( $ip2, $cidr2);
  } else {
      # Netmask 1 is more specific than netmask 2
      return ipv4_network( $ip1, $cidr1) eq ipv4_network( $ip2, $cidr1);
  }
}
# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__