##########################################################################
# package QueryHost.pm
# This module contains functions which asks hosts questions

# V     Who        When         What
# ---------------------------------------------------------------------------
# 1.5.6  skendric  02-13-2009  Support new arg format for skip_networks
# 1.5.5  skendric  01-29-2009  Simplify gather_netbios_name
# 1.5.4  skendric  01-28-2009  Parse node_status query more effectively
# 1.5.3  skendric  01-21-2009  Consult WINS if node does not respond to a 
#                              NetBIOS node status query
# 1.5.2  skendric  01-21-2009  Go back to using Net::NBName
# 1.5.1  skendric  01-02-2009  Use nmblookup instead of Net::NBName
# 1.5.0  skendric  09-19-2008  Disable warnings when invoking Net::NBName
# 1.4.9  skendric  07-03-2008  Wrap NetAddr::IP calls with eval
# 1.4.8  skendric  07-02-2008  Change skip_routers to flag_router
# 1.4.7  skendric  06-16-2008  Stylistic mods
# 1.4.6  skendric  06-12-2008  More debugging in gather_dns_name
# 1.4.5  skendric  05-21-2008  Fix gather_netbios_name routine
# 1.4.4  skendric  05-21-2008  Query host table if DNS returns nothing
# 1.4.3  skendric  10-10-2007  Error handling in gather_dns_name
# 1.4.2  skendric  06-18-2007  Error handling in gather_netbios_name
# 1.4.1  skendric  03-12-2007  Stylistic mods
# 1.4.0  skendric  09-25-2006  Handle obscure bug in NetAddr::IP generating
#                              a subnet full of IP addresses
# 1.3.9  skendric  06-24-2005  Support new %routeTable hash
# 1.3.8  skendric  06-13-2005  Fix bug in gather_host_snmp, check 
#                              subroutine parameters
# 1.3.7  skendric  02-24-2005  Fix bugs in finding NetBIOS names
# 1.3.6  skendric  02-18-2005  Add %netBiosUser
# 1.3.5  skendric  02-13-2005  Complete gather_host_snmp
# 1.3.4  skendric  02-09-2005  Convert %hostname to %nodename
# 1.3.3  skendric  02-06-2005  Remove redundant assign to %hostname
# 1.3.2  skendric  02-01-2005  Improve gather_netbios_name performance
# 1.3.1  skendric  02-01-2005  Improve gather_dns_name performance
# 1.3.0  skendric  01-11-2005  Add gather_dns_name
# 1.2.2  skendric  01-03-2004  Rename to QueryHost
# 1.2.1  skendric  09-23-2004  Change subroutine names
# 1.2.0  skendric  09-12-2004  Fix bugs in get_os_name
# 1.1.2  skendric  09-04-2004  Add MAC address collection to 
#                              get_netbios_name
# 1.1.1  skendric  09-03-2004  Fix bug in get_netbios_name
# 1.1.0  skendric  09-02-2004  Add get_os_name
# 1.0.1  skendric  08-27-2004  Add support for PingTools
# 1.0.0  skendric  08-26-2004  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::QueryHost;

#### Load modules ####
use strict;
use warnings;
use threads;
use threads::shared;
use Carp qw(carp cluck croak confess);
use Data::Dumper;
use Exporter;
use List::MoreUtils qw(any);
use Net::IPAddress qw(validaddr);
use NetAddr::IP;
use Net::NBName;
use Net::Nslookup;
use Perl6::Say;
use Socket;

use lib '/home/soma/lib';
use FHCRC::VDOPS::HostTools;
use FHCRC::VDOPS::NetworkTools;
use FHCRC::VDOPS::PingTools;
use FHCRC::VDOPS::SomaData;
use FHCRC::VDOPS::SNMPTools;
use FHCRC::VDOPS::Utilities;

#### Set-up export stuff ####
our @ISA = qw(Exporter);
our @EXPORT =    qw(
                          gather_dns_name
                          gather_host_snmp
                          gather_netbios_name
                    );

# Declare package local variables


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


########################################################################
# Given a route, perform DNS queries on all hosts on that route 
# and populate %dnsname with the results.  If the query returns null, 
# try a host table look-up
########################################################################
sub gather_dns_name {
  my $addresses;              # Ref to a list of IP addresses within 
                              # this route
  my $ip;                     # IP address to query
  my $route_obj;              # NetAddr::IP object
  my $mask;                   # Mask associated with $route
  my $route = shift;          # Route to analyze

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

  # Sanity check
  confess 'No parameters' unless defined $route;
  confess "Cannot find $route in route table" unless exists $routeTable{$route};
  confess "Cannot find mask for $route" unless defined $routeTable{$route};

  # Assign local variables
  $mask = $routeTable{$route};
  say "  Route $route / $mask" if $debug > 3;;

  # Create NetAddr::IP object
  eval { $route_obj = NetAddr::IP->new($route, $mask) };
  if ($@ or not defined $route_obj) {
    log_it("Bad route $route / $mask: $@");
    goto END;
  }

  # Build list of addresses within this route
  $addresses = $route_obj->hostenumref();

  # Walk the hosts, looking up PTR records
  log_it("Beginning gather_dns_name walk on $route_obj");
  say "Walking $route_obj" if $job eq 'interactive';
  ADDR:
  for my $addr (@$addresses) {
    my ($addr_obj, $ip);

    # Extract the IP address
    ($ip) = ($addr =~ /(\d+\.\d+\.\d+\.\d+)\/32/);

    # Sometimes, $ip is malformed; I don't understand how this happens
    unless (validaddr($ip)) {
      log_it("Problem with IP $ip in get_dns_name") if defined $ip;
      next ADDR;
    }

    # Skip weirdness
    eval { $addr_obj = NetAddr::IP->new($ip, $mask) };
    if ($@ or not defined $addr_obj) {
      log_it("Bad address $ip / $mask: $@");
      next ADDR;
    }

    # Skip routers
    next ADDR if flag_router($addr_obj);

    # First try DNS; if that doesn't work, try hosts table
    say "Resolving $ip" if $debug == 8;
    $dnsname{$ip} = nslookup(host => $ip, type => 'PTR');
    $dnsname{$ip} = get_nodename($ip) unless defined $dnsname{$ip};
    $dnsname{$ip} = $EMPTY_STR        unless defined $dnsname{$ip};

    # Debug info
    say "dnsname{$ip} = '$dnsname{$ip}'" if $debug == 8;

  } 

  # Leave tracks
  log_it("Ending gather_dns_name walk on $route_obj");

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

  return 1;
}




########################################################################
# Given a route, perform SNMP queries on all hosts on that route 
# and populate %snmpRead, %snmpVersion, %sysDescr, %sysObjectID 
########################################################################
sub gather_host_snmp {
  my $addresses;              # Ref to a list of IP addresses within 
                              # this route
  my $mask;                   # Mask associated with $route
  my $route_obj;              # NetAddr::IP object
  my $route = shift;          # Route to analyze

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

  # Sanity check
  confess 'No parameters' unless defined $route;
  confess "Cannot find $route in route table" unless exists $routeTable{$route};
  confess "Cannot find mask for $route" unless defined $routeTable{$route};

  # Assign local variables
  $mask = $routeTable{$route};
  say "  Route $route / $mask" if $debug > 3;;

  # Create NetAddr::IP object
  eval { $route_obj = NetAddr::IP->new($route, $mask) };
  if ($@ or not defined $route_obj) {
    log_it("Bad route $route / $mask: $@");
    goto END;
  }

  # Skip this network if it only hosts phones
  goto END if skip_networks($route_obj, \%voipRoute);

  # Skip this network if it belongs to MonkNet
  goto END if skip_networks($route_obj, \%monkRoute);

  # Build list of addresses within this route
  $addresses = $route_obj->hostenumref();

  # Walk the hosts
  log_it("Beginning gather_host_snmp walk on $route_obj");
  say "Walking $route_obj" if $job eq 'interactive';
  ADDR:
  for my $addr (@$addresses) {
    my ($addr_obj, $ip);

    # Extract the IP address
    ($ip) = ($addr =~ /(\d+\.\d+\.\d+\.\d+)\/32/);

    # Sometimes, $ip is malformed; I don't understand how this happens
    unless (validaddr($ip)) {
      log_it("Problem with IP $ip in get_host_snmp") if defined $ip;
      next ADDR;
    }    

    # Skip weirdness
    eval { $addr_obj = NetAddr::IP->new($ip, $mask) };
    if ($@ or not defined $addr_obj) {
      log_it("Bad address $ip / $mask: $@");
      next ADDR;
    }

    # Skip routers
    next ADDR if flag_router($addr_obj);

    # If it doesn't answer a ping, don't bother
    next ADDR unless ping_it($ip);

    # Gather SNMP information
    snmp_char($ip, \@snmp_read_list, \@snmp_version_list);

  } 
  log_it("Ending gather_host_snmp walk on $route_obj");

  END:

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

  return 1;
}




####################################################################### 
# Given a route, build a list of addresses in that route, and then walk 
# through them, quering each address' NetBIOS name table
########################################################################
sub gather_netbios_name {
  my $addresses;              # Ref to a list of IP addresses within
                              # this route
  my $alive;                  # Reference to an array of addresses which 
                              # responded to pings, a subset of all 
                              # addresses on this subnet
  my $dead;                   # Reference to an array of addresses which 
                              # did not respond to pings
  my $error;                  # Reference to an array of addresses which 
                              # returned some flavor of error when pinged
  my $unknown;                # Reference to an array of addresses for which 
                              # the ping response was undefined
  my $route_obj;              # NetAddr::IP object
  my $mask;                   # Mask associated with $route
  my $route = shift;          # Route to analyze

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

  # Sanity check
  confess 'No parameters' unless defined $route;
  confess "Cannot find $route in route table" unless exists $routeTable{$route};
  confess "Cannot find mask for $route" unless defined $routeTable{$route};

  # Assign local variables
  $mask = $routeTable{$route};
  say "  Route $route / $mask" if $debug > 3;;

  # Create NetAddr::IP object
  eval { $route_obj = NetAddr::IP->new($route, $mask) };
  if ($@ or not defined $route_obj) {
    log_it("Bad route $route / $mask: $@");
    goto END;
  }   

  # Skip this network if it only hosts phones
  goto END if skip_networks($route_obj, \%voipRoute);

  # Skip this network if it belongs to MonkNet
  goto END if skip_networks($route_obj, \%monkRoute);

  # Figure out which addresses are live
  ($alive, $dead, $unknown, $error) = ping_route($route_obj);

  # Build list of addresses within this route
  $addresses = $route_obj->hostenumref();
  say "$route_obj contains ", scalar @$addresses, ' addresses' if $debug > 3;

  # Walk the hosts in this route
  log_it("Beginning gather_netbios_name walk on $route_obj");
  say "Walking $route_obj" if $job eq 'interactive';
  ADDR:
  for my $addr (@$addresses) {
    my ($addr_obj, $ip, $machine, $nb, $ns);

    # Extract the IP address
    ($ip) = ($addr =~ /(\d+\.\d+\.\d+\.\d+)\/32/);

    # Sometimes, $ip is malformed; I don't understand how this happens
    unless (validaddr($ip)) {
      log_it("Problem with IP $ip in get_netbios_name") if defined $ip;
      next ADDR;
    }

    # Skip this IP unless it responded to a ping
    next ADDR unless any { $_ eq $ip } @$alive;

    # Don't bother asking routers for their NetBios name
    eval { $addr_obj = NetAddr::IP->new($ip, $mask) };
    if ($@ or not defined $addr_obj) {
      log_it("Bad address $ip / $mask: $@");
      next ADDR;
    }
    next ADDR if flag_router($addr_obj);

    # Debug info
    say "Doing $ip" if $debug == 8;

    # Query local NetBIOS name table.  Net::NBName does not handle various 
    # abnormal responses gracefully, so disable 'unitialized value' warnings 
    # before invoking it
    $nb = Net::NBName->new();
    no warnings qw(uninitialized);
    $ns = $nb->node_status($ip);
    use warnings qw(all);

    # If the node did not respond to the query
    if (not defined $ns) {
      say "  $ip did not answer a node status query" if $debug == 8;

      # Consult WINS
      if (defined $wins{$ip}) {
        $netBiosName{$ip} = $wins{$ip};
        say "  Using WINS $machine" if ($debug == 4 or $debug == 8);
      }

      # Wipe its entry
      else {
        say "  Will delete NetBIOS entries" if $debug == 8;
        $netBiosName{$ip} = $DASH;
        $netBiosUser{$ip} = $DASH;
      }

      # Skip to the next address
      next ADDR;
  
    }  # End 'if the node did not respond to the query'


    # Otherwise, the node did respond to the query: parse the results for a 
    # machine name
    say $ns->as_string if $debug == 8;
    ($machine) = ($ns->as_string =~ /(.*)\s*<00>\s+UNIQUE/);

    # If the node reports a machine name, use it
    if (defined $machine) {
      ($machine = $machine) =~ s/\s+\Z//g;  # Strip trailing spaces
      say "  Calls itself $machine" if ($debug == 4 or $debug == 8);
    }

    # If the node does not report a workstation name
    else {

      # Consult WINS
      if (defined $wins{$ip}) {
        $machine = $wins{$ip};
        say "  Responded but without specifying a name, using WINS $machine" if ($debug == 4 or $debug == 8);
      }

      # Wipe this entry
      else {
        $machine = $DASH;
        say "  Responded but without specifying a name and no entry in WINS" if ($debug == 4 or $debug == 8);
      }

    }  # End 'If the node did not report a workstation name'
    
    # Look for NetBIOS logged on user and MAC address
    
    # Dump node status query response into an array
    my (@as_string, $mac, $user);
    @as_string = split ($CR, $ns->as_string);

    # Walk through the response, extracting juicy tidibts
    LINE:
    for my $line (@as_string) {
      say "line = $line" if $debug == 8;
      next LINE if $line =~ / GROUP /;      # Skip workgroup info

      # If the line contains the MAC address, record it
      if ($line =~ /MAC Address =/) {
        ($mac) = ($line =~ /MAC Address = (.*$)/);
        say "  MAC address is '$mac'" if ($debug == 4 or $debug == 8);
      }

      # If the line contains the logged-on username, record for it
      elsif ($line =~ /\<03\>/) {
        ($user) = ($line =~ /^(.*)\s+<03>\s+UNIQUE/);
        if (defined $user) {
          ($user = $user) =~ s/\s//g;
          say "  Logged on user $user" if ($debug == 4 or $debug == 8);
        }
      }

    }  # End 'Walk through the response, extracting juicy tidbits'

    # Save the results
    $mac               = normalize_mac($mac)   if defined $mac;
    $netBiosMac{$ip}   = $mac                  if defined $mac;
    $netBiosName{$ip}  = $machine              if defined $machine;
    $netBiosUser{$ip}  = $user                 if defined $user;

    # Sometimes, I like to track what I'm finding in syslog
    # log_it("$netBiosName{$ip}") if defined $netBiosName{$ip};
  
    # Debug info
    if ($debug == 4 or $debug == 8) {
      say "netBiosName{$ip} = $netBiosName{$ip}" if defined $netBiosName{$ip};
      say "netBiosUser{$ip} = $netBiosUser{$ip}" if defined $netBiosUser{$ip};
      say "netBiosMac{$ip}  = $netBiosMac{$ip}"  if defined $netBiosMac{$ip};
    }  # End 'Debug info'

  }  # End 'walk the hosts on this route'

  # Leave tracks
  log_it("Ending gather_netbios_name walk on $route_obj");

  END:

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

  return 1;
}




1;