#!/opt/vdops/bin/perl

# This script pokes through yesterday's syslog, looking for Tipping Point 
# IPS lines.  It summarizes what it finds and sends e-mail to those who 
# wish to be notified about such events

# V      Who       When        What
# ---------------------------------------------------------------------------
# 1.7.2  skendric  05-01-2011  More debugging
# 1.7.1  skendric  04-12-2011  Handle arbitrary filter id code length
# 1.7.0  skendric  08-16-2010  Update to new severity categorization scheme
# 1.6.0  skendric  08-03-2010  Migrate back to BLK format
# 1.5.1  skendric  08-02-2010  More debugging
# 1.5.0  skendric  08-01-2010  Migrate to SMS 2.5 format
# 1.4.1  skendric  05-21-2010  Suppress mail to owners when running 
#                              interactively
# 1.4.0  skendric  03-30-2010  Upgrade to perl 5.10.1
# 1.3.9  skendric  11-09-2009  Skip TP mgmt-related lines
# 1.3.8  skendric  06-12-2009  Skip unrelated lines from syslog
# 1.3.7  skendric  05-07-2009  Customize 10.0.0.0/8 by institution name
# 1.3.6  skendric  05-06-2009  Discover input file programmatically
# 1.3.5  skendric  01-26-2009  Support new get_yesterday function
# 1.3.4  skendric  12-05-2008  Skip named lines
# 1.3.3  skendric  07-02-2008  Skip smtpd and postfix lines
# 1.3.2  skendric  01-21-2008  More debugging
# 1.3.1  skendric  12-16-2007  Handle days with no high severity events
# 1.3.0  skendric  12-14-2007  Log high severity events
# 1.2.3  skendric  10-29-2007  Handle filter numbers with no leading zeros
# 1.2.2  skendric  09-28-2007  Fiddle with report format
# 1.2.1  skendric  09-07-2007  Improve filter_num regex
# 1.2.0  skendric  08-17-2007  Send customized report to owners
# 1.1.0  skendric  07-31-2007  Add support for filtering via major category
# 1.0.7  skendric  06-12-2007  Exclude machines with known behavior
# 1.0.6  skendric  05-29-2007  More robust handling of case where filter_id 
#                              and filter_num are different
# 1.0.5  skendric  05-15-2007  Strip leading zeros from IP addresses
# 1.0.4  skendric  04-30-2007  Support archived reports
# 1.0.3  skendric  04-25-2007  Error checking, sort output by IP address
# 1.0.2  skendric  04-23-2007  Handle hosts with multiple classes of infections
# 1.0.1  skendric  04-20-2007  Handle hosts with multiple infections
# 1.0.0  skendric  04-11-2007  First Version
#

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

#
# This script takes the following approach:
#     -Extracts lines from syslog related to Tipping Point IPS
#     -Counts them
#     -Notifies relevant people
#     -Prints a report
#
# Requirements:
#     -PERL modules:  FHCRC::VDOPS::Utilities;
#
#
# 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 "examine-ips-logs" to see the command-line 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 Compress::Zlib;
use Data::Dumper;
use Data::Validate::IP qw(is_ipv4);
use English qw( -no_match_vars );
use Getopt::Std;
use List::MoreUtils qw(any);
use Mail::Send;
use NetAddr::IP;
use Net::IPAddress;
use Net::Netmask;
use Regexp::Common;
use Sys::Hostname;
use Time::localtime;
use FHCRC::Netops::HostTools 1.0.4;
use FHCRC::Netops::NetopsData 1.4.0;
use FHCRC::Netops::NetopsTools 2.2.3;
use FHCRC::Netops::Utilities 1.4.4;

# Declare global variables
my %activity;           # Hash of integers recording the number of malware 
                        # events logged for this IP address
my @enforcement_point;  # List of the TippingPoint enforcement nodes whose 
                        # messages we want to inspect
my %extract;
my %infected;           # Hash of hashes, counting malware, keyed by IP address
my $input_file;         # Location of compressed syslog
my @internal_networks;  # List of internal IP spaces
my $log_file;           # Location of log file recording history
my $log_owner;          # E-mail address which appens to $log_file
my %loved_lepers;       # Hash of infected IP addresses keyed by owner 
                        # e-mail alias
my %major_cat;          # Hash of 
my %major_cat_def;      # Definition of major category codes
my %minor_cat_def;      # Definition of minor category codes
my @mgmt_box;           # Hostnames of the Tipping Point management consoles
my %owner;              # Hash of arrays, where the keys are the e-mail 
                        # addresses of people interested in knowing which 
                        # boxes are infected in the subnets listed in the 
                        # array
my %platform_def;       # Definition of platform codes
my %protocol_def;       # Definition of protocol codes
my $report_base;        # String which defines the base name of the report file
my $report_dir;         # Name of report directory
my $report_file;        # Name of report file (constructed from other variables)
my $report_url;         # URL which points to the report_file
my %severity_threshold; # The threshold at which this owner wants to receive 
                        # a report
my %skip_machines;      # Machines which we skip, due to known behavior
my @skip_text;          # Strings which we skip, due to known legitimate 
                        # traffic

# 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 = 'examine-ips-logs';
$usage = 'Usage:  examine-ips-logs -s {yes|no} [-d {integer}] -r';
$version = '1.7.2';

# Our internal networks
given (hostname) {
  when (/colossus/) {
    @internal_networks = qw{ 10.0.0.0/8       72.14.32.0/19
                             192.168.0.0/16   10.22.240.0/20
                            };
  }
  when (/pooh/)      { @internal_networks = qw{ 10.0.0.0/8 10.22.0.0/16 } }
  when (/guru/)      { @internal_networks = qw{ 10.0.0.0/8 10.22.0.0/16 } }
}
die 'Unable to define internal_networks' unless @internal_networks > 0;


# Input file
given (hostname) {
  when (/guru/)      { $input_file = '/home/netops/syslog.0.gz' }
  when (/pooh/)      { $input_file = '/loghost/log/syslog.0'      }
  when (/colossus/)  { $input_file = '/var/log/syslog.0.gz'       }
  default            { $input_file = '/var/log/syslog.0.gz'       }
}

# Device names
@enforcement_point = qw/shield-a-ips shield-b-ips/;
@mgmt_box = qw/ips-mgmt tip-con/;

# Report stuff
$institution    = 'Widgets International, Inc.';
$log_file       = '/home/itreport/logs/internally-infected-hosts.log';
$log_owner      = 'frontdesk@widgets.com';
$report_base    = 'internally-infected-hosts';
$report_dir = '/home/itreport/serena/vox/itprof/reports/security/ips_log';
$report_queries = 'frontdesk@widgets.com';
$report_subject = 'Internally Infected Hosts Report';
$report_url = 'http://intranet.widgets.com/AP/it/nag/reports/security/widgets_ips_log';

# Tipping Point code defintions
%major_cat_def = (
                  '1' => 'Interesting',
                  '2' => 'Information disclosure',
                  '3' => 'DoS',
                  '4' => 'Remote Code Execution'
                 );


# Calculate $report_file
$report_file    = get_yesterday() . $DASH . $report_base . '.txt';

# Report recipients
%owner = (
   'bsmith@widgets.com'    => [ '10.0.0.0/8',       '192.168.0.0/16' ],
   'sjones@widgets.com'    => [ '10.10.0.0/16'                       ],
         );

# Severity threshold
%severity_threshold = (
   'bsmith@widgets.com'    => 2,
   'sjones@widgets.com'    => 1,
         );

# Skip stuff
%skip_machines = (
                    '10.22.58.48'  => 'pooh',
                    '10.22.64.121' => 'guru',
                 );
@skip_text = qw//;

# Grab arguments
getopts('d:l:rs:', \%option);


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


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

{
  process_args();                  # Check arguments

  sanity_check();                  # Check for problems

  parse_input_file();              # Find interesting messages

  count_results();                 # Sort by activity level

  associate_owners_with_lepers();  # Associate infected machines with owners

  notify_owners();                 # Tell people about infected boxes

  write_log();                     # Append to the log

  write_report();                  # Produce the report
}

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



########################################################################
# Associate owners with lepers
########################################################################
sub associate_owners_with_lepers {

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

  # Notify operator
  say 'Associating owners with infected machines...' if $mode eq 'interactive';

  # Walk through interested people
  for my $owner (keys %owner) {
    my @network_objs;
    say "Processing $owner" if $debug;

    # Create list of NetAddr::IP objects for specified networks
    for my $net (@{$owner{$owner}}) {
      my ($network, $mask);
      ($network, $mask) = split('/', $net);
      push @network_objs, NetAddr::IP->new($network, $mask);
      say "  owns $network / $mask" if $debug == 8;
    }

    # Walk through the infected addresses
    for my $ip (keys %activity) {
      my $addr_obj = NetAddr::IP->new($ip);

      # Walk network objects
      NETWORK:
      for my $network_obj (@network_objs) {

        # If this address belongs to this network, dig out the severity
        if ($addr_obj->within($network_obj)) {
          say "    ip $addr_obj lies within $network_obj" if $debug == 8;
          my $major_ref = $infected{$ip};
          say "      loves $ip" if $debug > 3;

          # Walk severities
          for my $major (keys %$major_ref) {
            if ($major >= $severity_threshold{$owner}) {
              say '        enough to hear about it' if $debug > 5;
              push @{$loved_lepers{$owner}}, $ip;
              print $BANG if ($mode eq 'interactive' and not $debug);
            }
          } 

        }

      }  # End walk network objects

      # Entertain the operator
      print $DOT if ($mode eq 'interactive' and not $debug);;

    }  # End walk infected addresses

  }  # End walk interested people
      

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

  # Debug info
  if ($debug > 2) {
    say 'Dumping %loved_lepers';
    say Dumper(%loved_lepers);
  }

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

  return 1;
}




########################################################################
# Count events by class and IP address
########################################################################
sub count_results {

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

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

  # For each IP address
  for my $ip (keys %infected) {
    my $major_ref = $infected{$ip};

    # For each major category
    for my $major (keys %$major_ref) {
      my $class_ref = $major_ref->{$major};

      # For each class
      for my $class (keys %$class_ref) {
        my $flavor_ref = $class_ref->{$class};

        # For each flavor of each class, count how many events we have recorded
        for my $flavor (keys %$flavor_ref) {
          $activity{$ip} += $flavor_ref->{$flavor};
          print $BANG if $mode eq 'interactive';
        }

      }

    }

  }

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

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

  return 1;
}




########################################################################
# Notify owners
########################################################################
sub notify_owners {
  my $handle;
  my $date;

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

  # Define local variables
  $date = get_yesterday('long');

  # Notify operator
  say 'Notifying owners...' if $mode eq 'interactive';

  # Unless we are serious, skip ahead
  unless ($dome) {
    say 'Just kidding';
    goto END;
  }

  # Tell people about their infected boxes
  for my $owner (keys %loved_lepers) {
    say "  Considering $owner" if $debug;

    # If we found infected boxes belonging to this person, send him/her mail
    if (@{$loved_lepers{$owner}} > 0) {
      my $msg;

      # Notify operator
      say "  Sending mail to $owner" if $mode eq 'interactive';

      # Build message header.  If we are running interactively, only address 
      # messages to $log_owner
      $msg = Mail::Send->new();
      given ($mode) {
        when ('interactive') { $msg->to($log_owner) }
        default              { $msg->to($owner)     }
      }
      $msg->subject($report_subject);

      # Build message body
      $handle = $msg->open;
      print {$handle} <<EOF;

IP Address       Hostname              S  Class         Hits   Description
---------------  --------------------  -  ------------  -----  -------------------------------------------
EOF
      # Walk addresses
      for my $ip ( sort_by_ip_address(@{$loved_lepers{$owner}}) ) {
        my ($first, $host);

        $first = 1;
        $host = get_nodename($ip);
        $host = $QUERY unless defined $host;

        printf {$handle} "%-15s  %-20s", $ip, $host;
        my $major_ref = $infected{$ip};
    
        # Walk the major categories of malware for this IP address
        for my $major (sort keys %$major_ref) {
          my $major_abbr = substr $major_cat_def{$major}, 0, 4;
          my $class_ref = $major_ref->{$major};
    
          # Walk the classes of malware for this major category
          for my $class (keys %$class_ref) {
            my $class_abbr = substr $class, 0, 12;
            my $flavor_ref = $class_ref->{$class};
    
            # Walk the particular flavors of this class
            for my $flavor (sort keys %$flavor_ref) {
              my $malware = substr $flavor, 0, 43;
              my $count = $flavor_ref->{$flavor};
    
              if ($first == 1) {
                printf {$handle} "  %1d  %-12s  %5d  %-43s\n",
                    $major, $class_abbr, $count, $malware;
                $first = 0;
              }
              else {
                printf {$handle} "                                       %1d  %-12s  %5d  %-43s\n",
                    $major, $class_abbr, $count, $malware;
              }
    
            }  # End 'walk flavors'
    
          }  # End 'walk classes'
    
        }  # End 'walk major categories'


      }  # End 'walk addresses'

      # Print instructions
      print $handle "\n\n";
      print {$handle} <<EOF;

Hello $owner,

You have elected to receive mail about machines infected with malware of 
severity level $severity_threshold{$owner} or higher on the following subnets:
	@{$owner{$owner}}

If you would like to change these preferences, send mail to $log_owner

The Intrusion Prevention Servers blocked severity level $severity_threshold{$owner} or worse outbound activity from the addresses listed below on $date.

For the Center-wide report, see $report_url/$report_file

For what is happening today, see http://toc.widgets.com/logs/ips.shtml

# 'S' Severity Level Definitions:
#     4 = Remote Code Execution, privilege escalation, and other yuckies
#     3 = Crash / DoS
#     2 = Reconnaissance (open ports, enumerate user names, identify versions)
#     1 = Informational (P2P, local policy)
#
# Class = A one word categorization for this type of malware
#
# Hits = The number of times this IP address attempted to perform this
#        behavior during the twenty-four hours covered by this report
#
EOF
      # Print closure
      print $handle "\n\n";
      print $handle "                    --frontdesk\@widgets.com ($PROGRAM_NAME)";

      # Send message
      $handle->close or warn "Could not send message: $!"; 

    }  # End sending mail

  }  # End walk infected boxes for whom we have owners
      
  END:

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

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

  return 1;
}




########################################################################
# Parse logfile
########################################################################
sub parse_input_file {
  my $gz;
  my $line;
  my %remove;

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

  # Notify operator
  say 'Parsing logfile...' if $mode eq 'interactive';

  # Read logfile
  $gz = gzopen($input_file, 'rb') or die "Cannot open $input_file: $gzerrno";
  LINE:
  while ($gz->gzreadline($line) > 0) {
    my ($filter_id, $filter_num, $malware_class, $malware_name, $src);
    my ($taxonomy, $major_category, $minor_category, $protocol, $platform);

    # Skip firewall lines
    next LINE if $line =~/\%PIX-|\%ASA-/;

    # Skip mail lines
    next LINE if $line =~/sendmail\[\d+\]:/;
    next LINE if $line =~/smtpd\[\d+\]:/;
    next LINE if $line =~/postfix\[\d+\]:/;
    next LINE if $line =~/postfix\/smtp\[\d+\]:/;
    next LINE if $line =~/postfix\/cleanup\[\d+\]:/;
    next LINE if $line =~/named\[\d+\]:/;
    
    # Skip network management lines
    next LINE if $line =~ /nodewatch:|tocops|apager/;
    next LINE if $line =~ /mgmt:/;

    # Skip if this line emanates from a Tipping Point management console
    next LINE if any { $line =~ /$_/ } @mgmt_box;

    # Skip unless this line emanates from a Tipping Point enforcement point
    next LINE unless any { $line =~ /$_/ } @enforcement_point;

    # Skip unless this is a block message
    next LINE unless $line =~ /BLK/;

    # Strip date and time
    ($line) = ($line =~ /^\w+\s+\d+\s+\d\d:\d\d:\d\d\s+(.*)/);

    # Find category code
    ($taxonomy) = ($line =~ /(\d+)T\d+/);
    say "Undefined taxonomy:  $line" unless defined $taxonomy;
    next LINE                        unless defined $taxonomy;

    # Parse category
    $major_category = int($taxonomy / 16777216);
    $taxonomy       = $taxonomy - ($major_category * 16777216);
    $minor_category = int($taxonomy / 65536);
    $taxonomy       = $taxonomy - ($minor_category * 65536);
    $protocol       = int($taxonomy / 256);
    $taxonomy       = $taxonomy - ($protocol * 256);
    $platform       = $taxonomy;
    say "Undefined major category: $line"    unless defined $major_category;
    say "Undefined minor category: $line"    unless defined $minor_category;
    say "Undefined protocol category: $line" unless defined $protocol;
    say "Undefined platform category: $line" unless defined $platform;
    next LINE unless (defined $major_category and defined $minor_category and
                      defined $protocol       and defined $platform);

    # Find filter_id
    ($filter_id) = ($line =~ /\s+"(\w+):\s/);
    unless (defined $filter_id) {
      say "Undefined filter_id: $line";
      next LINE;
    }

    # Find filter_num
    ($filter_num) = ($line =~ /$filter_id:\s.*?\s+"(\w+):\s+/);
    unless (defined $filter_num) {
      say "Undefined filter_num: $line";
      next LINE;
    }

    # Extract malware class/name and IP address
    ($malware_class, $malware_name) 
        = ($line =~ /"$filter_id:\s+(.*?):\s+(.*?)"/);
    unless (defined $malware_class) {
      say "Undefined malware_class: $line";
      next LINE;
    }

    # If we didn't find malware_class, grab the first word from malware_name
    ($malware_class) 
        = ($malware_name =~ /^(\w+)/) unless defined $malware_class;

    # Extract IP address
    ($src) = ($line =~ /\d+\.\d+\.\d+\.\d+.*?(\d+\.\d+\.\d+.\d+)/);
    unless (defined $src) {
      say "Undefined src = $line";
      next LINE;
    }

    # Skip unless this line involves an internal source
    next LINE unless inside_our_network($src, \@internal_networks);

    # Skip if we know about this machine
    next LINE if exists $skip_machines{$src};

    # Debug info
    say "\nFor $src, $malware_class:  $malware_name" if $debug == 8;

    # Count the results
    say "\nFor $src, severity = $major_category, $malware_class: $malware_name" if $debug == 4;
    $infected{$src}->{$major_category}->{$malware_class}->{$malware_name}++;

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

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

  # Clean-up
  warn "Error reading from $input_file: $gzerrno" if $gzerrno != Z_STREAM_END;
  $gz->gzclose();

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

  return 1;
}




########################################################################
# Process arguments
########################################################################
sub process_args {

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

  # Notify operator
  print_it("Beginning $PROGRAM_NAME\n");

  # Are we serious?
  unless ($option{s}) {
     say 'Must specify -s {yes|no}';
     die "$usage\n";
  }
  given ($option{s}) {
    when ('yes') { $dome = 1 }
    when ('no')  { $dome = 0 }
    default {
      say "The -s option must be either 'yes' or 'no'";
      die "$usage\n";
    }
  }

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

  # Check log file 
  $input_file = $option{l} if defined $option{l};
  unless (-r $input_file) {
    say "Cannot read $input_file";
    die "$usage\n";
  }


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




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

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

  # Walk owner, checking IP addresses
  for my $owner (keys %owner) {
    for my $block (@{$owner{$owner}}) {
      my ($addr, $obj);
      $obj = NetAddr::IP->new($block);
      die "$block is malformed" unless defined $obj;
      $addr = $obj->addr();
      die "$addr is malformed" unless is_ipv4($addr);
    }
  } 

  # Walk owner, checking severity levels
  for my $owner (keys %owner) {
    my $thresh = $severity_threshold{$owner};
    die "Must define a severity threshold for $owner"
        unless defined $thresh;
    die "Severity threshold for $owner must be an integer" 
        unless $RE{num}{int}->matches($thresh);
    die "Severity threshold for $owner must be > 0" if $thresh < 1;
    die "Severity threshold for $owner must be < 9" if $thresh > 8;
  }

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

  return 1;
}




########################################################################
# Write log
########################################################################
sub write_log {
  my $handle;
  my $date;

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

  # Define local variables
  $date = get_yesterday();

  # Notify operator
  say 'Appending to log file...' if $mode eq 'interactive';

  # Unless we are serious, skip ahead
  unless ($dome) {
    say 'Just kidding';
    goto END;
  }

  # Open log file
  unless (open $handle, '>>', $log_file) {
    say "Cannot append to $log_file: $!";
    goto END;
  }

  # If we found infected boxes belonging to $log_owner, append to $log_file
  if (defined $loved_lepers{$log_owner} and @{$loved_lepers{$log_owner}} > 0) {

    # Walk addresses
    for my $ip ( sort_by_ip_address(@{$loved_lepers{$log_owner}}) ) {
      my $host;

      $host = get_nodename($ip);
      $host = $QUERY unless defined $host;

      my $major_ref = $infected{$ip};
  
      # Walk the major categories of malware for this IP address
      for my $major (sort keys %$major_ref) {
        my $major_abbr = substr $major_cat_def{$major}, 0, 4;
        my $class_ref = $major_ref->{$major};
  
        # Walk the classes of malware for this major category
        for my $class (keys %$class_ref) {
          my $class_abbr = substr $class, 0, 12;
          my $flavor_ref = $class_ref->{$class};
  
          # Walk the particular flavors of this class
          for my $flavor (sort keys %$flavor_ref) {
            my $malware = substr $flavor, 0, 43;
            my $count = $flavor_ref->{$flavor};
  
            printf {$handle} "%-10s  %-15s  %-20s  %1d  %-12s  %5d  %-43s\n",
                $date, $ip, $host, $major, $class_abbr, $count, $malware;
  
          }  # End 'walk flavors'
  
        }  # End 'walk classes'
  
      }  # End 'walk major categories'

    }  # End 'walk addresses'


  }  # End appending to log file
      
  END:

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

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

  return 1;
}




########################################################################
# Produce the report
########################################################################
sub write_report { 
  my $date;
  my $handle;
  my $total = scalar keys %activity;
  
  # Debug trace
  trace_location('begin') if $debug;

  # Define variables
  $date = get_yesterday();

  # Notify operator
  print_it("Writing report...\n");
    
  # Direct output to screen or to file
  if ($mode eq 'interactive') {
    $handle = *STDOUT;
  }
  else {
    my $file = $report_dir . $SLASH . $report_file;
    open $handle, '>', $file or die "Cannot open $file: $!\n";
  }


print {$handle} <<EOF;
# Title:           $report_subject
#
# Institution:     $institution
#
# Date of Report:  $date
#
# Description:     This report lists the internal IP addresses for which the 
#                  Intrusion Prevention Servers are blocking outbound activity
#
# Active:          $total
#
# Questions:       If you have questions or comments regarding this
#                  report, please mail them to $report_queries.
#
# 'S' Severity Level Definitions:
#     4 = Vulnerability       Attempt to exploit known vulnerability
#     3 = Malicious Code      Viruses, worms, trojans, backdoors
#     2 = DDoS                Zombie or bot behavior
#     1 = Policy              Locally defined, typically P2P, IM, IRC
#
# Class = A one word categorization for this type of malware
#
# Hits = The number of times this IP address attempted to perform this 
#        behavior during the twenty-four hours covered by this report
#
IP Address      S Class        Hits  Description
--------------- - ------------ ----- -------------------------------------------
EOF

  # Descending sort of IP addresses based on activity level
  for my $ip (reverse sort { $activity{$a} <=> $activity{$b} } keys %activity) {
    my $first = 1;
    printf {$handle} "%-15s ", $ip;
    my $major_ref = $infected{$ip};

    # Walk the major categories of malware for this IP address
    for my $major (sort keys %$major_ref) {
      my $major_abbr = substr $major_cat_def{$major}, 0, 4;
      my $class_ref = $major_ref->{$major};

      # Walk the classes of malware for this major category
      for my $class (keys %$class_ref) {
        my $class_abbr = substr $class, 0, 12;
        my $flavor_ref = $class_ref->{$class};

        # Walk the particular flavors of this class
        for my $flavor (sort keys %$flavor_ref) {
          my $malware = substr $flavor, 0, 43;
          my $count = $flavor_ref->{$flavor};

          if ($first == 1) {
            printf {$handle} "%1d %-12s %5d %-43s\n",
                $major, $class_abbr, $count, $malware;
            $first = 0;
          }
          else {
            printf {$handle} "                %1d %-12s %5d %-43s\n",
                $major, $class_abbr, $count, $malware;
          }

        }  # End 'walk flavors'

      }  # End 'walk classes'

    }  # End 'walk major categories'

  }  # End 'walk IP addresses'

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

  # Notify operator
  print_it("Ending $PROGRAM_NAME\n");

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

  return 1;
}




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

  $usage

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

EOF

  return 1;
}




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