#!/opt/vdops/bin/perl

# This script queries Intel specific variables and produces a report 
# identifying salient issues.

# V      Who       When        What
# ---------------------------------------------------------------------------
# 1.6.1  skendric  2011-02-23  Fiddle with alarms
# 1.6.0  skendric  2011-02-21  Upgrade to Netops 1.4.0
# 1.5.2  skendric  2010-12-30  Add @insane to report
# 1.5.1  skendric  2010-12-17  Futz with owner/owner_backup
# 1.5.0  skendric  2010-01-26  Upgrade to perl 5.10.1
# 1.4.0  skendric  2009-04-20  Use color to highlight issues
# 1.3.4  skendric  2009-04-19  Distinguish between silent and unresponsive
# 1.3.3  skendric  2009-04-14  Add alarming on link, duplex, and type
# 1.3.2  skendric  2009-04-08  Focus purely on Intel
# 1.3.1  skendric  2009-03-20  Add @down_for_maintenance
# 1.3.0  skendric  2009-03-18  Begin adding Broadcom support
# 1.2.0  skendric  2009-03-11  Support arbitrary number of NICs
# 1.1.0  skendric  2009-03-11  Support seven NICs
# 1.0.2  skendric  2007-12-07  Add owner
# 1.0.1  skendric  2007-03-21  Stylistic mods 
# 1.0.0  skendric  2007-01-14  First Version
#

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

#
# This script takes the following approach:
#      -Parses the hosts table for a list of targets (or accepts a command-
#       line list)
#      -Queries a bunch of Intel-specific variables
#      -Produces a report
#
#
# Requirements:
#     -The target(s) must be pingable
#
#     -PERL modules:  the WI::Netops collection
#
#
# Assumptions:
#
#
# Tested on:
#        -mibVersion 1.4.3
#        -perl-5.12.2
#        -net-snmp-5.6
#
#
# Instructions:
#       -Customize the script for your site:  find the 'user-configurable
#        variables' section and modify as appropriate
#       -Try it out
#
#
#
# Caveats:
#
#
# Known Bugs:
#
#
# To do:
#

# Begin script

# Load modules
use strict;
use warnings;
#use warnings FATAL => qw(all);
use feature 'say';
use feature 'switch';
use Carp qw(carp cluck croak confess);
use Data::Dumper;
use English qw( -no_match_vars );
use Getopt::Std;
use List::MoreUtils qw(any first_index uniq);
use List::Util qw(max);
use Regexp::Common;
use WI::Netops::NetopsTools 2.2.3;
use WI::Netops::NetopsData 1.4.0;
use WI::Netops::SNMPTools 1.5.3;
use WI::Netops::Utilities 1.4.4;

# Declare global variables.  Hashes are keyed by target

# Hashes (keyed by target) of hash refs (keyed by ifIndex), 
# tracking the suitably named MIB variable from INTEL-LAN-ADAPTERS-MIB
my %adapterIndex;             
my %adapterType;             
my %adapterDriverInfo;      
my %adapterDriverLoadStatus; 
my %adapterDriverName;      
my %adapterDriverVersion;     
my %physicalAdapterIndex;     
my %physicalAdapterLinkStatus; 
my %physicalAdapterSpeed; 
my %physicalAdapterDplxMode; 
my %ansNumberOfVirtualAdapters;
my %ansTeamMode;
my %ansTeamProbesState;
my %ansTeamProbesMode;
my %ansTeamSpeed;
my %ansMemberIndex;
my %ansTeamMemberState;

# Summary variables
my $max_adapters;          # The maximum number of adapterIndex (effectively, 
                           # the number of logical interfaces) found 
                           # amongst @target
my $max_physical_adapters; # The maximum number of physicalAdapterIndex 
                           # (effectively, the number of logical interfaces) 
                           # found amongst @target
my $max_teams;             # The maximum number of TEAMs.  We don't really 
                           # support more than one, so seeing a number
                           # greater than this indicates that we skipping data
my $max_team_adapters;     # The maximum number of ansTeamIndex (effectively, 
                           # the number of TEAMs) found amongst @target
my %supportsANS;           # Boolean indicating support for the ANS 
                           # portion of the MIB
my @silent;                # Targets which did not answer pings
my @unresponsive;          # Targets which did not answer SNMP GETs

# Define global variables
$program_name = 'intel-nic-alarm';
$usage = 'Usage:  intel-nic-alarm -s {yes|no} [-d {integer}] [-a | -e {expr} | -f {filename} | target1 target2 target3 ...]'; 
$version = '1.6.1';


# Grab arguments
getopts('ad:e:f:rs:', \%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

  read_config();                        # Read Netops config file

  compile_mibs();                       # Compile MIB files

  build_target();                       # Populate @target
  
  target_check();                       # Look for errors in @target

  basic_info();                         # Gather information

  sanity_check();                       # Check for major errors

  do_the_work();                        # Gather more information

  identify_alarms();                    # Count devices with alarms

  write_alarm_log();                    # Record issues

  print_report();                       # Print report

 # notify_staff();                      # Tell staff to look at report

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


########################################################################
# Query Intel-specific variables
########################################################################
sub gather_intel_info {
  my $host = shift;
  my @indices;

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

  # Notify operator
  say "\nProcessing $host..." if $debug;

  # Walk adapterIndex
  {
    my (@array, %arg, $vb);
    say 'Walking adapterIndex' if $debug > 3;
    %arg = ( host => $host, oid => '.1.3.6.1.4.1.343.2.7.2.2.1.1.1.1' );
    $vb = snmpWalk(\%arg);

    # Walk the resulting varbind
    INDEX:
    for my $varbind (@$vb) {
      my ($index, $type, $val);
      $index = $varbind->{val};

      # Accumulate
      push @array, $index;
    } 
               
    # Save for posterity
    $adapterIndex{$host} = \@array;
    say '  adapterIndex = ', join $SPACE, @array if $debug > 1;
  }   
      
  # Populate @indices
  @indices = @{$adapterIndex{$host}};
        
  # Acquire adapterDriverLoadStatus.  If a driver isn't loaded, skip that NIC 
  # and remove from further consideration
  {
    my (%arg, @array, %hash, $type, $val);
    STATUS:
    for my $index (@indices) {
      say "Getting adapterDriverLoadStatus.$index" if $debug > 3;
      %arg = (
               host => $host,
               oid => ".1.3.6.1.4.1.343.2.7.2.2.1.1.1.4.$index"
             );
      $type = snmpGet(\%arg);

      # If not loaded, skip it
      if ($type ne 'loaded') {
        say "  Skipping unloaded adapterIndex $index" if $debug > 3;
        my (@list, $nuke);
        @list = @{$adapterIndex{$host}};
        $nuke = first_index {$_ == $index} @list;
        splice @list, $nuke, 1;
        $adapterIndex{$host} = \@list;
        next STATUS;
      }

      # Accumulate
      $hash{$index} = $type;
      push @array, $type;
    }

    # Save for posterity
    $adapterDriverLoadStatus{$host} = \%hash;
    say '  adapterDriverLoadStatus = ', join $SPACE, @array if $debug > 2;
  }


  # Repopulate @indices
  @indices = @{$adapterIndex{$host}};


  # Acquire adapterType.  If adapterType is Virtual, skip and remove 
  # that index from further consideration
  {
    my (%arg, @array, %hash, $type, $val);
    TYPE:
    for my $index (@indices) {
      
      say "Getting adapterType.$index" if $debug > 3;
      %arg = ( 
               host => $host,
               oid => ".1.3.6.1.4.1.343.2.7.2.2.1.1.1.3.$index"
             );
      $type = snmpGet(\%arg);

      # If adapterType is 'virtual', skip it
      if ($type eq 'virtual') {
        say "  Skipping virtual adapterIndex $index" if $debug > 3;
        my (@list, $nuke);
        @list = @{$adapterIndex{$host}};
        $nuke = first_index {$_ == $index} @list;
        splice @list, $nuke, 1;
        $adapterIndex{$host} = \@list;
        next TYPE;
      }

      # Accumulate
      $hash{$index} = $type;
      push @array, $type;
    }

    # Save for posterity
    $adapterType{$host} = \%hash;
    say '  adapterType = ', join $SPACE, @array if $debug > 2;
  }


  # Repopulate @indices
  @indices = @{$adapterIndex{$host}};


  # Acquire adapterDriverInfo
  {
    my (%arg, @array, %hash, $type, $val);
    INFO:
    for my $index (@indices) {

      say "Getting adapterDriverInfo.$index" if $debug > 3;
      %arg = (
               host => $host,
               oid => ".1.3.6.1.4.1.343.2.7.2.2.1.2.1.2.$index"
             );
      $val = snmpGet(\%arg);
    
      # Parse result
      given ($val) {
        when (undef) { $type = $DASH }
        default      { $type = $val  }
      }

      # If this is a BASP virtual driver, skip it
      if ($type =~ /Broadcom Advanced Server Program Driver/) {
        say "  Skipping $type / $index" if $debug > 3;
        my (@list, $nuke);
        @list = @{$adapterIndex{$host}};
        $nuke = first_index {$_ == $index} @list;
        splice @list, $nuke, 1;
        $adapterIndex{$host} = \@list;
        next INFO;
      }


      # Accumulate
      $hash{$index} = $type;
      push @array, $type;
    }

    # Save for posterity
    $adapterDriverInfo{$host} = \%hash;
    say '  adapterDriverInfo = ', join ', ', @array if $debug > 2;
  }     
                 

  # Repopulate @indices
  @indices = @{$adapterIndex{$host}};


  # Acquire adapterDriverName
  {
    my (%arg, @array, %hash, $type, $val);
    for my $index (@indices) {

      say "Getting adapterDriverName.$index" if $debug > 3;
      %arg = (
               host => $host,
               oid => ".1.3.6.1.4.1.343.2.7.2.2.1.2.1.1.$index"
             );
      $val = snmpGet(\%arg);

      # Parse result
      given ($val) {
        when (undef) { $type = $DASH }
        default      { $type = $val  }
      }

      # Accumulate
      $hash{$index} = $type;
      push @array, $type;
    }

    # Save for posterity
    $adapterDriverName{$host} = \%hash;
    say '  adapterDriveName = ', join ' ', @array if $debug > 2;
  }     
                 
  # Acquire adapterDriverVersion
  {
    my (%arg, @array, %hash, $type, $val);
    for my $index (@indices) {

      say "Getting adapterDriverVersion.$index" if $debug > 3;
      %arg = (   
               host => $host,
               oid => ".1.3.6.1.4.1.343.2.7.2.2.1.2.1.3.$index"
             );
      $val = snmpGet(\%arg);

      # Parse result
      given ($val) {
        when (undef) { $type = $DASH }
        default      { $type = $val  }
      }

      # Accumulate
      $hash{$index} = $type;
      push @array, $type;
    }

    # Save for posterity
    $adapterDriverVersion{$host} = \%hash;
    say '  adapterDriverVersion = ', join $SPACE, @array if $debug > 2;
  }

    
  # Walk physicalAdapterIndex
  {
    my (@array, %arg, $val);
    say 'Walking physicalAdapterIndex' if $debug > 3;
    %arg = (host => $host, oid => '.1.3.6.1.4.1.343.2.7.2.2.2.1.1.1');
    $val = snmpWalk(\%arg);
    for (my $i = 0; $i < @$val; $i++) {
      push @array, $val->[$i]->{iid};
    }
    $physicalAdapterIndex{$host} = \@array;
    say '  physicalAdapterIndex = ', join $SPACE, @array if $debug > 2;
  }


  # Acquire physicalAdapterLinkStatus
  {
    my (%arg, @array, %hash, $type, $val);
    for my $index (@indices) {
      say "Getting physicalAdapterLinkStatus.$index" if $debug > 3;
      %arg = (
               host => $host,
               oid => ".1.3.6.1.4.1.343.2.7.2.2.2.1.1.2.$index"
             );
      $type = snmpGet(\%arg);
      unless ($type eq 'link-up') {
        if ($adapterDriverLoadStatus{$host}->{$index} eq 'loaded') {
          $alarm_count{$host}++;
          log_it("For $host, physicalAdapterIndex.$index sees $type");
        }
      }

      # Accumulate
      $hash{$index} = $type;
      push @array, $type;
    } 
               
    # Save for posterity
    $physicalAdapterLinkStatus{$host} = \%hash;
    say '  physicalAdapterLinkStatus = ', join $SPACE, @array if $debug > 2;
  }
      
  # Acquire physicalAdapterSpeed
  {     
    my (%arg, @array, %hash, $type, $val);
    for my $index (@indices) {
      say "Getting physicalAdapterSpeed.$index" if $debug > 3;
      %arg = (
                host => $host,  
                oid => ".1.3.6.1.4.1.343.2.7.2.2.2.1.1.4.$index"
             );
      $type = snmpGet(\%arg);

      # Accumulate
      $hash{$index} = $type;
      push @array, $type;
    }

    # Save for posterity
    $physicalAdapterSpeed{$host} = \%hash;
    say '  physicalAdapterSpeed = ', join ', ', @array if $debug > 2;
  }

  # Acquire physicalAdapterDplxMode
  {
    my (%arg, @array, %hash, $type, $val);
    for my $index (@indices) {
      $type = snmpGet({host => $host, oid => "physicalAdapterDplxMode.$index"});

      # Analyze the result, logging and alarming
      given ($type) {
        when ('na') {
          say "For $host, physicalAdapterDplxMode is $type, which is bad" if $debug;
          log_it("physicalAdapterDplxMode is $type");
          $alarm_count{$host}++;
        }
        when ('half') {
          say "For $host, physicalAdapterDplxMode is $type, which is possibly good, if this is a heartbeat connection" if $debug;
        }
        when ('full') {
          say "For $host, physicalAdapterDplxMode is $type, which is good" if $debug;
        }
        when (undef) {
          given ($adapterDriverInfo{$host}->{$index}) {
            when (/Broadcom/) {
              say "For $host, we cannot determine physicalAdapterDplxMode.  But since the driver is Broadcom, let's ignore this and hope for the best" if $debug;
              $type = $QUERY;
            }
            default {
              say "For $host, physicalAdapterDplxMode is undefined, which is bad" if $debug;
              log_it("physicalAdapterDplxMode is undefined");
              $type = $QUERY;
              $alarm_count{$host}++;
            }
          }
        }
        default {
          say "For $host, physicalAdapterDplxMode is type, which is odd" if $debug;
          log_it("physicalAdapterDplxMode is $type");
          $alarm_count{$host}++;
        }
      }
    
      # Accumulate
      $hash{$index} = $type;
      push @array, $type;
    }

    # Save for posterity
    $physicalAdapterDplxMode{$host} = \%hash;
    say '  physicalAdapterDplxMode = ', join $SPACE, @array if $debug > 2;
  }

  # Gather ANS Team parameters if supported
  {
    my (%arg, $val);
    say 'Getting ansNumberOfVirtualAdapters.0' if $debug > 3;
    %arg = ( host => $host, oid => '.1.3.6.1.4.1.343.2.7.2.2.4.1.1.3.0' );
    $val = snmpGet(\%arg);
    if (defined $val and $val ne $EMPTY_STR and $RE{num}{int}->matches($val)) {
      $supportsANS{$host} = 1;
    }
    else {
      $supportsANS{$host} = 0;
      log_it("$host does not support ANS");
      goto END;
    }
    log_it("Warning: $host supports more than one team") if $val > 1;
    $ansNumberOfVirtualAdapters{$host} = $val;
  }

  # Acquire ansTeamMode
  {
    my (%arg, $val, $type);
    say 'Getting ansTeamMode.0' if $debug > 3;
    %arg = (host => $host, oid => '.1.3.6.1.4.1.343.2.7.2.2.4.3.1.2.0');
    $type = snmpGet(\%arg);

    # Analyze result, logging and alarming
    given ($type) {
      when ('adapter-fault-tolerance') {
        say "$host ansTeamMode.0 = $type, which is good" if $debug;
      }
      when ('adaptive-load-balancing') {
        say "$host ansTeamMode.0 = $type, which is good" if $debug;
      }
      when ('static-link-aggregation') {
        say "$host ansTeamMode.0 = $type, which is broken" if $debug;
        log_it("For $host, ansTeamMode.0 is $type");
        $alarm_count{$host}++;
      }
      when ('iEEE-802-3ad') {
        say "$host ansTeamMode.0 = $type, which is broken" if $debug;
        log_it("For $host, ansTeamMode.0 is $type");
        $alarm_count{$host}++;
      }
      when ('none') {
        say "$host ansTeamMode.0 = $type, which is broken" if $debug;
        log_it("For $host, ansTeamMode.0 is $type");
        $alarm_count{$host}++;
      }
      default {
        say "$host ansTeamMode.0 = $type, which suggests that this NIC is controlled by Broadcom BASP" if $debug;
      }
    }
  
    # Save for posterity
    $ansTeamMode{$host} = $type;
    say "  ansTeamMode = $type" if $debug > 1;
  } 
    
  # Acquire ansTeamProbesState
  { 
    my (%arg, $val, $type);
    $type = snmpGet( {host => $host, oid => 'ansTeamProbesState.0'} );
    unless ($type eq 'probes-enabled') {
      $alarm_count{$host}++;
      log_it("For $host, ansTeamProbesState is disabled");
    }

    # Save for posterity
    $ansTeamProbesState{$host} = $type;
    say "  ansTeamProbeState = $type" if $debug > 1;
  }

  # Acquire ansTeamProbesMode
  {
    my (%arg, $val, $type);
    $type = snmpGet( {host => $host, oid => 'ansTeamProbesMode.0'} );
    unless ($type eq 'broadcast' or $type eq 'multicast') {
      $alarm_count{$host}++;
      log_it("For $host, ansTeamProbesMode is set to $type");
    }
    
    # Save for posterity
    $ansTeamProbesMode{$host} = $type; 
    say "  ansTeamProbesMode = $type" if $debug > 1;
  }
  
  # Acquire ansTeamSpeed
  { 
    my (%arg, $val, $type);
    say 'Getting ansTeamSpeed.0' if $debug > 3;
    %arg = (host => $host, oid => '.1.3.6.1.4.1.343.2.7.2.2.4.3.1.4.0');
    $type = snmpGet(\%arg);

    # Save for posterity
    $ansTeamSpeed{$host} = $type;
    say "  ansTeamSpeed = $type" if $debug > 1;
  }

  # Walk ansMemberIndex
  {
    my (@array, %arg, $val);
    say 'Walking ansMemberIndex' if $debug > 3;
    %arg = (host => $host, oid => '.1.3.6.1.4.1.343.2.7.2.2.5.1.1.1');
    $val = snmpWalk(\%arg);
    for (my $i = 0; $i < @$val; $i++) {
      push @array, $val->[$i]->{iid};
    }
    $ansMemberIndex{$host} = \@array;
    say '  ansMemberIndex = ', join $SPACE, @array if $debug > 1;
  }   
      
  # Reset @indices
  undef @indices;
  @indices = @{$ansMemberIndex{$host}};
    
  # Acquire ansTeamMemberState
  {
    my (%arg, @array, %hash, $type, $val);
    for my $index (@indices) {
      say "Getting ansTeamMemberState.$index" if $debug > 3;
      %arg = (
               host => $host,
               oid => ".1.3.6.1.4.1.343.2.7.2.2.5.2.1.1.$index"
             );
      $type = snmpGet(\%arg);
      if ($type eq 'disabled' or $type eq $QUERY) {
        $alarm_count{$host}++;
        log_it("For $host, ansTeamMemberState is disabled or unknown");
      }

      # Accumulate
      $hash{$index} = $type;
      push @array, $type;
    }

    # Save for posterity
    $ansTeamMemberState{$host} = \%hash;
    say '  ansTeamMemberState = ', join $SPACE, @array if $debug > 1;;
  }
        
  END:

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

  return 1;
}




########################################################################
# Walk MIB variables, populating the global hashes
########################################################################
sub do_the_work {
  my @adapters;           # Number of adapterIndex instances found in each 
                          # target
  my @physical_adapters;  # Number of physicalAdapterIndex instances 
                          # found in each target
  my @remove;
  my @teams;              # Number of TEAMs found in each target
  my @team_members;       # Number of ansTeamIndex instances found in each 
                          # target

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

  # Notify operator
  say 'Querying targets...' if $mode eq 'interactive';
  unless ($dome) {
    sleep $short;
    return 1;
  }

  # Loop through targets
  TARGET:
  for my $target (@target) {

    # Debug info
    say "Processing $target..." if $debug;

    # Query lots of variables
    gather_intel_info($target);

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

  }

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

  # Identify the most number of NICs on a device
  say 'Counting NICs...' if $debug;
  for my $target (@target) {
    say "  Processing $target" if $debug > 1;  
    push @adapters, scalar @{$adapterIndex{$target}};
    push @physical_adapters, scalar @{$physicalAdapterIndex{$target}};
    if ($supportsANS{$target}) {
      push @team_members, scalar @{$ansMemberIndex{$target}};
      push @teams, $ansNumberOfVirtualAdapters{$target};
    }
    if ($debug > 2) {
      say '    ', scalar @{$adapterIndex{$target}}, ' NICs';
      say '    ', scalar @{$physicalAdapterIndex{$target}}, ' phy NICs';
      if ($supportsANS{$target}) {
        say '    ', $ansNumberOfVirtualAdapters{$target}, ' TEAMs';
        say '    ', scalar @{$ansMemberIndex{$target}}, ' TEAM NICs';
      } 
    }
  }
  $max_adapters          = max @adapters;
  $max_physical_adapters = max @physical_adapters;
  $max_teams             = max @teams;
  $max_teams             = 0 unless defined $max_teams;
  $max_team_adapters     = max @team_members;
  $max_team_adapters     = 0 unless defined $max_team_adapters;

  # Debug info
  if ($debug > 2) {
    for my $target (@target) {
      if (defined $alarm_count{$target} and $alarm_count{$target} > 0) {
        say "alarm_count{$target} = $alarm_count{$target}";
      }
    }
    say "The largest number of NICs is:           $max_adapters";
    say "The largest number of physical NICs is:  $max_physical_adapters";
    say "The largest number of TEAMs is:          $max_teams";
    say "The largest number of team NICs is:      $max_team_adapters";
    say('');
  }

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

  return 1;
}




########################################################################
# Numeric sort
########################################################################
sub numerically { $a <=> $b }





########################################################################
# Tell the operator what I discovered
########################################################################
sub print_report {
  my ($af, $uf, $wf, $zf);
  $af = '<font color="firebrick">';   # Alarm font
  $uf = '<font color="sienna1">';     # Warn font
  $uf = '<font color="F87431">';      # Warn font
  $wf = '<font color="gold">';        # Odd font
  $wf = '<font color="D4A017">';      # Odd font
  $zf = '</font>';                    # End font
  my $hdl;
  my $total = @target;
  my $now = get_now();

  # If we are running in test mode, skip this routine
  unless ($dome) {
    print_it("Running in test mode, cannot print a meaningful report\n");
    return 1;
  }

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

  # Notify the operator
  say 'Printing report...' if $debug;

  # Direct output to file
  open $hdl, '>', $report_file or die "Cannot open $report_file: $!\n";


print {$hdl} <<EOF;
<html>
<body>
<title>$report_subject</title>
<pre>
#
# Title:           $report_subject
#
# Institution:     $institution
#
# Date of Report:  $now
#
# Description:     This report describes devices equipped with Intel NICs
#
#                  Look through syslog for the details of alarms:
#                       grep $program_name /var/log/syslog
#
# Active:          $total
#
# Alarm Count:     $shit_happens
#
# In Alarm:        @alarm_list
# 
# Questions:       If you have questions or comments regarding this
#                  report, please mail them to $report_queries
#
# Notes:
#
EOF
print {$hdl} "# adapterType                = ", $uf, 'standAlone', $zf, ', ', 'teamMember', "\n";
print {$hdl} <<EOF;
#
# adapterDriverName
#
# adapterDriverVersion 
#
EOF
print {$hdl} "# physicalAdapterLinkStatus  = link-up, ", $af, 'link-down', $zf, ', ', $af, 'not-available', $zf, "\n";

print {$hdl} <<EOF;
#
# physicalAdapterSpeed       =  Vanilla Ethernet, Fast Ethernet, 
#                               Gigabit Ethernet, 10Gig Ethernet
#
EOF
print {$hdl} "# physicalAdapterDplxMode    = half, full, ", $af, 'not-available',  $zf, "\n";
print {$hdl} "#\n";
print {$hdl} "# ansTeamMode                = ", $af, 'none', $zf, ', ', 'adapter-fault-tolerant(aft), adaptive-load-balancing(alb), ', $af, 'static-link-aggregation(fec/gec)', $zf, ', ', $af, 'iEEE-802-3ad(lacp)', $zf, ', ', $af, 'switch-fault-tolerance(sft)', $zf, "\n";
print {$hdl} "#\n";
print {$hdl} "# ansTeamProbesState         = enabled, ", $af, 'disabled', $zf, "\n";
print {$hdl} "#\n";
print {$hdl} "# ansTeamProbesMode          = ", $wf, 'broadcast', $zf, ', ', 'multicast, ', $af, 'not-available', $zf, "\n";
print {$hdl} <<EOF;
#
# ansTeamSpeed               =  Vanilla Ethernet, Fast Ethernet, 
#                               Gigabit Ethernet, 10Gig Ethernet
#
EOF
print {$hdl} "# ansTeamMemberState         = active, ", $af, 'disabled', $zf, ', standby, active-secondary', "\n";
print {$hdl} <<EOF;
#
# ???                        = Device did not respond to query
# ?                          = Device does not support queries for this field 
# -                          = Not applicable to this device
#
# Black indicates normal
EOF
print {$hdl} "# $af", 'Red', $zf, " indicates problem\n";
print {$hdl} "# $uf", 'Orange', $zf, " indicates uncertainty (typically Broadcom NICs with the Intel SNMP subagent loaded, meaning this script cannot detect the teaming configuration)\n";
print {$hdl} "# $wf", 'Gold', $zf, " indicates working but could be optimized (typically choosing broadcast over multicast probes)\n";

  # Add silent devices to the report
  print {$hdl} "\n";
  print {$hdl} "<i>";
  for my $silent (sort @silent) {
    printf {$hdl} "%-15s  Not answering pings\n", $silent;
  }

  # Add unresponsive devices to the report
  for my $unresponsive (sort @unresponsive) {
    printf {$hdl} "%-15s  Not answering SNMP GETs\n", $unresponsive;
  }
  print {$hdl} "\n";
  print {$hdl} "</i>";
 
# Start the table
print {$hdl} <<EOF;
</pre>
<table border cellspacing=0 cellpadding=2>
  <tr>
    <th>Target</th>
EOF

  # Lay down Type headers
  for (my $i = 1; $i <= $max_adapters; $i++) {
    print {$hdl} "    <th>Type$i</th>\n";
  }

  # Lay down DriverInfo headers
  for (my $i = 1; $i <= $max_adapters; $i++) {
    print {$hdl} "    <th>DriverInfo$i</th>\n";
  }

#  # Lay down DriverLoadStatus headers
#  for (my $i = 1; $i <= $max_adapters; $i++) {
#    print {$hdl} "    <th>LoadStatus$i</th>\n";
#  }

  # Lay down DriverName headers
  for (my $i = 1; $i <= $max_adapters; $i++) {
    print {$hdl} "    <th>DriverName$i</th>\n";
  }

  # Lay down DriverVersion headers
  for (my $i = 1; $i <= $max_adapters; $i++) {
    print {$hdl} "    <th>DriverVersion$i</th>\n";
  }

  # Lay down physicalLinkStatus
  for (my $i = 1; $i <= $max_adapters; $i++) {
    print {$hdl} "    <th>LinkStatus$i</th>\n";
  }

  # Lay down physicalSpeed
  for (my $i = 1; $i <= $max_adapters; $i++) {
    print {$hdl} "    <th>Speed$i</th>\n";
  }

  # Lay down physicalDuplex
  for (my $i = 1; $i <= $max_adapters; $i++) {
    print {$hdl} "    <th>Duplex$i</th>\n";
  }

  # Lay down Team headings
  print {$hdl} "    <th>TeamMode</th>\n";
  print {$hdl} "    <th>ProbesState</th>\n";
  print {$hdl} "    <th>ProbesMode</th>\n";
  print {$hdl} "    <th>ProbesSpeed</th>\n";

  # ansTeamMemberState
  for (my $i = 1; $i <= $max_team_adapters; $i++) {
    print {$hdl} "    <th>TeamMemberState$i</th>\n";
  }

  # Close heading row
  print {$hdl} "  </tr>\n";


  # Walk targets, laying down cells
  TARGET:
  for my $target (@target) {
    my ($ai, $at, $adi, $als, $adn, $adv, $pi, $pls, $ps, $pdm, $tmi, $tms);
    my (@cells, @nics);

    # Debug info
    say "Processing $target..." if $debug;

    # Deference data structures
    $ai  = $adapterIndex{$target};
    $at  = $adapterType{$target};
    $adi = $adapterDriverInfo{$target};
    $als = $adapterDriverLoadStatus{$target};
    $adn = $adapterDriverName{$target};
    $adv = $adapterDriverVersion{$target};
    #$pi  = $physicalAdapterIndex{$target};
    $pls = $physicalAdapterLinkStatus{$target};
    $ps  = $physicalAdapterSpeed{$target};
    $pdm = $physicalAdapterDplxMode{$target};
    $tmi = $ansMemberIndex{$target};
    $tms = $ansTeamMemberState{$target};

    # Start the row
    print {$hdl} "  <tr>\n";

    # Add the target
    push @cells, $target;

    # adapterType
    for my $index (sort numerically @$ai) {
      given ($at->{$index}) {
        when ('teamMember')                { push @cells, $at->{$index} }
        when ('standAlone') {
          given ($adi->{$index}) {
            when (/Broadcom/) {
              push @cells, $uf . $at->{$index} . $zf;
            }
            default {
              push @cells, $af . $at->{$index} . $zf;
            }
          }
        }
        default {
          push @cells, $af . $at->{$index} . $zf;
        }
      }
    }
    for (my $i = 0; $i < ($max_adapters - scalar @$ai); $i++) {
      push @cells, $DASH;
    }

    # adapterDriverInfo
    for my $index (sort numerically @$ai) {
      push @cells, $adi->{$index};
    }
    for (my $i = 0; $i < ($max_adapters - scalar @$ai); $i++) {
      push @cells, $DASH;
    }

#    # adapterDriverLoadStatus
#    for my $index (sort numerically @$ai) {
#      push @cells, $als->{$index};
#    }
#    for (my $i = 0; $i < ($max_adapters - scalar @$ai); $i++) {
#      push @cells, $DASH;
#    }

    # adapterDriverName
    for my $index (sort numerically @$ai) {
      push @cells, $adn->{$index};
    }
    for (my $i = 0; $i < ($max_adapters - scalar @$ai); $i++) {
      push @cells, $DASH;
    }

    # adapterDriverVersion
    for my $index (sort numerically @$ai) {
      push @cells, $adv->{$index};
    }
    for (my $i = 0; $i < ($max_adapters - scalar @$ai); $i++) {
      push @cells, $DASH;
    }


    # physicalAdapterLinkStatus
    for my $index (sort numerically @$ai) {
      given ($pls->{$index}) {
        when ('link-up') { push @cells, $pls->{$index}             }
        default          { push @cells, $af . $pls->{$index} . $zf }
      }
    }
    for (my $i = 0; $i < ($max_adapters - scalar @$ai); $i++) {
      push @cells, $DASH;
    }

    # physicalAdapterSpeed
    for my $index (sort numerically @$ai) {
      push @cells, $ps->{$index};
    }
    for (my $i = 0; $i < ($max_adapters - scalar @$ai); $i++) {
      push @cells, $DASH;
    }

    # physicalAdapterDplxMode
    for my $index (sort numerically @$ai) {
      given ($pdm->{$index}) {
        when ('full') { push @cells, $pdm->{$index}             }
        default       { push @cells, $af . $pdm->{$index} . $zf }
      }
    }
    for (my $i = 0; $i < ($max_adapters - scalar @$ai); $i++) {
      push @cells, $DASH;
    }

    # Add team parameters
    given  ($supportsANS{$target}) {
      when (0) {
        push @cells, qw/- - - - - -/;
      }
      when (1) {
        given  ($ansTeamMode{$target}) {
          when (/adapt/) { push @cells, $ansTeamMode{$target}             }
          default        { push @cells, $af . $ansTeamMode{$target} . $zf }
        }
        push @cells, $ansTeamProbesState{$target};
        given  ($ansTeamProbesMode{$target}) {
          when ('broadcast') {
            push @cells, $wf . $ansTeamProbesMode{$target} . $zf;

          }
          when ('multicast') {
            push @cells, $ansTeamProbesMode{$target};
          }
          default {
            push @cells, $uf . $ansTeamProbesMode{$target} . $zf;
          }
        }
        push @cells, $ansTeamSpeed{$target};
        for (my $i = 0; $i < $max_team_adapters; $i++) {
          push @cells, $tms->{$tmi->[$i]};
        }
      }
    }

    # Now that we've built the line for this target, print the cells
    for my $cell (@cells) {
      print {$hdl} "    <th>$cell</th>\n";
    }

    # Terminate the row
    print {$hdl} "   </tr>\n";

  }  # End 'Walk targets'
  
  # Terminate table
  print {$hdl} "</table>\n";

  # Terminate HTML
  print {$hdl} "</body>\n";
  print {$hdl} "</html>\n";

  # Clean-up
  close $hdl or warn "Cannot close $report_file: $!\n";

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

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

  return 1;
}




########################################################################
# Sanity check
########################################################################
sub sanity_check {
  my @remove;

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

  # Notify operator
  say 'Sanity check...' if $mode eq 'interactive';

  # Loop through targets, identifying NIC manufacturer
  TARGET:
  for my $target (@target) {
    my (@array, $val);

    # Try Intel
    say 'Getting INTEL-LAN-ADAPTERS-MIB::company.0' if $debug > 3;
    $val = snmpGet( {host => $target, oid => '.1.3.6.1.4.1.343.2.7.2.1.1.0'} );
    unless (defined $val and $val =~ /Intel/) {
      say "$target does not contain Intel NICs, skipping" if $debug;
      print $DOT if $mode eq 'interactive';
      push @remove, $target;
      next TARGET;
    }

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

  }

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

  # Remove entries which failed checks
  prune_basic(@remove);

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

  return 1;
}




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

  See $netops_global_config (and $netops_alarm_config if this is an
  xxxx-alarm script) for configuration options

  $usage

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

    -d specifies debug level (typically 0-9)

    -r determines whether or not the script writes its report to disk

    -a instructs the script to filter the hosts table using its internally
       defined suffixes variable to produce a list of targets

    -e requires a regex as its argument, with which the script filters
       the hosts table to produce a list of targets.  Enclose the regex in 
       quotes to protect special characters from the shell

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

    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;
}