##########################################################################
# package PingTools.pm
# This module contains various ways of pinging targets

# V      Who       When        What
# ---------------------------------------------------------------------------
# 1.0.7  skendric  2009-01-22  Yank poe_ping_nodes + ping_list, add ping_route
# 1.0.6  skendric  2008-06-16  Stylistic mods
# 1.0.5  skendric  2008-05-30  Stylistic mods
# 1.0.4  skendric  2007-03-12  Stylistic mods
# 1.0.3  skendric  2006-09-04  Re-enable POE stuff
# 1.0.2  skendric  2005-07-01  Comment out POE stuff
# 1.0.1  skendric  2005-06-13  Check subroutine parameters
# 1.0.0  skendric  2004-08-26  First version
#
#
#
# Authors:  Stuart Kendrick <sbk {insert at sign here } skendric
#                                {insert dot here} com>
#
# Source:  http://www.skendric.com/device/soma
#
# This software is available under the GNU GENERAL PUBLIC LICENSE, see
# http://www.fsf.org/licenses/gpl.html
#


package FHCRC::VDOPS::PingTools;

#### Load modules ####
use strict;
use warnings;
use Carp qw(carp cluck croak confess);
use Data::Dumper;
use English qw( -no_match_vars );
use Exporter;
use File::stat;
use IPC::Open3;
use Net::Ping::External qw(ping);
use Perl6::Say;
use Socket;
use Switch;

use lib '/home/soma/lib';
use FHCRC::VDOPS::SomaData;
use FHCRC::VDOPS::Utilities;

#### Set-up export stuff ####
our @ISA = qw(Exporter);
our @EXPORT =    qw(
                          ping_it
                          ping_route
                          poe_ping_nodes 
                    );

# Declare package local variables

our @addrs;               # List of addresses to ping
our @responded;           # Subset of @addrs which answered a ping

##### Only subroutines below here ####



########################################################################
# Ping host, returning success or failure
########################################################################
sub ping_it {
  my $host    = shift;
  my $timeout = shift;
  my $count   = shift;

  # Sanity check
  confess 'No parameters' unless defined $host;

  # Fill in missing parameters
  $timeout = $ping_timeout unless defined $timeout;
  $count   = $ping_count   unless defined $count;

  if ( ping ( hostname    => $host,
              timeout     => $timeout,
              count       => $count
            )
     ) {
    say "$host returned a ping" if $debug == 8;
    return 1;
  }
  else {
    say "$host did not answer" if $debug == 8;
    return 0;
  }

}




########################################################################
# Given a reference to a NetAddr::IP object, ping the addresses and 
# return a list of references to arrays specifying alive, dead, etc.
########################################################################
sub ping_route {
  my @alive;               # Answered a ping
  my @dead;                # Didn't answer a ping
  my @error;               # Pinger returned an error
  my $fping;               # fping binary plus command-line options
  my $fping_output;        # The stuff fping returned to us
  my $route_ref = shift;   # Reference to NetAddr::IP route object
  my @unknown;             # Pinger couldn't resolve name to address

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

  # Sanity check
  confess 'Parameter is wrong type' unless ref $route_ref eq 'NetAddr::IP';

  # Debug info
  say "  Preparing to ping $route_ref" if $debug;

  # If fping is functional, use it
  if (validate_pinger($fping_binary)) {

    # Ping the addresses
    $fping = "$fping_binary -r $fping_retries -B $fping_backoff -i $fping_interval -t $fping_timeout -g $route_ref";
    say "  Pinger = $fping" if $debug;
    $fping_output = `$fping 2>/dev/null`;
    
    # Walk pinger output
    for my $line (split $CR, $fping_output) {
      my $target;
      say $line if $debug == 8;

      # Find target
      ($target) = ($line =~ /^(\S+)/);

      # Build data structures, categorizing hosts as dead, alive, etc.
      switch ($line) {
        case /is alive/ {
          push @alive, $target;
          print $BANG if $job eq 'interactive';
        }
        case /is unreachable/ {
          push @dead, $target;
          print $DOT if $job eq 'interactive';
        }
        case /address not found/ {
          push @unknown, $target;
          print $QUERY if $job eq 'interactive';
        }
        else {
          push @error, $target;
          print 'e' if $job eq 'interactive';
        }
      }

    }  # End 'walk pinger output'

  }  # End 'if fping is available, use it'
            
  # Otherwise, use ping_it
  else {      
              
    for my $addr (@$route_ref) {
      my ($ip) = ($addr =~ /(\d+\.\d+\.\d+\.\d+)\/32/);
      if (ping_it($ip, 1, 1)) {
        push @alive, $ip;
      }       
      else {
        push @dead, $ip;
      }
    }   

  }  # End 'use ping_it'


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

  # Debug info
  if ($debug == 8) {
    say();
    if (@alive > 0) {
      say "Alive targets are:";
      say "@alive";
    }
    if (@dead > 0) {
      say "Dead targets are:";
      say "@dead";
    }
    if (@error > 0) {
      say "Error targets are:";
      say "@error";
    }
    if (@unknown > 0) {
      say "Unknown targets are:";
      say "@unknown";
    } 
  }
     
  # Debug trace 
  trace_location('end') if $debug;
    
  return \@alive, \@dead, \@unknown, \@error;
      
}     




########################################################################
# Given the path to the pinger binary, verify that we can use use it to
# send pings.  Return 1 if yes, 0 if no.
########################################################################
sub validate_pinger {
  my $answer = 1;
  my $pinger = shift;
  my $sb;

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

  # Can we execute the binary?
  if (not -x $pinger) {
    $answer = 0;
    say "Cannot execute $pinger" if $debug;
  }

  # Do we have rootly privileges?
  else {
    $sb = stat($pinger);
    unless ($EUID == 0 or ($sb->uid == 0 and -u $pinger) ) {
      $answer = 0;
      say "To use $pinger, it must be setuid root or I must be running as root" if $debug;
    }
  }

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

 return $answer;
}




1;