#!/usr/bin/perl
#
#   File: vlsm.p
# Author: Darin Davis, Copyright 1997
#   Date: 6 June 1997
# Update: 26 July 1997
#   Desc: Command line VLSM address computer.  See Usage().
#	  Most useful (in DOS/Win95) when defined as a DOSKEY macro,
#	  such as:
#
#		doskey vlsm \path\perl \path\vlsm.p $*
#
# Change History:
#	7 July 1997 - corrected one-off error in print_subnets()
#	26 July 1997 - changed recommendation in Desc from DOS
#		       batch file to DOSKEY macro (to support
#		       redirection)
#

			########################
			### GLOBAL CONSTANTS ###
			########################

					# table to convert number of bits
					# in octet mask to decimal equivalent
$masks{0} = 0;
$masks{1} = 128;
$masks{2} = 192;
$masks{3} = 224;
$masks{4} = 240;
$masks{5} = 248;
$masks{6} = 252;
$masks{7} = 254;

$true = 1 == 1;
$false = ! $true;

			########################
			### GLOBAL VARIABLES ###
			########################

					# HOUSEKEEPING VARIABLES (w/defaults)

$arg;					# zeroth cmd line argument
$mask_set = $false;			# did the user specify a mask? No
$subnets_set = $false;			# did the user request all subnets? No

					# INPUT VARIABLES (with defaults)

$mask_length = 24;			# length of mask in bits
$ipaddr = "192.168.10.10";		# IP address
$mask = "255.255.255.0";		# network mask

					# COMPUTED VARIABLES

$subnets;				# number of subnets
$hosts;					# number of hosts
$addrclass;				# address class
$net_addr;				# network address (bit-wise AND
					# of ipaddr and mask)


			###################
			### SUBROUTINES ###
			###################

					####################################
					# prints program usage
					####################################
sub Usage {
  print "\nUsage:\t$0 [<flag> <value>] ...\n";
  print <<END_USAGE;

		Flag	Value

		-a	IP Address (in dotted decimal)
		-l	Length of mask in bits
		-m	Mask (in dotted decimal)

		Flag	Description (no value)

		-h	Help (print this message)
		-s	print all Subnet numbers

		Note: If both a mask and a mask length are specified,
		      the mask length is *ignored*.

END_USAGE

  exit;
}

					####################################
					# computes network mask from
					# mask length
					####################################
sub compute_mask {
  local($tmp_ml = $mask_length);
  local($octet1, $octet2, $octet3, $octet4);

					# compute octet 1
  if ($tmp_ml < 8) {
    $octet1 = $masks{$tmp_ml};
    $mask = "$octet1.0.0.0";
    return;
  }
  else {
    $octet1 = "255";
    $tmp_ml -= 8;			# reduce number of remaining bits
  }

					# compute octet 2
  if ($tmp_ml < 8) {
    $octet2 = $masks{$tmp_ml};
    $mask = "$octet1.$octet2.0.0";
    return;
  }
  else {
    $octet2 = "255";
    $tmp_ml -= 8;			# reduce number of remaining bits
  }

					# compute octet 3
  if ($tmp_ml < 8) {
    $octet3 = $masks{$tmp_ml};
    $mask = "$octet1.$octet2.$octet3.0";
    return;
  }
  else {
    $octet3 = "255";
    $tmp_ml -= 8;			# reduce number of remaining bits
  }

					# compute octet 4

  $octet4 = $masks{$tmp_ml}; 		# ASSUME it's < 8
  $mask = "$octet1.$octet2.$octet3.$octet4";
}

					####################################
					# returns the decimal equivalent of
					# the binary number represented by
					# the string bin_num
					####################################
sub convert_bin_to_dec {
  local($bin_num) = @_;
  local($dec_num, $power, $multiplier);

					# make sure bin_num is true to itself
  die("VLSM: convert_bin_to_dec: '$bin_num' is not a binary number")
	unless ($bin_num =~ /^(0|1)+$/);

  while(length($bin_num) > 0) {		# compute each bit, MSB to LSB
    $power = length($bin_num) - 1;	# MSB * 2 ^ power = dec equiv of MSB
#print "power = $power\n";
    $bin_num =~ s/^.//;			# discard MSB; decr length($bin_num)
    $multiplier = $&;			# note discarded MSB
#print "multiplier = $multiplier\n";
					# keep a running sum
    $dec_num += $multiplier * (2 ** $power);
  }
  return $dec_num;
}


					####################################
					# converts a decimal number to any
					# base between 2 and 9 (inclusive);
					# returns the converted number
					# filled to num_fill leading zeros
					####################################
sub convert_dec_to_base {
  local($base10num, $target_base, $num_fill) = @_;
  local($quotient, $remainder, $divisor, $dividend, $new_num);

					# validate target base
  die("VLSM: convert_dec_to_base: '$target_base' is not between 2 and 9")
	unless (2 <= $target_base && $target_base <= 9);

  $dividend = $base10num;
  $divisor = $target_base;
  $quotient = 1;			# just has to satisfy while loop test
  $new_num = "";			# no digits initially

					# convert bases
  while ($quotient > 0) {
#print "q='$quotient', dd='$dividend', ds='$divisor'\n";
    $remainder = $dividend % $divisor;
    $quotient = int($dividend / $divisor);
    $dividend = $quotient;
    $new_num = $remainder . $new_num;
  }

  while (length($new_num) < $num_fill) {	# pad with leading zeros
    $new_num = "0" . $new_num;
  }

  return $new_num; 
}

					####################################
					# computes mask length (in bits)
					# of a network mask
					####################################
sub compute_length {
  local($binary_mask, @octets);

  @octets = split(/\./, $mask);		# decompose mask octets

					# convert mask to binary
  $binary_mask = &convert_dec_to_base($octets[0], 2, 8) .
		 &convert_dec_to_base($octets[1], 2, 8) .
		 &convert_dec_to_base($octets[2], 2, 8) .
		 &convert_dec_to_base($octets[3], 2, 8);

  $binary_mask =~ s/0+$//;		# truncate trailing zeros

  if ($binary_mask =~ /^1+$/) {		# if the mask is all ones
    $mask_length = length($binary_mask);
  }
  else {
    die("VLSM: Non-contiguous mask '$mask'!  Don't do this!!!")
  }
}


					####################################
					# compute network address (bitwise
					# AND of ipaddr and mask
					####################################
sub compute_netaddr {
  local(@a_octets, @m_octets,		# ipaddr and mask octets
	@n_octets);

  @a_octets = split(/\./, $ipaddr);	# decompose address octets
  @m_octets = split(/\./, $mask);	# decompose mask octets

#print join(":",@a_octets); print "\n";	# make sure we've got addr & mask
#print join(":",@m_octets); print "\n";

					# AND example from Camel book:

					# doesn't work
#print "123.45 AND 234.56 = ", "123.45" & "234.56", "\n";

					# doesn't work
#print "123 AND 234 = ", "123" & "234", "\n";
					# works! So, operands *have* to
					# be numeric; won't convert from
					# strings (contrary to Camel book
					# example).
#print "123 AND 234 = ", 123 & 234, "\n";

					# force a numeric scalar context

  $a_octets[0] = hex(sprintf("%x", $a_octets[0]));
  $m_octets[0] = hex(sprintf("%x", $m_octets[0]));
  $a_octets[1] = hex(sprintf("%x", $a_octets[1]));
  $m_octets[1] = hex(sprintf("%x", $m_octets[1]));
  $a_octets[2] = hex(sprintf("%x", $a_octets[2]));
  $m_octets[2] = hex(sprintf("%x", $m_octets[2]));
  $a_octets[3] = hex(sprintf("%x", $a_octets[3]));
  $m_octets[3] = hex(sprintf("%x", $m_octets[3]));

					# bitwise AND of addr and mask

#print "a0 = $a_octets[0], m0 = $m_octets[0]\n";

  $n_octets[0] = $a_octets[0] & $m_octets[0];
  $n_octets[1] = $a_octets[1] & $m_octets[1];
  $n_octets[2] = $a_octets[2] & $m_octets[2];
  $n_octets[3] = $a_octets[3] & $m_octets[3];

  $netaddr = join(".", @n_octets);

#print "$netaddr\n";
#exit;
}


					####################################
					# computes subnet class of an
					# IP address
					####################################
sub compute_class {
  local(@octets);

  @octets = split(/\./, $ipaddr);

  if (0 <= $octets[0] && $octets[0] < 128) {
    $addrclass = "A";
  }
  elsif (128 <= $octets[0] && $octets[0] < 191) {
    $addrclass = "B";
  }
  elsif (191 <= $octets[0] && $octets[0] < 223) {
    $addrclass = "C";
  }
  else {
    $addrclass = "M";			# Multicast/experimental address
  }
}

					####################################
					# computes the number of subnets
					# and hosts given the address class 
					####################################
sub compute_subnets_hosts {
  local($bits);

#print "compute_subnets_hosts: addrclass = $addrclass\n";

  if ($addrclass eq "A") {		# class A address?
#print "compute_subnets_hosts: class A\n";
    if ($mask_length < 8) {
	die("VLSM: '$mask' is an invalid class A mask.");
    }
    else {				# yes, so compute subnets/hosts
	$bits = $mask_length - 8;
	$subnets = 2 ** $bits;
	$hosts = 2 ** (32 - $mask_length);
#print "compute_subnets_hosts: class A, subnets=$subnets, hosts=$hosts\n";
    }
  }

  elsif ($addrclass eq "B") {		# class B address?
#print "compute_subnets_hosts: class B\n";
    if ($mask_length < 16) {
	die("VLSM: '$mask' is an invalid class B mask.");
    }
    else {				# yes, so compute subnets/hosts
	$bits = $mask_length - 16;
	$subnets = 2 ** $bits;
	$hosts = 2 ** (32 - $mask_length);
    }
  }

  elsif ($addrclass eq "C") {		# class C address?
#print "compute_subnets_hosts: class C\n";
    if ($mask_length < 24) {
	die("VLSM: '$mask' is an invalid class C mask.");
    }
    else {				# yes, so compute subnets/hosts
	$bits = $mask_length - 24;
	$subnets = 2 ** $bits;
	$hosts = 2 ** (32 - $mask_length);
    }
  }

  else {				# must be a multicast/experimental
					#   address
    $subnets = "Multicast/Experimental address";
    $hosts = "Multicast/Experimental address";
#print "compute_subnets_hosts: multicast/experimental\n";
  }
}


					####################################
					# returns TRUE or FALSE depending
					# if $host is a valid IP address
					####################################
sub is_ip {
  local($host) = @_;
  local($first_octet, $other_octet);

  $first_octet = "[1-9]|[1-9][0-9]|[1][0-9][0-9]|2[0-4][0-9]|25[0-5]";
  $other_octet = "[0-9]|[1-9][0-9]|[1][0-9][0-9]|2[0-4][0-9]|25[0-5]";

  return ($host =~ /^($first_octet)\.($other_octet)\.($other_octet)\.($other_octet)$/);
}

					####################################
					# computes and returns a subnet
					# number
					####################################

sub compute_subnet_number {
  local($subnet) = @_;
  local($bin_ipaddr, @octets);

  @octets = split(/\./, $ipaddr);	# decompose address into octets

					# convert first 3 octets to binary
  $octets[0] = &convert_dec_to_base($octets[0], 2, 8);
  $octets[1] = &convert_dec_to_base($octets[1], 2, 8);
  $octets[2] = &convert_dec_to_base($octets[2], 2, 8);

					# build network prefix of address
  if ($addrclass eq "A") {
    $bin_ipaddr = $octets[0];
  }
  elsif ($addrclass eq "B") {
    $bin_ipaddr = $octets[0] . $octets[1];
  }
  elsif ($addrclass eq "C") {
    $bin_ipaddr = $octets[0] . $octets[1] . $octets[2];
  }
  else {
    print "\tN/A - Multicast/Experimental Network Number\n";
    exit;
  }
#print "bin_ipaddr = $bin_ipaddr\n";
					# tack on the subnet bits...
  $bin_ipaddr .= $subnet;
#print "bin_ipaddr = $bin_ipaddr\n";
					# ...and the host bits
  while (length($bin_ipaddr) < 32) {
    $bin_ipaddr .= "0";
  }
#print "bin_ipaddr = $bin_ipaddr\n";
					# convert the octets back to decimal

  $bin_ipaddr =~ s/^........//;		# behead first 8 bits...
  $octets[0] = $&;			# ...save them & convert to decimal
  $octets[0] = &convert_bin_to_dec($octets[0]);

  $bin_ipaddr =~ s/^........//;		# behead second 8 bits...
  $octets[1] = $&;			# ...save them & convert to decimal
  $octets[1] = &convert_bin_to_dec($octets[1]);

  $bin_ipaddr =~ s/^........//;		# behead third 8 bits...
  $octets[2] = $&;			# ...save them & convert to decimal
  $octets[2] = &convert_bin_to_dec($octets[2]);

					# fourth octet remains, so
					# convert to decimal
  $octets[3] = &convert_bin_to_dec($bin_ipaddr);

  return join(".", @octets);		# return the subnet number
}


					####################################
					# prints all subnet numbers
					####################################
sub print_subnets {
  local($nbits,				# number of bits that compose the
					# subnet portion of the mask
	$i,
	$subnet);			# the decimal equiv of the nbits bits

  print "Subnets:\n";

					# compute number of subnet bits
  $nbits = length(&convert_dec_to_base($subnets, 2, 0));

					# compute and print each subnet num
  for ($i=0; $i < $subnets; $i++) {
    $subnet = &convert_dec_to_base($i, 2, $nbits - 1);
    print "\t", &compute_subnet_number($subnet), "\n";
  }
}


			#################
			### MAIN CODE ###
			#################


					# process cmd line args into vars
while ($#ARGV >= 0) {
  $arg = shift @ARGV;			# behead zeroth argument

  if ($arg =~ /^-a$/) {			# user specified an IP address?
    $ipaddr = shift @ARGV;
    die("VLSM: '$ipaddr' is not a valid IP address!") unless &is_ip($ipaddr);
    next;
  }

  if ($arg =~ /^-h$/) {			# user wants help?
    &Usage;
  }

  if ($arg =~ /^-l$/) {			# user specified a mask length?
    $mask_length = shift @ARGV;
    next;
  }

  if ($arg =~ /^-m$/) {			# user specified a mask?
    $mask = shift @ARGV;
    die("VLSM: '$mask' is not a valid network mask!") unless &is_ip($mask);
    $mask_set = $true;
    next;
  }

  if ($arg =~ /^-s$/) {			# user requested all subnets?
    $subnets_set = $true;
    next;
  }

  print "\nVLSM: '$arg' is an unknown flag.\n\n";
  &Usage;
}

					# compute results

if ($mask_set) {			# grant mask precedence over length
  &compute_length;
}
else {
  &compute_mask;
}

&compute_netaddr;
&compute_class;
&compute_subnets_hosts;

					# display results

print "\nInput:\n";

printf("\t%-30s%s\n", "IP Address:", $ipaddr);
printf("\t%-30s%s\n", "Network Mask:", $mask);
printf("\t%-30s%s\n", "Mask Length:", $mask_length);

print "Output:\n";

printf("\t%-30s%s\n", "Network Address:", $netaddr);
printf("\t%-30s%s\n", "Class $addrclass Subnets:", $subnets);
printf("\t%-30s%s\n", "Class $addrclass Hosts:", $hosts);

&print_subnets if $subnets_set;