#!/opt/vdops/bin/perl

# This script automates gathering ping data during high-availibility testing

# V      Who       When        What
# ---------------------------------------------------------------------------
# 1.1.0  skendric  2010-02-01  Upgrade to perl 5.10.1
# 1.0.7  skendric  2009-09-16  Handle unresolvable names
# 1.0.6  skendric  2009-07-30  Resolve addresses but not names; don't sort
#                              if nodes listed in a file
# 1.0.5  skendric  2009-04-15  Swap comment and title fields
# 1.0.4  skendric  2009-03-22  Expand help message
# 1.0.3  skendric  2009-03-01  Check arguments more rigorously
# 1.0.2  skendric  2009-02-27  Remove dependency on Netops modules
# 1.0.1  skendric  2009-02-25  Add -c {command} command-line parameter
# 1.0.0  skendric  2009-02-11  First Version
#

# Author:  Stuart Kendrick, sbk {put at sign here} skendric {put dot here} com
#
# Source:  http://www.skendric.com/nmgmt
#
# This software is available under the GNU GENERAL PUBLIC LICENSE, see
# http://www.fsf.org/licenses/gpl.html
#

#
# This script takes the following approach:
#     -Accepts a list of targets (or reads a file containing said list)
#
#     -Pings those targets
#
#     -Produces a report describing missed pings
#
#
# Requirements:
#     -Must run as root
#
#
# Assumptions:
#
#
# Tested on:
#       -perl-5.12.2
#
#
# Instructions:
#    -Customize the script for your site:  find the 'user-configurable
#     variables' section and modify as appropriate
#    -Type "mass-ping" to see the options
#    -Try it out
#
#
#
# Caveats:
#
#
# Known Bugs:
#
#
# To do:
#

# Begin script

# Load modules
use v5.12.0;
use strict;
use warnings;
use feature 'say';
use feature 'switch';
use Carp qw(carp cluck croak confess);
use Contextual::Return;
use Data::Dump::Streamer;
use Data::Dumper;
use Data::Validate::IP qw(is_ipv4);
use DateTime;
use English qw( -no_match_vars );
use Getopt::Std;
use List::MoreUtils qw(any);
use Net::hostent;
use NetAddr::IP;
use Net::DNS;
use POE qw(Component::Client::Ping);
use Readonly;
use Regexp::Common;
use Socket;
use Sys::Hostname;
use Sys::Syslog qw(:DEFAULT setlogsock);
use Time::HiRes qw(sleep time);

# Declare mundane variables
my $institution;       # Name of institution; appears in report
my $invocation;        # Hacked version of how we were called
my $localhost;         # Nodename of the machine on which we are running
my $long;              # Seconds to sleep
my $mid;               # Seconds to sleep
my $mode;              # Interactive or batch
my $node_file;         # File holding list of hosts to ping
my %option;            # Command-line arguments
my $program_name;      # Name of this program
my $report_date;       # Today's date
my $report_dir;        # Directory holding data and report files
my $report_file;       # Place to store report
my $report_group;      # Group for data and report files
my $report_owner;      # Owner for data and report files
my $report_prefix;     # Prefix for data and report file names
my $report_queries;    # Address to which questions can be addressed
my $report_subject;    # Report header
my $report_time;       # Today's time
my $short;             # Seconds to sleep
my $syslog_facility;   # Facility to use when sending msgs to syslog
my $syslog_host;       # If undefined, I will log locally.  However,
                       # if undefined and I are running under Windows,
                       # I will complain and die
my $syslog_port;       # Only needed if $syslog_host is defined
my $syslog_priority;   # Priority to use when sending msgs to syslog
my $syslog_socket;     # Socket type to use when sending msgs to syslog;
                       # not used under Windows.  See 'perldoc Sys::Syslog'
                       # for details
my $title;             # Optional title string written first to the data file
my $usage;             # Usage message
my $version;           # Version of this program

# Declare ping-related variables
my @active;            # Targets which responded to a ping (compare to @silent)
                       # This variable is shared between ping_nodes and 
                       # _client_got_pong.  ping_nodes undefs it after every 
                       # run
my %addr_of;           # Hash of addresses, keyed by name
my @addresses;         # Similar to @target, but converted to IP addresses if 
                       # needed
my %alive;             # Hash of references to lists of nodes which returned
                       # a ping, keyed by the time of the event
my $begin_count;       # Number of addresses returning pings when we begin
my %data;              # Hash of hash refs, keyed by time, where each hash ref 
                       # is keyed by hostname and specifies whether or not the 
                       # host returned a ping at that time (1 = yes, 0 = no)
my $debug;             # Specifies debug level
my $end_count;         # Number of addresses returning pings when we end
my $errors;            # Description of errors encountered during run
my %hits;              # Hash of integers identifying the number of pings 
                       # returned, keyed by target
my @ips;               # Starts off as equivalent to @addresses; POE pings this 
                       # list, removing elements as it emits pings
my $interrupted;       # Boolean telling us that the user has typed Ctrl-C
my %misses;            # Hash of integers identifying the number of pings 
                       # which didn't return, keyed by target
my %name_of;           # Hash of names, keyed by addresses.  Names are
                       # typically nodenames, but if we are unable to identify 
                       # these, then hostnames, and failing that, the target's 
                       # IP address
my $ping_interval;     # Number of seconds to elapse between ping cycles
my $parallelism;       # Maximum number of outstanding pings when invoking
                       # POE::Component::Client::Ping
my $ping_timeout;      # Seconds to wait before declaring a ping lost when
                       # employing POE-based pinging routines
my @routes;            # List of routes in CIDR-format (10.1.2.0/24); we will 
                       # ping all (live) nodes on these routes
                       # that route
my $ping_end;          # Time when we ended pinging
my $ping_start;        # Time when we started pinging
my @silent;            # Targets which did not respond to a ping (see @active)
my @target;            # List of hosts to ping
my @timeline;          # List of timestamps, in order to occurrence
my $whine;             # The number of times we were unable to emit pings fast 
                       # enough to keep steady with $ping_interval
my $window;            # Number of seconds to run

# Define constants
Readonly my $BANG          => q{!};
Readonly my $COMMA         => q{,};
Readonly my $DASH          => q{-};
Readonly my $DOT           => q{.};
Readonly my $EMPTY_STR     => q{};
Readonly my $SLASH         => q{/};
Readonly my $SPACE         => q{ };

# Define global variables
$debug = 0;
            # 10 = Logging
            #  9 = Database SELECT operations
            #  8 = Per IP/MAC/Port processing
            #  7 = Database INSERT/UPDATE/DELETE
            #  6 = Dump SNMP var
            #  5 = Dump snmp_packets
            #  4 = Grody:    print big var
            #  3 = Verbose:  print mid var
            #  2 = Simple:   print small var
            #  1 = Basic:    subroutine trace
            #  0 = Disable debugging
$program_name = 'mass-ping';
$usage = 'Usage:  mass-ping -s {yes|no} [-c {"title"}] [-d {integer}] [-i {interval in seconds}] [-t {timeout in seconds}] [-w {window in seconds}] [-n {report prefix}] [-o {owner}] [-g {group}] [-r] [-q {route,route,route...}] | -f {filename} | target1 target2 target3 ...]'; 
$version = '1.1.0';
$OUTPUT_AUTOFLUSH = 1;
$Getopt::Std::STANDARD_HELP_VERSION = 1;

# Catching Ctrl-C
$interrupted = 0;

# Data storage
$report_date = get_date();
$report_time = get_time();

# Pause parameters
$long  = 30;
$mid   = 10;
$short = 5;

# Ping Stuff
$ping_interval = 1;
$parallelism   = 30;
$ping_timeout  = .2;
$window        = 600;

# Report stuff
$localhost      = hostname;
$report_owner   = exists $ENV{SUDO_UID} ? $ENV{SUDO_UID} : $UID;
$report_owner   = getpwuid($report_owner);
$report_group   = exists $ENV{SUDO_GID} ? $ENV{SUDO_GID} : $GID;
$report_group   = getgrgid($report_group);
$report_dir     = '/home/netops/rpts/mass-ping';
$report_prefix  = 'mass-ping';
$report_queries = 'netops@fhcrc.org';
$report_subject = 'Mass Ping Report';
$title          = $program_name;

# Syslog stuff
$syslog_facility  = 'local5';
$syslog_host      = 'localhost';
$syslog_port      = 514;        
$syslog_priority  = 'info';
$syslog_socket    = 'unix';    # Other possibilites include 'udp' and
                               # 'stream'; depending on the flavor of Unix,
                               # I've employed each of these

# Grab arguments
getopts('c:d:f:g:i:n:o:p:q:rs:t:w:', \%option); 
@target = @ARGV;

# Set mode
if      ($option{r})            { $mode = 'report'      }
elsif   (-t STDIN)              { $mode = 'interactive' }
else                            { $mode = 'batch'       }


### Begin Main Program ###############################################

{

  check_args();                   # Check arguments

  sanity_check();                 # Check for error conditions

  prep_run();                    # Characterize initial conditions

  do_the_work();                  # Do the work

  finish_run();                   # Characterize ending conditions

  process_results();              # Extract statistics from the data

  write_data();                   # Write data file

  print_report();                 # Print report

}

##### End Main Program ###############################################



########################################################################
# Handle a "pong" event (returned by the Ping component because we
# asked it to)
########################################################################
sub _client_got_pong {
  my ($kernel, $session) = @_[ KERNEL, SESSION];

  # Debug trace
  trace_location('begin') if $debug == 8;

  # The original request is returned as the first parameter.  It
  # contains the address we wanted to ping, the total time to wait for
  # a response, and the time the request was made.

  my $request_packet = $_[ARG0];
  my ($request_address, $request_timeout, $request_time ) = @{$request_packet};
  if ($debug == 4) {
    log_it("$request_address, $request_timeout, $request_time");
  }

  # The response information is returned as the second parameter.  It
  # contains the response address (which may be different from the
  # request address), the ping's round-trip time, and the time the
  # reply was received.

  my $response_packet = $_[ARG1];
  my ($response_address, $roundtrip_time, $reply_time ) = @{$response_packet};

  # Record results
  if (defined $response_address) {
    push @active, $response_address;
    if ($debug == 4) {
      log_it("$response_address, $roundtrip_time, $reply_time");
    }
  }
  else {
    push @silent, $request_address;
    log_it("$request_address missed a ping") if $debug;
  }

  # Track weirdness
  if (defined $response_address) {
    if ($request_address ne $response_address) {
      log_it("I pinged $request_address, and $response_address replied");
    }
  }

  # Debug trace
  trace_location('end') if $debug == 8;
  
} 




########################################################################
# Handle _start (given by POE itself to start your session) by sending
# several "ping" commands to the component at once.  The component
# will reply over the course of $ping_timeout seconds
########################################################################
sub _client_start {
  my ($kernel, $session ) = @_[ KERNEL, SESSION ];

  # Debug trace
  trace_location('begin') if $debug > 3;

  # Ping the addresses
  for my $address (@addresses) {
    # Pinger, do a ping and return the results as a pong event
    $kernel->post( pinger => ping => pong => $address );
  }

  # Debug trace
  trace_location('end') if $debug > 3;

}




########################################################################
# Catch Ctrl-C
########################################################################
sub block_int {

  # Debug trace
  trace_location('begin') if $debug > 8;

  # Install our own signal handler
  $SIG{INT} = \&got_int;

  # Debug trace
  trace_location('end') if $debug > 8;

  return 1;
}




########################################################################
# Install our own signal handler for Ctrl-C
########################################################################
sub catch_int {

  # Debug trace
  trace_location('begin') if $debug > 8;

  # The signals that we'll use to break out of the ping loop gracefully
  $SIG{INT}      = \&quit_pinging;

  # Debug trace
  trace_location('end') if $debug > 8;

  return 1;
}




########################################################################
# Check arguments
########################################################################
sub check_args {

  # Debug trace
  trace_location('begin') if $debug;

  # Are you serious?
  unless ($option{s})                {
     say 'Must specify the -s option';
     die "$usage\n";
  }

  # Set debug level
  $debug = defined $option{d} ? $option{d} : 0;
  unless ($RE{num}{int}->matches($debug)) {
    say 'Option d must be an integer';
    die "$usage\n";
  }


  # Assign title and report_prefix
  $title            = $option{c} if defined $option{c};
  $report_prefix    = $option{n} if defined $option{n};

  # Populate @routes
  @routes           = split $COMMA, $option{q} if defined $option{q};

  # Check ping interval
  $ping_interval = $option{i} if defined $option{i};
  unless ($RE{num}{real}->matches($ping_interval)) {
    say "-i {seconds} ping interval must be a number";
    die "$usage\n";
  }

  # Check ping timeout
  $ping_timeout = $option{t} if defined $option{t};
  unless ($RE{num}{real}->matches($ping_timeout)) {
    say "-t {seconds} timeout must be a number";
    die "$usage\n";
  }

  # Check parallelism
  $parallelism = $option{p} if defined $option{p};
  unless ($RE{num}{int}->matches($parallelism)) {
    say "-p {parallelism} timeout must be an integer";
    die "$usage\n";
  }

  # Check window
  $window = $option{w} if defined $option{w};
  unless ($RE{num}{real}->matches($window)) {
    say "-w {seconds} window must be a number";
    die "$usage\n";
  }

  # File containing targets
  if ($option{f}) {
    $node_file = $option{f};
    unless (-f $node_file and -r $node_file and -s $node_file) {
      say "Problem with $node_file: $!";
      die "$usage\n";
    }
  }

  # Debug trace
  trace_location('end') if $debug;

  return 1; 
} 




########################################################################
# Characterize ending conditions
########################################################################
sub finish_run {

  # Debug trace
  trace_location('begin') if $debug;

  # Ping the targets, recording the number which are live
  $end_count = ping_nodes(\@addresses, 3);

  # Notify operator
  print_it("Ending with $end_count live addresses\n");

  # Debug trace
  trace_location('end') if $debug;

  return 1;
}




########################################################################
# Do the work:  ping the targets
########################################################################
sub do_the_work {
  my $whine_interval = 20;    # Interval at which to whine about being 
                              # unable to ping fast enough

  # Debug trace
  trace_location('begin') if $debug;

  # Initialize variables
  $ping_start = time;
  $whine = 0;

  # Notify operator
  if ($mode eq 'interactive') {
    my $minutes = int $window / 60;
    say "Pinging targets every $ping_interval seconds with timeout $ping_timeout seconds, running for $minutes minutes, hit Ctrl-C to cancel...";
  }

  # Loop for a while
  for (my $i = 0; $i < $window; $i += $ping_interval) {
    my ($end, @living, $pause, $start);

    # Record time
    $start = time;

    # Ping and gather data
    block_int();
    @living = ping_nodes(\@addresses);
    $alive{$start} = \@living;
    $end = $ping_end = time;
    quit_pinging() if $interrupted;
    catch_int();

    # Keep operator entertained
    print scalar @living, $SPACE if $mode eq 'interactive';

    # Sleep if necessary
    $pause = $ping_interval - ($end - $start);
    say "\nsleeping $pause seconds" if $debug == 2;
    if ($pause > 0) {
      sleep $pause;
    }
    else {
      if ($mode eq 'interactive') {
        if (int $whine / $whine_interval == $whine / $whine_interval) {
          say "\nUnable to emit pings fast enough:  $pause";
        }
      }
      $whine++;
    }

  }

  # Make things look pretty
  say "\nLeaving ping loop ..." if $mode eq 'interactive';

  # Debug trace
  trace_location('end') if $debug;

  return 1;
}




########################################################################
# Return date in yyyy-mm-dd for today, unless handed an epoch time
########################################################################
sub get_date {
  my $dt;                 # DateTime object
  my $time = shift;

  # Debug trace
  trace_location('begin') if $debug == 10;

  # Determine time
  given ($time) {
    when (undef) { $dt = DateTime->now( time_zone => 'local' )  }
    default      { $dt = DateTime->from_epoch( epoch => $time ) }
  }

  # Debug trace
  trace_location('end') if $debug;

  return $dt->ymd;
}




#######################################################################
# Given an IP address, return hostname
########################################################################
sub get_hostname {
  my $query;            # Net::DNS search object
  my $res;              # Net::DNS object
  my $hostname;         # The answer
  my $addr = shift;     # The IP address

  # Debug trace
  trace_location('begin') if $debug == 8;

  # Sanity check
  confess 'No parameters!' unless defined $addr;

  # Do the work
  $res = Net::DNS::Resolver->new();
  $query = $res->search($addr);
  if ($query) {
    RR:
    for my $rr ($query->answer) {
      next RR unless $rr->type eq 'PTR';
      $hostname = lc($rr->ptrdname);
    }
  }

  # Debug trace
  trace_location('end') if $debug == 8;

  return $hostname;
}




#######################################################################
# Given a hostname, return its IP address
########################################################################
sub get_ipaddr {
  my $h;                # Net::hostent object
  my $ipaddr;           # The answer
  my $nodename = shift; # The hostname

  # Debug trace
  trace_location('begin') if $debug == 8;

  # Sanity check
  confess 'No parameters!' unless defined $nodename;

  # Do the work
  $h = gethost($nodename);
  $ipaddr = inet_ntoa($h->addr) if defined $h;

  # Debug trace
  trace_location('end') if $debug == 8;

  return $ipaddr;
}




#######################################################################
# Given an IP address, return the nodename
########################################################################
sub get_nodename {
  my $addr = shift;     # The IP address
  my $h;                # Net::hostent object
  my $nodename;         # The answer
      
  # Debug trace 
  trace_location('begin') if $debug == 8;
  
  # Sanity check
  confess 'No parameters!' unless defined $addr;
  
  # Do the work
  $h = gethost($addr);
  if (defined $h) {
    $nodename = $h->name;
    ($nodename) = ($nodename =~ /(.*?)\./) if $nodename =~ /\./;
  }

  # Debug info
  if ($debug == 8) {
    if (defined $nodename) {
      say "$addr = $nodename";
    }
    else {              
      say "$addr nodename is undefined";
    }
  }

  # Debug trace
  trace_location('end') if $debug == 8;

  return $nodename;
}




########################################################################
# Return a version of the time at this moment
########################################################################
sub get_now {
  my ($dt, $date, $now);

  # Debug trace
  trace_location('begin') if $debug;

  # Define date
  $dt = DateTime->now( time_zone => 'local' );
  $date = join $SPACE, $dt->day_name, $dt->month_name, $dt->day;
  $now  = $date . ', ' . $dt->year . ' at ' . $dt->hms;

  # Debug trace
  trace_location('end') if $debug;

  return $now;
}




########################################################################
# Return current time as hh:mm:ss, unless called with an epoch time
########################################################################
sub get_time {
  my $dt;                 # DateTime object
  my $time = shift;

  # Debug trace
  trace_location('begin') if $debug == 10;

  # Determine time
  given ($time) {
    when (undef) {
      $dt = DateTime->now( time_zone => 'local' );
    }
    default {
      $dt = DateTime->from_epoch( epoch => $time, time_zone => 'local' );
    }
  }
  
  # Debug trace
  trace_location('end') if $debug == 10;

  return $dt->hms;
}




########################################################################
# Catch Ctrl-C
########################################################################
sub got_int {

  # Debug trace
  trace_location('begin') if $debug > 8;

  # Record the fact that we heard a Ctrl-C
  $interrupted = 1;
  log_it("Received SIGINT, will quit after current round of pings complete");

  # Debug trace
  trace_location('end') if $debug > 8;

  return 1;
}




########################################################################
# Send messages to syslog
########################################################################
sub log_it {
  my $ident;
  my $msg = shift;
  my $username = getlogin();

  # Debug trace
  trace_location('begin') if $debug == 10;

  # Check for content
  $msg = 'undefined' if (not defined $msg or $msg eq $EMPTY_STR);

  # Assign Sys::Syslog variables
  $Sys::Syslog::host = $syslog_host;
  $Sys::Syslog::host = $Sys::Syslog::host;  # Avoid warning

  # Construct ident
  #$ident = $username . '_is_running_' . $PROGRAM_NAME;
  $ident = $username . $SPACE . $PROGRAM_NAME;

  # Strip new lines from message
  $msg =~ s/\n//g;

  # Send it to syslog
  setlogsock($syslog_socket) or carp "Cannot setlogsock to $syslog_socket: $!";
  openlog($ident, 'nofatal,ndelay,pid', $syslog_facility);
  syslog($syslog_priority, $msg);
  closelog();

  # Debug trace
  trace_location('end') if $debug == 10;

  return 1;
}




########################################################################
# Given a reference to an array of IP addresses or hostnames, return a
# version of the results, depending on context
########################################################################
sub ping_nodes {
  my $addr_ref = shift;
  my $retry = shift;

  # Debug trace
  trace_location('begin') if $debug;

  # Default retry
  $retry = 0 unless defined $retry;

  # Sanity checking
  confess 'No parameters!'           unless defined $addr_ref;
  confess 'Wrong type for parameter' unless ref $addr_ref eq 'ARRAY';
  confess 'Retry must be an integer' unless $RE{num}{int}->matches($retry);

  # Initialize variables
  @ips = @$addr_ref;

  # Create a pinger component.  This will do the work of multiple
  # concurrent pings.  It requires another session to interact with it.
  POE::Component::Client::Ping->spawn ( Alias       => 'pinger',
                                        Parallelism => $parallelism,
                                        Timeout     => $ping_timeout,
                                        OneReply    => 1,
                                        Retry       => $retry
                                       );

  # Create a session that will use the pinger.  Its parameters match
  # event names with the functions that will handle them.
  POE::Session->create
    ( inline_states =>
        { _start    => \&_client_start,       # Handle "_start"
          pong      => \&_client_got_pong,    # Handle "pong"
        }
    );

  # Start POE's main loop.  It will only return when everything is done.
  $poe_kernel->run();
  
  # Debug trace 
  trace_location('end') if $debug;

  return  
      SCALAR   { scalar @active }
      LIST     { @active        }
      HASHREF  { 
                 my (%alive, %dead, %result);
                 for my $host (@active) {
                   $alive{$host} = 1;
                 }                                    
                 for my $host (@silent) {             
                   $dead{$host} = 0;               
                 }
                 $result{alive} = \%alive;
                 $result{dead}  = \%dead;
                 \%result;
               }
      DEFAULT  { confess q{Bad context!  No cracker!} }
      RECOVER  { undef @active; undef @silent;        }
  ;
}                                      




########################################################################
# Characterize initial conditions
########################################################################
sub prep_run {
  my @live;

  # Debug trace
  trace_location('begin') if $debug;

  # Notify operator
  say 'Identifying live hosts...' if $mode eq 'interactive';

  # Resolve names and addresses as needed
  for my $target (@target) {
    my ($addr, $name);

    # Target given as an IP address: find name
    if (is_ipv4($target)) {
      $addr = $target;
      $name = get_nodename($target);
      $name = get_hostname($target) unless defined $name;
      $name = defined $name ? lc $name
            :                 $addr;
    }

    # Target given as a name: find address
    else {
      $addr = get_ipaddr($target);
      warn "$target does not resolve, skipping\n" unless defined $addr;
      $name = $target;
    }

    # Save results
    if (defined $addr) {
      push @addresses, $addr;
      if (defined $addr_of{$name}) {
        warn "$name maps to $addr_of{$name} and $addr, $addr wins";
      }
      $addr_of{$name} = $addr;
      if (defined $name_of{$addr}) {
        warn "$addr maps to $name_of{$addr} and $name, $name wins";
      }
      $name_of{$addr} = $name;
    }

  }

  # Ping the targets, recording the number which are live
  @live = ping_nodes(\@addresses, 3);
  $begin_count = @live;

  # Only ping live targets
  @addresses = sort @live;

  # Initialize %hits and %misses
  for my $addr (@addresses) {
    $hits{$addr}   = 0;
    $misses{$addr} = 0;
  }

  # Build $invocation
  $invocation 
      = "$program_name -i $ping_interval -w $window -t $ping_timeout ";
  if (@routes > 0) {
    $invocation .= '-q ' . join $COMMA, @routes;
  }
  elsif (defined $option{f}) {
    $invocation .= "-f $option{f}";
  }
  else {
    given (@addresses) {
      when (1..10) { $invocation .= join $SPACE, @addresses[0..@addresses - 1] }
      default      { $invocation .= join $SPACE, @addresses[0..10] . ' ...'    }
    }
  }
  
  # Make things look pretty
  say "\n" if $mode eq 'interactive';

  # Notify operator
  print_it("Beginning with $begin_count live addresses");

  # Debug trace
  trace_location('end') if $debug;
}




########################################################################
# Print line to STDOUT or to Syslog
########################################################################
sub print_it {
  my $line = shift;
  
  given ($mode) {
    when ('interactive') { say $line     }
    default              { log_it($line) }
  }
  
  return 1; 
}




########################################################################
# Tell the operator what I discovered
########################################################################
sub print_report {
  my $handle;
  my @nodes;                         # List of names of the nodes,
                                     # possibly sorted
  my $total = @addresses;
  my $now = get_now();
  my $report_file;

  # Debug trace
  trace_location('begin') if $debug;

  # Direct output to screen or to file
  if ($mode eq 'interactive') {
    $handle = *STDOUT;
  }
  else {
    $report_file = $report_dir . $SLASH . $report_prefix . $DASH . $report_date . $DASH . $report_time . '.txt';
    open $handle, '>', $report_file or die "Cannot open $report_file: $!\n";
  }

print {$handle} <<EOF;
# Title:           $report_subject
#
# Institution:     $institution
#
# Date of Report:  $now
#
# Description:     This report portrays pings hit and missed
#
# Active:          $total
#
# Title;           $title
#
# Errors:          $errors
#
# Questions:       If you have questions or comments regarding this
#                  report, please mail them to $report_queries.
#
#
# target                        hits   misses
# ----------------------------  -----  ------
EOF

  # If the operator specified a file, preserve the order of nodes
  # Otherwise, sort the nodes by name
  if (defined $node_file) {
    @nodes = @target;
  }
  else {
    @nodes = sort keys %addr_of;
  }

  # Walk the nodes
  NAME:
  for my $name (@nodes) {
    my $addr = $addr_of{$name};

    # Skip hosts which didn't resolve
    next NAME unless defined $addr;

    # Skip unless we pinged this address
    next NAME unless any {$addr eq $_} @addresses;

    # Print result
    printf {$handle} "%-30s  %5s  %6s\n", $name, $hits{$addr}, $misses{$addr};
  }

  # Clean-up
  unless ($handle =~ /STDOUT/) {
    close $handle or warn "Cannot close $report_file: $!\n";
    my $uid = getpwnam($report_owner);
    my $gid = getgrnam($report_group);
    chown $uid, $gid, $report_file or warn "Cannot chown $report_file: $!";
    chmod 0664, $report_file       or warn "Cannot chmod $report_file: $!";
  }

  # Make things look pretty
  print_it("\n\nEnding $PROGRAM_NAME");

  # Debug trace
  trace_location('end') if $debug;

  return 1;
}




########################################################################
# Analyze the data.  I start with a hash of array refs listing the nodes 
# which responded at a given time, specified by the key.  I want to 
# populate the %result hash, which 
########################################################################
sub process_results { 

  # Debug trace
  trace_location('begin') if $debug;

  # Notify operator
  say 'Processing results...' if $mode eq 'interactive';

  # Record problems
  if ($whine > 0) {
    $errors = "   Unable to emit pings fast enough on $whine occasions";
  }

  # Initialize variables
  $title   = $EMPTY_STR unless defined $title;
  $errors  = $EMPTY_STR unless defined $errors;

  # Walk through the data hash, which contains references to lists of nodes
  # which answered a ping at the time specified by the key to the hash
  for my $time (sort keys %alive) {
    my (@living, %result);

    # Debug info
    say 'Processing pings for ', get_time($time) if $debug > 3;

    # Add to the timeline
    push @timeline, $time;

    # Extract the list of 'living' nodes for this timestamp
    @living = @{$alive{$time}};

    # Walk through the list of living nodes, recording hit pings
    for my $addr (@living) {
      $data{$time}->{$addr} = 1;
      $hits{$addr}++;
    }

    # At this point, %data contains all the nodes which answered pings ... 
    # but none of the ones which did not respond to pings.  Add the silent ones
    for my $addr (@addresses) {
      unless ( any { $addr eq $_ } @living) {
        $data{$time}->{$addr} = 0;
        $misses{$addr}++;
      }
    }

    # Entertain the operator
    print $BANG if $mode eq 'interactive';

  }  # End 'Walk through the data hash'

  # Make things look pretty
  say "\n" if $mode eq 'interactive';

  # Debug trace
  trace_location('end') if $debug;

  return 1;
}




########################################################################
# If the operator hits Ctrl-C, our signal handler intercepts it and 
# pushes us here, where we analyze data and produce the report
########################################################################
sub quit_pinging {

  # Debug trace
  trace_location('begin') if $debug;

  # Make things look pretty
  print_it("\nAborting...");

  finish_run();                   # Characterize ending conditions

  process_results();              # Extract statistics from the data

  write_data();                   # Write data file

  print_report();                 # Print report

  # Debug trace
  trace_location('end') if $debug;

  exit 1;
}




########################################################################
# Sanity check
########################################################################
sub sanity_check {

  # Debug trace
  trace_location('begin') if $debug;

  # Notify operator
  print_it('Sanity check...');

  # Check routes
  if (@routes > 0) {
    my @hosts;

    # Convert route into an array of NetAddr::IP objects
    for my $route (@routes) {
      my $obj;
      eval { $obj = NetAddr::IP->new($route) };
      die "-q {route}:  $route is malformed\n" if $@;
      push @hosts, $obj->hostenum;
    }

    # Convert @hosts from NetAddr::IP objects to IP addresses
    for my $host (@hosts) {
      push @target, $host->addr();
    }

    # Check to see that @target is populated
    die "Unable to convert -q {route,route,route...} to a list of addresses\n" unless @target > 0;

  }

  # Read file
  if (defined $node_file) {
    open my $file, '<', $node_file or die "Cannot open $node_file: $!";
    for my $line (<$file>) {
      chomp $line;
      push @target, $line;
    }
    close $file or warn "Cannot close $node_file: $!";
    die "$node_file is empty\n" unless @target > 0;
  }

  # Check for command-line list of targets
  die "Must specify node_file, route, or list of targets\n" unless @target > 0;

  # Verify root privileges
  die "Must run with root privileges\n" unless $EUID == 0;

  # Debug trace
  trace_location('end') if $debug;

  return 1;
}




########################################################################
# Show the programmer where we are
########################################################################
sub trace_location {
  my $location = shift;
  my ($subroutine) = (caller (1))[3];

  given ($location) {
    when (/begin/) { say "Entering $subroutine" }
    when (/end/)   { say "Leaving $subroutine"  }
  }

  return 1;
}




########################################################################
# Write the data file
########################################################################
sub write_data {
  my $data_file;
  my @nodes;                         # List of names of the nodes, 
                                     # possibly sorted
  my $num_addr = scalar @addresses;
  my $num_time = scalar @timeline;

  # Debug trace
  trace_location('begin') if $debug;

  # Open data file
  $data_file = $report_dir . $SLASH . $report_prefix . $DASH . $report_owner . $DASH . $report_date . $DASH . $report_time . '.csv';
  ($data_file = $data_file) =~ s/:/_/g;    # Windows doesn't like colons
  open my $file, '>', $data_file or die "Cannot open $data_file: $!";

  # Write header
  print {$file} "Mass-Ping: $title\n";
  print {$file} "Invocation           $invocation\n";
  print {$file} "Details                Run from $localhost on $report_date at $report_time by $report_owner\n";
  print {$file} "Errors               $errors\n";

  # Write column headings
  print {$file} 'Timestamps:,';
  for my $epoch (@timeline) {
    print {$file} get_time($epoch);
    print {$file} $COMMA unless $epoch eq $timeline[$num_time - 1];
  }
  print {$file} "\n";

  # If the operator specified a file, preserve the order of nodes
  # Otherwise, sort the nodes by name
  if (defined $node_file) {
    @nodes = @target;
  }
  else {
    @nodes = sort keys %addr_of;
  }

  # Walk the nodes
  NAME:
  for my $name (@nodes) {
    my $addr = $addr_of{$name};

    # Skip hosts which didn't resolve
    next NAME unless defined $addr;

    # Skip unless we pinged this address
    next NAME unless any {$addr eq $_} @addresses;

    # Print name
    print {$file} $name, $COMMA;
  
    # Walk through time
    for my $time (@timeline) {

      # Print dots for missed pings, bangs for hit pings
      given ($data{$time}->{$addr}) {
        when (0) { print {$file} $DOT  }
        when (1) { print {$file} $BANG }
      }

      # Unless this is the last entry, print a comma
      print {$file} $COMMA unless $time eq $timeline[$num_time - 1];

    }  # End 'Walk through time'

    # Terminate the line with a carriage return
    print {$file} "\n";

  }  # End 'Walk through targets'

  # Clean-up
  close $file or warn "Cannot close $data_file: $!";
  my $uid = getpwnam($report_owner);
  my $gid = getgrnam($report_group);
  chown $uid, $gid, $data_file or warn "Cannot chown $data_file: $!";
  chmod 0664, $data_file       or warn "Cannot chmod $data_file: $!";

  # Debug trace
  trace_location('end') if $debug;

  return 1;
}




########################################################################
# Output help
########################################################################
sub HELP_MESSAGE {
  print <<EOF;

  $usage

    -c specifies the title (enclose multi-word titles in quotes) which 
       will be included in the data file

    -d specifies debug level (typically 0-9)

    -f points the script to a file containing the list of targets

    -i specifies the interval between rounds of pings; default is $ping_interval seconds

    -n specifies the report prefix, a string prepending to the name of the 
       data file.  The default is empty

    -p defines the level of parallelism, a POE::Component::Client::Ping 
       parameter for the number of outstanding pings permitted.  The default 
       is $parallelism

    -q specifies a list of routes in CIDR form (e.g. 10.1.2.0/23,10.2.20.0/23,10.15.30.0/23); we will ping all host addresses on these routes

    -r determines whether or not the script writes its report to disk.  (The 
       data file is always written to disk)

    -s asks the question:  are you serious?  If you answer 'no', then 
       the script will run in demo mode, making no changes

    -t specifies the time to wait before considering a ping lost; default 
       is $ping_timeout seconds

    -w specifies the window during which we will ping, i.e. the length of time 
       to elapse between starting and stopping.  The operator can interrupt 
       the program using Ctrl-C, whereupon the script will produce its report
       files with whatever data it has gathered up to that point.  The default 
       is $window seconds

    target1 target2 target3 ... is the command-line list of targets you
      have specified, in lieu of the -a, -e, or -f options

EOF

  return 1;
}




########################################################################
# Output version
########################################################################
sub VERSION_MESSAGE {
  say "$program_name v$version";
  return 1;
}