#!/apps/gnu/perl/5.006/bin/perl
#
# @(#)IpWatchdog.pl	1.11 [05/31/00 - 18:06:07]
#
# author: ron dilley
#
# desc: this perl script monitors segments looking for unused ip addresses
#
# Copyright (C) 2000  Ron A. Dilley
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; version 2
# of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
# ron.dilley@uberadmin.com
#
############################################################################

#
# modules
#
use Getopt::Std;
use Socket;
use Net::Ping;
use Fcntl;

#
# requires
#
require 5.006;

#
# pragmas
#
use strict;

#
# set environment
#
$ENV{PATH} = "/usr/bin:/bin:/usr/sbin:/sbin:/usr/ucb";

#
# turn on autoflush
#
select STDERR; $|;
select STDOUT; $|;

#
# defines
#
$::TRUE = 1;
$::FALSE = 0;
$::FAILED = -1;

$::VERSION = "1.11";
$::PROGNAME = "IpWatchdog.pl";

$::HOSTS_PACK = "a50a50L";
$::ADDR_PACK = "LLL "; # int_addr, time, status

%::Config = ();
$::Config{'debug'} = $::FALSE;
$::Config{'status_file'} = "/var/tmp/ipwatcher.status.tmp";
$::Config{'now'} = time();
$::Config{'terminate'} = $::FALSE;
$::Config{'report'} = $::FALSE;
$::Config{'utilization'} = $::FALSE;
$::Config{'rec_size'} = length( pack( $::ADDR_PACK, 0, 0, 0 ) );

@::subnets = ();

@::hosts = ();
%::hosts_index = ();

#
# main routine
#
if ( &main() != $::TRUE ) {
  exit( 1 );
}

exit( 0 );

############################################################################
#
# sub-routines
#

#
# main routine
#
sub main {
  my $arg;
  my $i;

  #
  # display script banner
  #
  &show_banner();

  #
  # parse command-line
  #
  if ( &parse_command_line() != $::TRUE ) {
    return $::FAILED;
  }

  if ( $::Config{'status'} != $::TRUE && $::Config{'report'} != $::TRUE && $::Config{'utilization'} != $::TRUE ) {
    #
    # test for uid-0
    #
    if ( $> != 0 ) {
      print "ERROR[$$] - Must be root to run this script\n";
      return $::FAILED;
    }

    #
    # create icmp ping object
    #
    $::icmp = Net::Ping->new( "icmp" );
    if ( ! defined $::icmp ) {
      print "ERROR[$$] - Unable to use icmp\n";
      return $::FAILED;
    }
  }

  #
  # turn on signal handlers
  #
  &set_signal_handlers( $::TRUE );

  #
  # if status option selected, display current status of all known addresses
  #
  if ( defined $::Config{'status'} ) {
    if ( sysopen( $::Config{'db_fh'}, $::Config{'status_file'}, O_RDWR ) != $::TRUE ) {
      print "ERROR[$$] - Unable to open [$::Config{'status_file'}] in RO mode\n";
      return $::FAILED;
    }
    if ( &show_current_status() != $::TRUE ) {
      return $::FAILED;
    }
    close( $::Config{'db_fh'} );
    # done
    return $::TRUE;
  } else {
    if ( sysopen( $::Config{'db_fh'}, $::Config{'status_file'}, O_CREAT|O_RDWR, 0664 ) != $::TRUE ) {
      print "ERROR[$$] - Unable to open [$::Config{'status_file'}] in RW mode\n";
      return $::FAILED;
    }
    chmod( $::Config{'status_file'}, 664 );
    chown( -1, 1000, $::Config{'status_file'} );
  }

  #
  # if subnet file defined, load it
  #
  if ( defined $::Config{'subnet_file'} ) {
    if ( &load_subnet_file() != $::TRUE ) {
      print "ERROR[$$] - Unable to load subnets from [$::Config{'subnet_file'}]\n";
    }
  }

  # add what is left of the command line to the subnet list
  push( @::subnets, @::ARGV );

  # if we are generating reports
  if ( $::Config{'report'} == $::TRUE || $::Config{'utilization'} == $::TRUE ) {
    # load hosts table
    if ( &load_hosts_table() != $::TRUE ) {
      return $::FAILED;
    }
    # process args in current order
    while( $arg = shift( @::subnets ) ) {
      if ( $::Config{'terminate'} == $::TRUE ) {
	return $::FALSE;
      }
      ( $::Config{'int_addr'}, $::Config{'int_mask'}, $::Config{'start_int_addr'}, $::Config{'stop_int_addr'} ) = &get_start_and_stop_int( $arg );
      if ( $::Config{'report'} ) {
	# generate detailed segment report
	if ( &show_segment_usage() != $::TRUE ) {
	  return $::FAILED;
	}
      } elsif ( $::Config{'utilization'} ) {
	# generate utilization summary report
	if ( &show_segment_utilization() != $::TRUE ) {
	  return $::FAILED;
	}
      }
    }
  } else {
    # process args in random order
    while( @::subnets > 0 ) {
      if ( $::Config{'terminate'} == $::TRUE ) {
	return $::FALSE;
      }
      if ( scalar @::subnets > 1 ) {
	$i = int( rand( scalar @::subnets ) );
	$arg = splice( @::subnets, $i - 1, 1 );
      } else {
	$arg = pop( @::subnets );
      }
      ( $::Config{'int_addr'}, $::Config{'int_mask'}, $::Config{'start_int_addr'}, $::Config{'stop_int_addr'} ) = &get_start_and_stop_int( $arg );
      # scan subnets
      if ( &inventory_segment( $arg ) == $::FAILED ) {
	return $::FAILED;
      }
    } 
  }

  # close the database
  close( $::Config{'db_fh'} );

  # done
  return $::TRUE;
}

#
# display banner info
#
sub show_banner {
  print "$::PROGNAME v$::VERSION\n";
  print "By: Ron Dilley\n";
  print "\n";
  print "$::PROGNAME comes with ABSOLUTELY NO WARRANTY.\n";
  print "This is free software, and you are welcome\n";
  print "to redistribute it under certain conditions;\n";
  print "See the GNU General Public License for details.\n";
  print "\n";

  return $::TRUE;
}

#
# display help info
#
sub show_help {
  print "Syntax:\n";
  print "\n";
  print "$::PROGNAME [options] {subnet} [[{subnet}] ...]\n";
  print "\n";
  print "{subnet}   In the form x.x.x.x or x.x.x.x/bits or x.x.x.x:y.y.y.y\n";
  print "           10.0.0.0 or 10.*.*.* or 10. Implied 8-bit mask\n";
  print "           172.16.0.0  or 172.16.*.* or 172.16. Implied 16-bit mask\n";
  print "           192.168.1.0 or 192.168.1.* or 192.168. Implied 24-bit mask\n";
  print "           Use x.x.x.x/24 or x.x.x.x:255.255.255.0 to override netmask\n";
  print "-d {0-9}   Display debug information during program run\n";
  print "-f {file}  Name of file containing subnets to scan\n";
  print "-r         Enable usage report generation\n";
  print "-u         Enable utilization summary report generation\n";
  print "-s         Display current IP address status (no polling)\n";
  print "\n";

  return $::TRUE;
}

#
# parse command-line arguments
#
sub parse_command_line {
  no strict 'vars';

  if ( getopts( 'd:rsuf:' ) == $::FALSE ) {
    &show_help();
    return $::FAILED;
  }
  if ( defined $opt_d ) {
    if ( $opt_d > 0 ) {
      # set debug mode
      $::Config{'debug'} = $opt_d;
    }
  }
  if ( defined $opt_r ) {
    if ( $opt_r > 0 ) {
      # enable report mode
      $::Config{'report'} = $opt_r;
    }
  }
  if ( defined $opt_s ) {
    if ( $opt_s > 0 ) {
      # enable report mode
      $::Config{'status'} = $opt_s;
    }
  }
  if ( defined $opt_u ) {
    if ( $opt_u > 0 ) {
      # enable util summary mode
      $::Config{'utilization'} = $opt_u;
    }
  }
  if ( defined $opt_f ) {
    if ( -f $opt_f ) {
      # read subnets from file
      $::Config{'subnet_file'} = $opt_f;
    } else {
      print "ERROR[$$] - [$opt_f] not found\n";
    }
  }  
  return $::TRUE;
}

#
# load subnet file
#
sub load_subnet_file {
  my $line;

  if ( $::Config{'debug'} >=3 ) {
    print "DEBUG[$$] - Loading subnets from [$::Config{'subnet_file'}]\n";
  }

  if ( open( SUBNET, $::Config{'subnet_file'} ) != $::TRUE ) {
    print "ERROR[$$] - Unable to open [$::Config{'subnet_file'}]\n";
    return $::FAILED;
  }

  while( $line = <SUBNET> ) {
    if ( $::Config{'terminate'} == $::TRUE ) {
      return $::FALSE;
    }
    chomp( $line );
    if ( $::Config{'debug'} >= 5 ) {
      print "DEBUG[$$] - Loaded [$line]\n";
    }
    push( @::subnets, $line );
  }

  close( SUBNET );

  return $::TRUE;
}

#
# inventory a segment
#
sub inventory_segment {
  my ( $segment ) = @_;

  my $i;
  my $search_segment;
  my $timeout = 1;
  my $hour;
  my $min;
  my $sec;
  my $mon;
  my $mday;
  my $year;
  my $status;

  # search entire segment for ip addresses
  for( $i = $::Config{'start_int_addr'} + 1; $i < $::Config{'stop_int_addr'}; $i++ ) {
    if ( $::Config{'terminate'} == $::TRUE ) {
      return $::FALSE;
    }
    # scan ip address
    if ( $::icmp->ping( &int_to_ipv4( $i ), 1 ) ) {
      # device located at address
      if ( $::Config{'debug'} >= 5 ) {
	printf( "DEBUG[$$] - %s is alive\n", &int_to_ipv4( $i ) );
      }
      $status = $::TRUE; # 1 = alive, 0 = dead
    } else {
      # no device located at address
      if ( $::Config{'debug'} >= 5 ) {
	printf( "DEBUG[$$] - No response from %s\n", &int_to_ipv4( $i ) );
      }
      $status = $::FALSE;
    }
    if ( &update_addr_record( $i, time(), $status ) == $::FAILED ) {
      print "ERROR[$$] - Unable to insert record\n";
    }
  }

  return $::TRUE;
}

#
# generate usage report
#
sub show_segment_usage {
  my $i;
  my $x;
  my $hour;
  my $min;
  my $sec;
  my $mon;
  my $mday;
  my $year;
  my $int_addr;
  my $name;
  my $cname;
  my $index;
  my $time;
  my $status;

  # lock database
  &lock( $::Config{'db_fh'}, 0, 0 );

  print "Segment usage report for " . &int_to_ipv4( $::Config{'int_addr'} ) . ":" . &int_to_ipv4( $::Config{'int_mask'} ) . "\n";
  ( $sec, $min, $hour, $mday, $mon, $year ) = ( localtime() )[0,1,2,3,4,5];
  printf( "Created at %02d:%02d:%02d on %02d/%02d/%04d\n", $hour, $min, $sec, $mon + 1, $mday, $year + 1900 );
  &multi_print( "=", 60 );

  # search entire segment for ip addresses
  for( $i = $::Config{'start_int_addr'} + 1; $i < $::Config{'stop_int_addr'}; $i++ ) {
    if ( $::Config{'terminate'} == $::TRUE ) {
      return $::FALSE;
    }
    printf( "%s ", &int_to_ipv4( $i ) );

    $index = &find_addr_record( $i );
    if ( $::Config{'debug'} >= 5 ) {
      print "DEBUG[$$] - Find for [$i] returned [$index]\n";
    }
    ( $int_addr, $time, $status ) = unpack( $::ADDR_PACK, &db_read_record( $index ) );
    if ( $index < &db_length() && $i == $int_addr ) {
      # found it
    } else {
      # not there, insert
      if ( $::Config{'debug'} >= 4 ) {
	printf ( "DEBUG[$$] - No addr record for [%s]\n", &int_to_ipv4( $i ) );
      }
      print "no record\n";
      next;
    }

    if ( $status == $::FALSE ) {
      ( $sec, $min, $hour, $mday, $mon, $year ) = ( localtime( $time ) )[0,1,2,3,4,5];
      printf( "no response since %02d:%02d:%02d on %02d/%02d/%04d\n", $hour, $min, $sec, $mon + 1, $mday, $year + 1900 );
    } else {
      print "is alive\n";
    }

    if ( defined $::hosts_index{$i} ) {
      for ( $x = $::hosts_index{$i}; $i == ( unpack( $::HOSTS_PACK, $::hosts[$x] ) )[2]; $x++ ) {
	( $cname, $name, $int_addr ) = unpack( $::HOSTS_PACK, $::hosts[$x] );
	print "$name\n";
      }
    }
    &multi_print( '-', 56 );
  }

  # unlock database
  &unlock( $::Config{'db_fh'}, 0, 0 );

  return $::TRUE;
}

#
# generate utilization report
#
sub show_segment_utilization {
  my $i;
  my $x;
  my $hour;
  my $min;
  my $sec;
  my $mon;
  my $mday;
  my $year;
  my $int_addr;
  my $name;
  my $cname;
  my $counter = 0;
  my $alive;
  my $static;
  my $allocated;
  my $static_alive = 0;
  my $static_count = 0;
  my $static_allocated = 0;
  my $dynamic_alive = 0;
  my $dynamic_count = 0;
  my $index;
  my $tmp_addr;
  my $time;
  my $status;

  # lock database
  &lock( $::Config{'db_fh'}, 0, 0 );

  print "Segment usage summary report for " . &int_to_ipv4( $::Config{'int_addr'} ) . ":" . &int_to_ipv4( $::Config{'int_mask'} ) . "\n";
  ( $sec, $min, $hour, $mday, $mon, $year ) = ( localtime() )[0,1,2,3,4,5];
  printf( "Created at %02d:%02d:%02d on %02d/%02d/%04d\n", $hour, $min, $sec, $mon + 1, $mday, $year + 1900 );
  &multi_print( "=", 60 );

  # search entire segment for ip addresses
  for( $i = $::Config{'start_int_addr'} + 1; $i < $::Config{'stop_int_addr'}; $i++ ) {
    if ( $::Config{'terminate'} == $::TRUE ) {
      return $::FALSE;
    }

    # increment addr counter
    $counter++;

    $index = &find_addr_record( $i );
    ( $int_addr, $time, $status ) = unpack( $::ADDR_PACK, &db_read_record( $index ) );
    if ( $index < &db_length() && $i == $int_addr ) {
      # found it
      $alive = $status;
    } else {
      # not there, insert
      if ( $::Config{'debug'} >= 4 ) {
	printf ( "DEBUG[$$] - No addr record for [%s]\n", &int_to_ipv4( $int_addr ) );
      }
      next;
    }

    if ( defined $::hosts_index{$i} ) {
      # name associated with addr
      for ( $x = $::hosts_index{$i}; $i == ( unpack( $::HOSTS_PACK, $::hosts[$x] ) )[2]; $x++ ) {
	( $cname, $name, $int_addr ) = unpack( $::HOSTS_PACK, $::hosts[$x] );
	if ( $cname =~ m/^dhcp\d+\-\d+/ ) {
	  # dhcp address
	  $static = $::FALSE;
	} else {
	  # static address
	  $static = $::TRUE;
	  $allocated = $::TRUE;
	}
      }
    } else {
      # static address
      $static = $::TRUE;
      $allocated = $::FALSE;
    }

    if ( $static & $allocated ) {
      # static address that has been allocated
      $static_allocated++;
    }

    if ( $static & $alive ) {
      # static address that is alive
      $static_alive++;
      $static_count++;
    } elsif ( $alive ) {
      # dynamic address that is alive
      $dynamic_alive++;
      $dynamic_count++;
    } elsif ( $static ) {
      # static address that is dead
      $static_count++;
    } else {
      # dynamic address that is dead
      $dynamic_count++;
    }
  }

  print "\n";
  print "Total usable address space: $counter\n";
  &multi_print( "-", 38 );
  if ( $static_count > 0 ) {
    printf ( "    Total static space: %3i (%1.2f%%)\n", $static_count, ( $static_count / $counter ) * "100" );
    printf ( "Allocated static space: %3i (%1.2f%%)\n", $static_allocated, ( $static_allocated / $static_count ) * "100" );
    printf ( "   Active static space: %3i (%1.2f%%)\n", $static_alive, ( $static_alive / $static_count ) * "100" );
  }
  if ( $dynamic_count > 0 ) {
    printf ( "   Total dynamic space: %3i (%1.2f%%)\n", $dynamic_count, ( $dynamic_count / $counter ) * "100" );
    printf ( "  Active dynamic space: %3i (%1.2f%%)\n", $dynamic_alive, ( $dynamic_alive / $dynamic_count ) * "100" );
  }
  print "\n";

  # unlock database
  &unlock( $::Config{'db_fh'}, 0, 0 );

  return $::TRUE;
}

#
# print separator
#
sub multi_print {
  my ( $char, $count ) = @_;

  while ( $count-- ) {
    print $char;
  }

  print "\n";
}

#
# get start and end address
#
sub get_start_and_stop_int {
  my ( $segment ) = @_;

  my $seg_addr;
  my $seg_mask;
  my $bit_mask;
  my $int_seg_addr;
  my $int_seg_mask;
  my $low_int;
  my $high_int;

  # get subnet mask
  if ( $segment =~ m/^(\d{1,3})(.*)\/(\d+)$/ ) {
    # bit mask
    $seg_addr = $1 . $2;
    if ( $1 >= 1 && $1 <= 126 ) {
      # class a
      $seg_mask = "255.0.0.0";
    } elsif ( $1 >= 128 & $1 <= 191 ) {
      # class b
      $seg_mask = "255.255.0.0";
    } elsif ( $1 >= 192 & $1 <= 223 ) {
      # class c
      $seg_mask = "255.255.255.0";
    } elsif ( $1 >= 224 & $1 <= 239 ) {
      # class d (multicast)
      print "ERROR[$$] - [$segment] is a class-d address\n";
      return $::FAILED;
    } else {
      # class e (research)
      print "ERROR[$$] - [$segment] is a class-e address\n";
      return $::FAILED;
    }
    $seg_mask = &bitmask_to_ipv4( $3 );
  } elsif ( $segment =~ m/^(\d{1,3})(.*)\:(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ ) {
    # fully qualified subnet mask
    $seg_addr = $1 . $2;
    $seg_mask = $3;
  } elsif ( $segment =~ m/^(\d{1,3})(.*)$/ ) {
    # default subnet mask
    $seg_addr = $1 . $2;
    if ( $1 >= 1 && $1 <= 126 ) {
      # class a
      $seg_mask = "255.0.0.0";
    } elsif ( $1 >= 128 & $1 <= 191 ) {
      # class b
      $seg_mask = "255.255.0.0";
    } elsif ( $1 >= 192 & $1 <= 223 ) {
      # class c
      $seg_mask = "255.255.255.0";
    } elsif ( $1 >= 224 & $1 <= 239 ) {
      # class d (multicast)
      print "ERROR[$$] - [$segment] is a class-d address\n";
      return $::FAILED;
    } else {
      # class e (research)
      print "ERROR[$$] - [$segment] is a class-e address\n";
      return $::FAILED;
    }
  } else {
    print "ERROR[$$] - [$segment] is indecypherable\n";
    return $::FAILED;
  }

  # deal with partial addresses
  if ( $seg_addr =~ m/^(\d{1,3})\.$/ ) { # x.
    $seg_addr = "$1.0.0.0";
    $seg_mask = "255.0.0.0";
  } elsif ( $seg_addr =~ m/^(\d{1,3})\.(\d{1,3})\.$/ ) { # x.x.
    $seg_addr = "$1.$2.0.0";
    $seg_mask = "255.255.0.0";
  } elsif ( $seg_addr =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.$/ ) { # x.x.x.
    $seg_addr = "$1.$2.$3.0";
    $seg_mask = "255.255.255.0";
  } elsif ( $seg_addr =~ m/^(\d{1,3})\.\*\.\*\.\*$/ ) { # x.*.*.*
    $seg_addr = "$1.0.0.0";
    $seg_mask = "255.0.0.0";
  } elsif ( $seg_addr =~ m/^(\d{1,3})\.(\d{1,3})\.\*\.\*$/ ) { # x.x.*.*
    $seg_addr = "$1.$2.0.0";
    $seg_mask = "255.255.0.0";
  } elsif ( $seg_addr =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.\*$/ ) { # x.x.x.*
    $seg_addr = "$1.$2.$3.0";
    $seg_mask = "255.255.255.0";
  }

  if ( $::Config{'debug'} >= 8 ) {
    print "DEBUG[$$] - [$seg_addr] [$seg_mask]\n";
  }

  $int_seg_addr = &ipv4_to_int( $seg_addr );
  $int_seg_mask = &ipv4_to_int( $seg_mask );

  $low_int = $int_seg_addr;
  $high_int = ( $int_seg_mask ^ 0xffffffff ) + $low_int;

  if ( $::Config{'debug'} >= 7 ) {
    printf( "DEBUG[$$] - [%s - %s]\n", &int_to_ipv4( $low_int ), &int_to_ipv4( $high_int ) );
  }

  return ( $int_seg_addr, $int_seg_mask, $low_int, $high_int );
}

#
# load hosts table
#
sub load_hosts_table {
  my $line;
  my $cname;
  my $name;
  my $addr;
  my $int_addr;
  my $i;
  my $start_time;
  my $stop_time;

  $start_time = time();

  if ( $::Config{'debug'} >= 3 ) {
    print "DEBUG[$$] - Loading hosts.org_dir\n";
  }

  if ( open( HOSTS, "niscat -M hosts.org_dir |" ) == $::TRUE ) {
    print "ERROR[$$] - Unable to load hosts table\n";
    return $::FAILED;
  }

  while( $line = <HOSTS> ) {
    chomp( $line );
    ( $cname, $name, $addr ) = ( split( /\s/, $line ) )[0,1,2];
    $int_addr = ipv4_to_int( $addr );
    push( @::hosts, pack( $::HOSTS_PACK, $cname, $name, $int_addr ) );
    if ( $::Config{'debug'} >= 9 ) {
      print "DEBUG[$$] - [$line]\n";
    }
  }

  close( HOSTS );

  #
  # sort host list
  #
  @::hosts = sort hosts_by_intaddr ( @::hosts );

  #
  # build index
  #
  if ( $::Config{'debug'} >= 3 ) {
    print "DEBUG[$$] - Building host index\n";
  }
  for( $i = ( @::hosts - 1 ); $i >= 0; $i-- ) {
    ( $cname, $name, $int_addr ) = unpack( $::HOSTS_PACK, $::hosts[$i] );
    $::hosts_index{$int_addr} = $i;
    if ( $::Config{'debug'} >= 8 ) {
      print "DEBUG[$$] - Index [$int_addr $::hosts_index{$int_addr}]\n";
    }
  }

  if ( $::Config{'debug'} >= 7 ) {
    print "DEBUG[$$] - Loaded " . @::hosts . " record(s)\n";
  }

  $stop_time = time();

  if ( $::Config{'debug'} >= 7 ) {
    print "DEBUG[$$] - Load took " . ( $stop_time - $start_time ) . " second(s)\n";
  }

  return $::TRUE;
}

#
# sort hosts by int_addr
#
sub hosts_by_intaddr {
  return ( unpack( $::HOSTS_PACK, $a ) )[2] <=> ( unpack( $::HOSTS_PACK, $b ) )[2];
}

#
# display status info for all known addresses
#
sub show_current_status {
  my $i;
  my $int_addr;
  my $time;
  my $status;
  my $hour;
  my $min;
  my $sec;
  my $mon;
  my $mday;
  my $year;

  # lock database
  &lock( $::Config{'db_fh'}, 0, 0 );

  print "Current status of non-responsive IP addresses\n";
  &multi_print( "-", 56 );

  for ( $i = 0; $i < &db_length(); $i++ ) {
    if ( $::Config{'terminate'} == $::TRUE ) {
      return $::FALSE;
    }
    ( $int_addr, $time, $status ) = unpack( $::ADDR_PACK, &db_read_record( $i ) );
    ( $sec, $min, $hour, $mday, $mon, $year ) = ( localtime( $time ) )[0,1,2,3,4,5];
    if ( $status != $::TRUE ) {
      printf( "INFO[$$] - No response from %s", &int_to_ipv4( $int_addr ) );
      printf( " since %02d:%02d:%02d on %02d/%02d/%04d\n", $hour, $min, $sec, $mon + 1, $mday, $year + 1900 );
    } else {
      printf( "INFO[$$] - %s is alive", &int_to_ipv4( $int_addr ) );
      printf( " since %02d:%02d:%02d on %02d/%02d/%04d\n", $hour, $min, $sec, $mon + 1, $mday, $year + 1900 );
    }
  }

  # unlock database
  &unlock( $::Config{'db_fh'}, 0, 0 );

  return $::TRUE;
}

########################################
#
# signal functions
#
########################################

#
# set signal handlers
#
sub set_signal_handlers {
  my ( $command ) = @_;

  if ( $command == $::TRUE ) {
    $::SIG{HUP} = 'signal_handler';
    $::SIG{TERM} = 'signal_handler';
    $::SIG{QUIT} = 'signal_handler';
    $::SIG{INT} = 'signal_handler';

    if ( $::Config{'debug'} >= 4 ) {
      print "DEBUG[$$] - Customizing signal handlers\n";
    }
  } else {
    $::SIG{HUP} = 'DEFAULT';
    $::SIG{TERM} = 'DEFAULT';
    $::SIG{QUIT} = 'DEFAULT';
    $::SIG{INT} = 'DEFAULT';

    if ( $::Config{'debug'} >= 4 ) {
      print "DEBUG[$$] - Returning signal handlers to default\n";
    }
  }

  return $::TRUE;
}

#
# signal handler
#
sub signal_handler {
  my ( $sig ) = @_;

  if ( $::Config{'debug'} >= 6 ) {
    print "DEBUG[$$] - Caught a Sig$sig\n";
  }

  if ( $sig eq 'HUP' || $sig eq 'TERM' || $sig eq 'QUIT' || $sig eq 'INT' ) {
    $::Config{'terminate'} = $::TRUE;
  }

  return $::FALSE;
}

#
# sort numbericaly
#
sub by_number {
  return $a <=> $b;
}

#
# search for numeric element in array using binary search
#
sub find_addr_record {
  my ( $int_addr ) = @_;

  my $tmp_int_addr;
  my $tmp_time;
  my $tmp_status;

  if ( $::Config{'debug'} >= 5 ) {
    print "DEBUG[$$] - Finding [$int_addr] using binary search\n";
  }

  # $low is first element that is not too low
  # $high is the first that is too high
  my ( $low, $high ) = ( 0, &db_length() );

  # keep trying as long as there are elements that might work

  while ( $low < $high ) {
    # try the middle element    
    use integer;
    my $cur = ( ( $high - $low ) / 2 ) + $low;
    if ( $::Config{'debug'} >= 6 ) {
      print "DEBUG[$$] - low: $low high: $high cur: $cur\n";
    }
    if ( $cur < &db_length() ) {
      ( $tmp_int_addr, $tmp_time, $tmp_status ) = unpack( $::ADDR_PACK, &db_read_record( $cur ) );
      if ( $tmp_int_addr < $int_addr ) {
	$low = $cur + 1;
      } elsif ( $tmp_int_addr > $int_addr ) {
	$high = $cur;
      } else {
	return $cur;
      }
    } else {
      return $cur;
    }
  }

  return $low;
}

#
# search for numeric element in array using proportional search
#
sub new_find_addr_record {
  my ( $int_addr ) = @_;

  my $tmp_int_addr;
  my $tmp_time;
  my $tmp_status;

  if ( $::Config{'debug'} >= 5 ) {
    print "DEBUG[$$] - Finding [$int_addr] using proportional search\n";
  }

  # set starting values
  my ( $low, $high ) = ( 0, &db_length() );

  # new record goes first
  ( $tmp_int_addr, $tmp_time, $tmp_status ) = &db_read_record( 0 );
  if ( $high == -1 || $tmp_int_addr >= $int_addr ) {
    return 0;
  }

  # new record goes last
  ( $tmp_int_addr, $tmp_time, $tmp_status ) = &db_read_record( $high - 1 );
  if ( $tmp_int_addr < $int_addr ) {
    return --$high;
  }



}

#
# update/insert element in array
#
sub update_addr_record {
  my ( $int_addr, $time, $status ) = @_;

  my $addr;
  my $tmp_int_addr;
  my $tmp_addr;
  my $tmp_time;
  my $tmp_status;
  my $i;

  if ( $::Config{'debug'} >= 6 ) {
    print "DEBUG[$$] - [$int_addr, $time, $status]\n";
  }

  my $target = pack( $::ADDR_PACK, $int_addr, $time, $status );

  # lock the database while we go looking for the record
  &lock( $::Config{'db_fh'}, 0, 0 );

  my $index = &find_addr_record( $int_addr );

  if ( $::Config{'debug'} >= 5 ) {
    print "DEBUG[$$] - find for [$int_addr] returned [$index]\n";
  }

  ( $tmp_int_addr, $tmp_time, $tmp_status ) = unpack( $::ADDR_PACK, &db_read_record( $index ) );
  if ( $::Config{'debug'} >= 6 ) {
    print "DEBUG[$$] - [$tmp_int_addr, $tmp_time, $tmp_status]\n";
  }  
  if ( $int_addr == $tmp_int_addr ) {
    # found it
    if ( $status != $tmp_status ) {
      if ( $::Config{'debug'} >= 5 ) {
	print "DEBUG[$$] - Updating [$int_addr] at [$index]\n";
      }
      &db_write_record( $index, $target );
    } else {
      if ( $::Config{'debug'} >= 4 ) {
	print "DEBUG[$$] - Status has not changed\n";
      }
    }
  } else {
    # not there, insert
    if ( $::Config{'debug'} >= 5 ) {
      print "DEBUG[$$] - Inserting record at [$index]\n";
    } 
    &db_insert_record( $index, $target );
  }

  if ( $::Config{'debug'} >= 5 ) {
    printf( "DEBUG[$$] - DB size [%d]\n", &db_length() );
  }

  # unlock the database, we are done
  &unlock( $::Config{'db_fh'}, 0, 0 );

  return $index;
}

#
# delete element from array
#
sub delete_addr_record {
  my ( $int_addr ) = @_;

  my $target;
  my $tmp_int_addr;
  my $tmp_time;
  my $tmp_status;
  my $index = &find_addr_record( $int_addr );

  ( $tmp_int_addr, $tmp_time, $tmp_status ) = unpack( $::ADDR_PACK, $::address_records[$index] );
  if ( $int_addr == $tmp_int_addr ) {
    # found it, delete it
    if ( $::Config{'debug'} >= 5 ) {
      print "DEBUG[$$] - Deleting [$int_addr]\n";
    }
    $target = $::address_records[$index];
 } else {
    # not there
    return; # undef
  }

  return $target;
}

#
# get size of db file (in records)
#
sub db_length {
  seek( $::Config{'db_fh'}, 0, 2 );
  return ( tell( $::Config{'db_fh'} ) / $::Config{'rec_size'} );
}

#
# read a record
#
sub db_read_record {
  my ( $index ) = @_;

  my $buf;
  my $offset;
  my $count;

  if ( $index >= &db_length() ) {
    if ( $::Config{'debug'} >= 3 ) {
      print "DEBUG[$$] - Attempt to read past EOF\n";
    }
    return; # undef
  }

  $offset = $index * $::Config{'rec_size'};

  seek( $::Config{'db_fh'}, $offset, 0 );
  if ( ! defined ( $count = sysread( $::Config{'db_fh'}, $buf, $::Config{'rec_size'} ) ) ) {
    print "ERROR[$$] - Unable to read record at [$index] ($offset)\n";
    return; # undef
  }

  if ( $count != $::Config{'rec_size'} ) {
    print "ERROR[$$] - Read [$count] bytes, expected [$::Config{'rec_size'}]\n";
    return; # undef
  }

  return $buf;
}

#
# write (update a record)
#
sub db_write_record {
  my ( $index, $buf ) = @_;

  my $offset;
  my $count;

  if ( $index >= &db_length() ) {
    if ( $::Config{'debug'} >= 3 ) {
      print "DEBUG[$$] - Write past EOF\n";
    }
  }

  $offset = $index * $::Config{'rec_size'};

  seek( $::Config{'db_fh'}, $offset, 0 );
  if ( ! defined ( $count = syswrite( $::Config{'db_fh'}, $buf, $::Config{'rec_size'} ) ) ) {
    print "ERROR[$$] - Unable to write record at [$index] ($offset)\n";
    return; # undef
  }

  if ( $count != $::Config{'rec_size'} ) {
    print "ERROR[$$] - Wrote [$count] bytes, expected [" . $::Config{'rec_size'} ."]\n";
    return; # undef
  }

  return $offset / $::Config{'rec_size'};
}

#
# insert a record
#
sub db_insert_record {
  my ( $index, $buf ) = @_;

  my $i;

  # lock from index to eof
  
  # shift everything down by one (wish splice would work)
  for( $i = &db_length(); $i > $index; $i-- ) {
    if ( $::Config{'debug'} >= 8 ) {
      print "DEBUG[$$] - Moving [" . ( $i - 1 ) . "] to [$i]\n";
    }
    &db_write_record( $i, &db_read_record( $i - 1 ) );
  }
  
  # add new entry
  &db_write_record( $index, $buf );

  return $::TRUE;
}

#
# remove a record
#
sub db_delete_record {

}

# SOF - [/home/amgen/rdilley/Projects/Perl/Modules/SCCS/s.ip_conversion.pl]

# @(#)ip_conversion.pl	1.1 [05/05/00 - 15:04:56]
#
#  author: ron dilley
#    desc: the following functions allow conversion to/from ipv4 addresses
#
############################################################################

#
#    desc: convert ipv4 addr to int
#    type: function
#    args: ipv4 address
# returns: int on no error, $::FAILED on error
#   notes: none
#
############################################################################

sub ipv4_to_int {
  my ( $addr ) = @_;

  if ( $addr =~ m/(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/ ) {
    return ( ( $1 << 24 ) & 0xff000000 ) + ( ( $2 << 16 ) & 0x00ff0000 ) + ( ( $3 << 8 ) & 0x0000ff00 ) + ( $4 & 0x000000ff );
  }

  # not an ipv4 addr
  return $::FAILED;
}

#
#    desc: convert int to ipv4 addr
#    type: function
#    args: int
# returns: ipv4 address on no error, $::FAILED on error
#   notes: none
#
############################################################################

sub int_to_ipv4 {
  my ( $int_addr ) = @_;

  my @addr = ();

  $addr[0] = ( $int_addr >> 24 ) & 0x000000ff;
  $addr[1] = ( $int_addr >> 16 ) & 0x000000ff;
  $addr[2] = ( $int_addr >> 8 ) & 0x000000ff;
  $addr[3] = $int_addr & 0x000000ff;

  return "$addr[0].$addr[1].$addr[2].$addr[3]";
}

#
#    desc: convert bitmask to ipv4 addr       
#    type: function
#    args: bitmask (int)
# returns: ipv4 address on no error, $::FAILED on error
#   notes: (count bits from left to right for netmasks)
#
############################################################################

sub bitmask_to_ipv4 {
  my ( $bit_mask ) = @_;

  return int_to_ipv4( &bitmask_to_int( $bit_mask ) );
}

#
#    desc: convert ipv4 addr to bitmask     
#    type: function
#    args: ipv4 address
# returns: bitmask (int) on no error, $::FAILED on error
#   notes: (count bits from left to right for netmasks)
#
############################################################################

sub ipv4_to_bitmask {
  my ( $netmask ) = @_;

  return &int_to_bitmask( &ipv4_to_int( $netmask ) );
}

#
#    desc: convert bitmask to int  
#    type: function
#    args: bitmask
# returns: int on no error, $::FAILED on error
#   notes: (count bits from left to right for netmasks)
#
############################################################################

sub bitmask_to_int {
  my ( $bit_mask ) = @_;

  my $i;
  my $mask = "";

  for( $i = 0; $i < 32; $i++ ) {
    if ( $bit_mask > $i ) {
      $mask = $mask . "1";
    } else {
      $mask = $mask . "0";
    }
  }

  return unpack( "N", pack( "B32", substr( "0" x 32 . $mask, -32 ) ) );
}

#
#    desc: convert int to bitmask 
#    type: function
#    args: int
# returns: bitmask (int) on no error, $::FAILED on error
#   notes: (count bits from left to right for netmasks)
#
############################################################################

sub int_to_bitmask {
  my ( $netmask ) = @_;

  my @mask;
  my $i;

  @mask = split( //, unpack( "B32", pack( "N", $netmask ) ) );

  for( $i = 0; $i < 32 && $mask[$i] == 1; $i++ ) {
    # count the bits until we hit a '0'
  }

  return $i;
}

# EOF - [/home/amgen/rdilley/Projects/Perl/Modules/SCCS/s.ip_conversion.pl]

# SOF - [/home/amgen/rdilley/Projects/Perl/Modules/SCCS/s.lockf.pl]

# @(#)lockf.pl	1.3 [05/26/00 - 17:50:25]
#
#  author: ron dilley
#    desc: the following functions allow access to fcntl record locking
#
############################################################################

#
# modules
#
use Fcntl;
use POSIX qw(:unistd_h :errno_h);

#
# pragmas
#
no strict 'subs';

#
#    desc: lock record(s)
#    type: function
#    args: filenandle, offset, length
# returns: $::TRUE on no error, $::FAILED on error
#   notes: Requires $::Config{'debug'} to enable/disable verbose messages
#
############################################################################

sub lock {
  my ( $fh, $offset, $length ) = @_;
  if ( $::Config{'debug'} >= 6 ) {
    print "DEBUG[$$] - Locking [$offset][$length]\n";
  }
  my $lock_struct = struct_flock( F_WRLCK, SEEK_SET, $offset, $length, 0 );
  my $blocker_pid = 0;
  unless ( fcntl( $fh, F_SETLK, $lock_struct ) ) {
    if ( $! != EAGAIN && $! != EDEADLK ) {
      die "F_SETLK $$ @_: $!";
    }
    fcntl( $fh, F_GETLK, $lock_struct ) or die "F_GETLK $$ @_: $!";
    $blocker_pid = ( struct_flock( $lock_struct ) )[-1];
    if ( $::Config{'debug'} >= 5 ) {
      print "DEBUG[$$] - Lock waiting for $blocker_pid\n";
    }
    $lock_struct = struct_flock( F_WRLCK, SEEK_SET, $offset, $length, 0 );
    unless ( fcntl( $fh, F_SETLKW, $lock_struct ) ) {
      warn "F_SETLKW $$ @_: $!\n";
      return; # undef
    }
  }
  return $blocker_pid;
}

#
#    desc: unlock record(s)
#    type: function
#    args: filenandle, offset, length
# returns: $::TRUE on no error, $::FAILED on error
#   notes: Requires $::Config{'debug'} to enable/disable verbose messages
#
############################################################################

sub unlock {
  my ( $fh, $offset, $length ) = @_;
  if ( $::Config{'debug'} >= 6 ) {
    print "DEBUG[$$] - UnLocking [$offset][$length]\n";
  }
  my $lock_struct = struct_flock( F_UNLCK, SEEK_SET, $offset, $length, 0 );
  fcntl( $fh, F_SETLK, $lock_struct ) or die "F_UNLCK $$ @_: $!";
}

#
# os specific flock structs
#

# linux struct flock

BEGIN {
  my $FLOCK_STRUCT = 's s l l i';
  sub linux_flock {
    if ( wantarray ) {
      my ( $type, $whence, $start, $len, $pid ) = unpack( $FLOCK_STRUCT, $_[0] );
      return ( $type, $$whence, $start, $len, $pid );
    } else {
      my ( $type, $whence, $start, $len, $pid ) = @_;
      return pack( $FLOCK_STRUCT, $type, $whence, $start, $len, $pid );
    }
  }
}

# sunos struct flock
# short l_type;
# short l_whence;
# short l_start;
# short l_len;
# short l_pid;
# short l_xxx;

BEGIN {
  my $FLOCK_STRUCT = 's s l l s s';
  sub sunos_flock {
    if ( wantarray ) {
      my ( $type, $whence, $start, $len, $pid, $xxx ) = unpack( $FLOCK_STRUCT, $_[0] );
      return ( $type, $whence, $start, $len, $pid );
    } else {
      my ( $type, $whence, $start, $len, $pid ) = @_;
      return pack( $FLOCK_STRUCT, $type, $whence, $start, $len, $pid, 0 );
    }
  }
}

# solaris struct flock
# typedef struct flock {
#        short   l_type;
#        short   l_whence;
#        off_t   l_start;
#        off_t   l_len;          /* len == 0 means until end of file */
#        int     l_sysid;
#        pid_t   l_pid;
#        long    l_pad[4];               /* reserve area */
# } flock_t;

BEGIN {
  my $FLOCK_STRUCT = 's s l l l l l l l l';
  sub solaris_flock {
    if ( wantarray ) {
      my ( $type, $whence, $start,$len, $sysid, $x, $xx, $xxx, $pid, @xxx ) = unpack( $FLOCK_STRUCT, $_[0] ); # why the order is wrong, who knows
      return ( $type, $whence, $start, $len, $pid );
    } else {
      my ( $type, $whence, $start, $len, $pid ) = @_;
      return pack( $FLOCK_STRUCT, $type, $whence, $start, $len, 0, $pid, 0, 0, 0, 0 );
    }
  }
}

# bsd struct flock

BEGIN {
  my $FLOCK_STRUCT = 'll ll i s s';
  sub bsd_flock {
    if ( wantarray ) {
      my ( $xxstart, $start, $xxlen, $len, $pid, $type, $whence ) = unpack( $FLOCK_STRUCT, $_[0] );
      return ( $type, $whence, $start, $len, $pid );
    } else {
      my ( $type, $whence, $start, $len, $pid ) = @_;
      my ( $xxstart, $xxlen ) = (0,0);
      return pack( $FLOCK_STRUCT, $xxstart, $start, $xxlen, $len, $pid, $type, $whence );
    }
  }
}

# alias the fcntl structure at compile time

BEGIN {
  if ( $^O =~ m/bsd/ ) {
    *struct_flock = \&bsd_flock;
  } elsif ( $^O =~ m/linux/ ) {
    *struct_flock = \&linux_flock;
  } elsif ( $^O =~ m/sunos/ ) {
    *struct_flock = \&sunos_flock;
  } elsif ( $^O =~ m/solaris/ ) {
    *struct_flock = \&solaris_flock;
  } else {
    die "unknown os $^O, bailing out";
  }
}

# EOF - [/home/amgen/rdilley/Projects/Perl/Modules/SCCS/s.lockf.pl]
