#!/opt/vdops/bin/perl

# This daemon reads a pipe, parsing whatever it receives and appending the 
# results to various TOC-related text files

# V      Who       When        What
# ---------------------------------------------------------------------------
# 1.7.2  skendric  02-23-2011  Retire Perl6::Say
# 1.7.1  skendric  12-21-2010  Fiddle with apager format
# 1.7.0  skendric  12-20-2010  Handle multiple NodeWatch formats
# 1.6.9  skendric  12-20-2010  Add another msg format to mangle_rtmt
# 1.6.8  skendric  12-16-2010  Catch additional msg formats in mangle_rtmt
# 1.6.7  skendric  11-30-2010  mangle_nodewatch can handle PID
# 1.6.6  skendric  11-19-2010  Retire mangle_cisco
# 1.6.5  skendric  09-03-2010  Add time to mangle_utility_power output
# 1.6.4  skendric  08-05-2010  Remove SMS 2.5 log support
# 1.6.3  skendric  08-01-2010  Return to BLK format
# 1.6.2  skendric  07-27-2010  Don't add time in mangle_utility_power
# 1.6.1  skendric  05-13-2010  Return undef in mangle_ips for system/audit msgs
# 1.6.0  skendric  10-28-2009  Add mangle_ccm
# 1.5.9  skendric  10-17-2009  Add mangle_rtmt, mangle_cer
# 1.5.8  skendric  09-16-2009  Support 911 page
# 1.5.7  skendric  09-03-2009  Include ga-a-fw IPSec records
# 1.5.6  skendric  08-14-2009  Add crypto tunnel support
# 1.5.5  skendric  05-22-2009  Retire Switch for perl-5.10.0 switch feature
# 1.5.4  skendric  05-22-2009  Restore daphne/velma IPSec support
# 1.5.3  skendric  05-20-2009  Support Radiator messages in SCCA
# 1.5.2  skendric  04-19-2009  Fix bug in mangle_ips affecting console format
# 1.5.1  skendric  04-16-2009  shutdown if we receive SIGSEGV
# 1.5.0  skendric  04-09-2009  Support TippingPoint console and enforcer formats
# 1.4.5  kkawakub  12-29-2008  Support Radius msgs from ias01
# 1.4.4  skendric  09-29-2008  Mangle apager messages
# 1.4.3  skendric  07-14-2008  Change mangle_vpn to mangle_ipsec_vpn
# 1.4.2  skendric  05-12-2008  Refine apager logging
# 1.4.1  skendric  04-28-2008  Remove FHCRC/SCCA dichotomy
# 1.4.0  skendric  04-23-2008  Remove dialin support
# 1.3.9  skendric  04-23-2008  Simplify WebVPN/VPN support
# 1.3.8  skendric  04-11-2008  Add charon/IPSEC support
# 1.3.7  kkawakub  03-25-2008  Add SCHARP wireless support
# 1.3.6  skendric  03-24-2008  More mangle_apager/hostname tweaks
# 1.3.5  skendric  12-31-2007  More mangle_apager/hostname tweaks
# 1.3.4  skendric  12-29-2007  Really preserve hostname in mangle_apager
# 1.3.3  skendric  12-21-2007  Preserve hostname in mangle_apager
# 1.3.2  skendric  11-02-2007  Incorrectly feeding $input rather than $line 
#                              to strip_date
# 1.3.1  kkawakub  10-24-2007  Add WebVPN Detailed support
# 1.3.0  kkawakub  10-12-2007  Replace nessus support with WebVPN support
# 1.2.7  skendric  05-29-2007  Handle obscure IPS line
# 1.2.6  skendric  04-05-2007  Handle more apager cases
# 1.2.5  skendric  02-08-2007  Add mangle_environment
# 1.2.4  skendric  02-02-2007  Add captive portal support to mangle_wireless
# 1.2.3  skendric  01-08-2007  Strip parens from apager output
# 1.2.2  skendric  12-17-2006  Fiddle with signals
# 1.2.1  skendric  11-06-2006  Move strip_html to SwatchOps, add webvpn
# 1.2.0  skendric  10-30-2006  Refactor to use new Netops structure
# 1.1.2  skendric  10-16-2006  Strip HTML tags from incoming line
# 1.1.1  skendric  10-12-2006  Improve apager handling
# 1.1.0  skendric  10-09-2006  Add time to utility power msgs
# 1.0.9  skendric  10-06-2006  Add mangle_cisco
# 1.0.8  skendric  10-03-2006  Handle default 'ops' cases
# 1.0.7  skendric  09-25-2006  Add shutdown routine
# 1.0.6  skendric  09-19-2006  Add mangle_dialin, mangle_vpn, mangle_wireless
# 1.0.5  skendric  09-18-2006  Refactor, pushing more code in SwatchOps
# 1.0.4  skendric  04-28-2006  Fix bug in mangle_apager
# 1.0.3  skendric  04-12-2006  Catch signals
# 1.0.2  skendric  04-10-2006  Add mangle_apager
# 1.0.1  skendric  04-10-2006  Add mangle_utility_power
# 1.0.0  skendric  04-02-2006  First version

# Swatch is not forwarding apager messages containing:  $ ^ & * ( ) +
# I don't have a fix for this.  --sk

# Load modules
use sigtrap qw 'handler' => \&log_signal;
use sigtrap qw(handler log_signal any);
use feature 'switch';
use feature 'say';
use strict;
use warnings;
use Carp qw(carp cluck croak confess);
use English;
use Fcntl qw(:DEFAULT :flock);
use List::MoreUtils qw(all any notall none uniq);
use POSIX;
use FHCRC::Netops::NetopsData 1.2.1;
use FHCRC::Netops::SwatchOps 1.2.3;
use FHCRC::Netops::Utilities 1.2.6;

# Declare global variables
my @defined_logs;      # List of log files which we support
my $log;               # Log file to which this message will be written
my $log_dir;           # The directory holding the log files
my $owner;             # The username under which we must run
my $pipe;              # Path to the pipe we are reading
my @strip_these_nodes; # List of hostnames to remove from apager messages
my %tunnel_name;       # Hash of tunnel names, keyed by IP address
my $version;           # Our version number

# Define global variables
@defined_logs = qw/apager          emergency         ips
                   ipsec           nodewatch         ops
                   ups             webvpn            webvpn_detailed
                   wireless
                  /;

$debug             = 0;
$log_dir           = '/home/tocops/logs';
$owner             = 'tocops';
$pipe              = '/home/tocops/.tocpipe';
@strip_these_nodes = qw/danalite junoite jane george/;
$version           = '1.7.2';

%tunnel_name = (
                 '69.91.254.6'     => 'charms',
                 '146.79.254.99'   => 'chrmc',
                 '72.14.61.132'    => 'colo',
                 '216.50.65.4'     => 'dejarnette',
                 '208.51.30.230'   => 'gems',
                 '128.95.186.12'   => 'hematopathology',
                 '140.142.149.5'   => 'hmc',
                 '63.239.35.30'    => 'icad',
                 '128.95.181.250'  => 'impac',
                 '128.95.161.89'   => 'mimi2',
                 '128.208.165.5'   => 'mimi3',
                 '204.69.11.20'    => 'nwh',
                 '128.208.220.230' => 'onbase',
                 '128.208.127.70'   => 'pacs',
                 '140.142.235.200' => 'pinnacle',
                 '63.239.162.4'    => 'pms',
                 '207.114.139.110' => 'pyxis',
                 '140.142.26.136'  => 'sod',
                 '129.171.150.1'   => 'um',
               );

# Assign signals
assign_signals();

# Announce start-up
log_it("Starting toclogd v$version");

# Change process owernship if necessary
change_uid($owner);

# Check for existance of pipe
unless (-p $pipe) {
  if (-e $pipe) {
    unless (unlink $pipe) {
      my $error = $!;
      log_it("Cannot delete $pipe: $error");
      die "Cannot delete $pipe: $error";
    }
  }
  else {
    unless (POSIX::mkfifo($pipe, 0644)) {
      my $error = $!;
      log_it("Cannot mkfifo $pipe: $error");
      die "Cannot mkfifo $pipe: $error";
    }
  }
}

# Debugging info
say "Pipe = $pipe, Pipe Buffer = ", PIPE_BUF if $debug;


#### Begin Main Program ###############################################
{      
  # Declare variables
  my $fifo;         # The pipe from which we'll read
  my $input;        # Text which swatch handed us ($input = $log . $line)
  my $line;         # Text which swatch handed us, gradually stripped of
                    # log name, date, and time

  # Set-up pipe
  die "Cannot open pipe $pipe: $!" unless -p $pipe;
  $SIG{ALRM} = sub { close($fifo) or log_it("Cannot close FIFO to $pipe: $!") };

  MAIN_LOOP:
  while (1) {

    # Open pipe
    alarm(0);
    unless (open $fifo, '<', $pipe) {
      log_it("Cannot open $pipe: $!");
      sleep 5;
      next MAIN_LOOP;
    }

    # Give ourselves one second to read input
    alarm(1);
    $input = <$fifo>;
    next MAIN_LOOP unless defined $input;
    chomp $input;

    # Process input
    alarm(0);
    next MAIN_LOOP unless $line = strip_junk($input);
    next MAIN_LOOP unless $log  = return_param($line);
    next MAIN_LOOP unless $log  = check_log_name($log);
    next MAIN_LOOP unless $line = strip_date($line);
    next MAIN_LOOP unless $line = strip_time($line);
    next MAIN_LOOP unless $line = mangle_line($line);
    write_line($line);
  }


}

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




##### Define subroutines ####


########################################################################
# Populate %SIG
########################################################################
sub assign_signals {

  # The stop process signals that we'll use to run shutdown()
  $SIG{__DIE__}  = \&shutdown;
  $SIG{HUP}      = \&shutdown;
  $SIG{INT}      = \&shutdown;
  $SIG{KILL}     = \&shutdown;
  $SIG{SEGV}     = \&shutdown;
  $SIG{STOP}     = \&shutdown;
  $SIG{TERM}     = \&shutdown;

  return 1;
}




########################################################################
# Change owner and group uids if necessary
########################################################################
sub change_uid {
  my $owner = shift;
  my $name;
  my $gid;
  my $uid;

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

  # Find UID of owner
  ($uid) = (getpwnam($owner))[2];

  # Change UID if necessary
  if ($uid == $UID) {
    # Do nothing;
  }
  else {
    log_it("Changing uid from $UID to $uid");
    ($UID, $EUID) = ($uid, $uid);
    unless ($uid == $UID) {
      log_it('Failed to change uid');
      die "$PROGRAM_NAME must run as $owner, bailing";
    }
  }

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

  return 1;
}




########################################################################
# Check the $log variable
########################################################################
sub check_log_name {
  my $log = shift;

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

  # Sanity check
  unless (length $log > 0) {
    log_it("Empty input in check_log_name");
    return;
  }

  # Test contents of $log
  unless (any { $_ eq $log } @defined_logs) {
    log_it("Invalid log \'$log\'");
    return;
  }

  # Add .txt extension
  $log .= '.txt';
  say "log = $log" if $debug;

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

  return $log;
}




########################################################################
# Log the alarm
########################################################################
sub log_signal {
  my $signame = shift;
  log_it("Received SIG$signame");
  return 1;
}




########################################################################
# Mangle Apager messages
########################################################################
sub mangle_apager {
  my $input = shift;
  my $node;
  my $output;
  my $text;

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

  # Sanity check
  if (not defined $input or $input eq $EMPTY_STR) {
    log_it('Empty input in mangle_apager');
    return;
  }

  # Clean text
  say "Incoming page = $input" if $debug;
  $text = $input;
  ($text = $text) =~ s/.*?httpd.*?:\s//;
  ($text = $text) =~ s/.*?apager.*?://;
  ($text = $text) =~ s/\(//;
  ($text = $text) =~ s/\)//;
  ($text = $text) =~ s/^\s+//;
  say "Cleaned page = $text" if $debug;

  # Strip leading hostname
  ($node) = ($text =~ /^(\w+)/);
  ($text) = ($text =~ /^\w+\s+(.*)/) if any { $_ eq $node } @strip_these_nodes;
  say "Stripped hostname:  $text" if $debug;

  # Strip leading time
  $text =~ s/^\d\d:\d\d //;

  # Construct message
  $output = $time . $SPACE . $text;

  # Debug info
  say "mangle_apager returns:  $output" if $debug;

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

  return $output;
}




########################################################################
# Mangle Cisco Call Manager messages
########################################################################
sub mangle_ccm {
  my $input = shift;
  my $msg;
  my $node;
  my $output;

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

  # Sanity check
  if (not defined $input or $input eq $EMPTY_STR) {
    log_it('Empty input in mangle_ccm');
    return;
  }

  # Grab msg
  ($node) = ($input =~ /^(.*?)\s/);
  ($msg) = ($input =~ /CALLMANAGER-.*?: (.*)/);

  # If that worked, create the line which we will log to the TOC
  if (defined $time and defined $msg and defined $node) {
    $output = $time . $SPACE . $node. $SPACE . $msg;
    ($output = $output) =~ s/\"//g;
    ($output = $output) =~ s/\\//g;
  }
  else {
    log_it("Problem with mangle_ccm:  $input");
    return;
  }

  # Debug info
  say "mangle_ccm returns:  $output" if $debug;

  return $output;
}



########################################################################
# Mangle Cisco Communications Manager CER messages
########################################################################
sub mangle_cer {
  my $input = shift;
  my $msg;
  my $node;
  my $output;

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

  # Sanity check
  if (not defined $input or $input eq $EMPTY_STR) {
    log_it('Empty input in mangle_cer');
    return;
  }

  # Grab msg
  ($node) = ($input =~ /^(.*?)\s/);
  ($msg) = ($input =~ /: (.*)/);

  # If that worked, create the line which we will log to the TOC
  if (defined $time and defined $msg and defined $node) {
    $output = $time . $SPACE . $node. $SPACE . $msg;
    ($output = $output) =~ s/\"//g;
    ($output = $output) =~ s/\\//g;
  }
  else {
    log_it("Problem with mangle_cer:  $input");
    return;
  }

  # Debug info
  say "mangle_cer returns:  $output" if $debug;

  return $output;
}




########################################################################
# Mangle IPS messages
########################################################################
sub mangle_ips {
  my $dst;              # Destination IP address / port
  my $filter_name;      # Name of filter
  my $filter_id;        # Four digit number identifier of filter
  my $filter_num;       # Typically the same as filter_id, though occasionally 
                        # not
  my $host;             # hostname of enforcement point
  my $input = shift;
  my $output;
  my $src;              # Source IP address / port

  # Sanity check
  if (not defined $input or $input eq $EMPTY_STR) {
    log_it('Empty input in mangle_ips');
    return;
  }

  # Skip system messages
  return if $input =~ /\[sys\]|\[audit\]/;
  
  # Name the proximate source of the message
  ($host) = ($input =~ /^(.*?)\s/);
  say "host = $host" if $debug;

  # Find filter_id
  ($filter_id) = ($input =~ /\s+(\d+):\s/);
  say "filter_id = $filter_id" if $debug;

  # Find filter_num
  ($filter_num) = ($input =~ /$filter_id:.*?(\d+):/);
  say "filter_num = $filter_num" if $debug;

  # Find filter name (Cannot rely on quotes; they are not always there)
  ($filter_name) = ($input =~ /$filter_id:(.*?)$filter_num:/);
  if (defined $filter_name) {
    ($filter_name = $filter_name) =~ s/"//g;
    ($filter_name = $filter_name) =~ s/  / /g;
    ($filter_name = $filter_name) =~ s/^\s+//;
    ($filter_name = $filter_name) =~ s/\s+\Z//;
  }
  say "filter_name = $filter_name" if $debug;

  # Find src and dst IP addresses
  ($src, $dst) = ($input =~ /(\d+\.\d+\.\d+\.\d+:\d+)\s+(\d+\.\d+\.\d+\.\d+:\d+)\s+/);
  say "src = $src, dst = $dst" if $debug;

  # If the extraction worked, create the line which we will log to the TOC
  if (defined $time and defined $host and defined $filter_id and defined $filter_name and defined $src and $time ne $EMPTY_STR and $host ne $EMPTY_STR and $filter_id ne $EMPTY_STR and $filter_name ne $EMPTY_STR and $src ne $EMPTY_STR) {
    $output = $time   . $SPACE . $host . $SPACE . $filter_id . $COLON . $SPACE . $filter_name . $SPACE . "src:$src" . $SPACE .  "dst:$dst";
  }
  else {
    log_it("Problem with mangle_ips:  $input");
    return;
  }

  # Debug info
  say "mangle_ips returns:  $output" if $debug;

  return $output;
}




########################################################################
# Mangle VPN messages
########################################################################
sub mangle_ipsec_vpn {
  my $input = shift;
  my $internal_time;
  my $output;
  my $node;

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

  # Debug info
  say "Entering mangle_ipsec_vpn with $input" if $debug;
 
  # Sanity check
  if (not defined $input or $input eq $EMPTY_STR) {
    log_it('Empty input in mangle_ipsec_vpn');
    return;
  }

  # Extract fields from incoming line
  given ($input) {
    when (/ASA/) {
      ($node, $output) = ($input =~ /^(.*)\s%(ASA.*)/);
    }
    when (/daphneVPN|velmaVPN|radius01vpn|radius02vpn/) {
      ($node, $internal_time, $output)
          = ($input =~ /^(\w+).*(\d\d:\d\d:\d\d).*(vpn:.*)/);
    }
  }  # End 'Extract fields from incoming lines'


  # Check for errors
  given ($input) {
    when (/ASA/) {
      if (defined $node          and $node   ne $EMPTY_STR and
          defined $output        and $output ne $EMPTY_STR) {
        $output = $time . $SPACE . $node . $SPACE . $output;
      }
    }
    when (/daphneVPN|velmaVPN|radius01|radius02/) {
      if (defined $node          and $node   ne $EMPTY_STR and 
          defined $output        and $output ne $EMPTY_STR and 
          defined $internal_time and $internal_time ne $EMPTY_STR) {
        $output = $time . $SPACE . $node . $SPACE . $internal_time. $SPACE . $output;
     }
    }
    default {
      log_it("Problem with mangle_ipsec_vpn:  $input");
      return;
    }
  }  # End 'Check for errors'

  # Debug info
  say "mangle_ipsec_vpn returns:  $output" if $debug;

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

  return $output;
}




########################################################################
# Mangle the line
########################################################################
sub mangle_line {
  my $line = shift;

  # Make things look pretty
  say('') if $debug;

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

  # Sanity check
  if (not defined $line or $line eq $EMPTY_STR) {
    log_it('Empty line in mangle_line');
    return;
  }

  # Mangles lines appropriately
  given ($log) {

    # Mangle Apager messages
    when ('apager.txt')               { $line = mangle_apager($line)        }

    # Mangle Emergency messages
    when ('emergency.txt')            { $line = mangle_emergency($line)     }

    # Mangle IPS messages
    when ('ips.txt')                  { $line = mangle_ips($line)           }

    # Mangle VPN messages
    when ('ipsec.txt')                { $line = mangle_ipsec_vpn($line)     }

    # Mangle Ops messages
    when ('ops.txt') {
      given ($line) {
        when (/Crypto tunnel is/)     { $line = mangle_tunnel($line)        }
        when (/Microsoft Exchange/)   { $line = mangle_exchange($line)      }
        when (/nagios:/)              { $line = mangle_nagios($line)        }
        when (/PowerNet-MIB/)         { $line = mangle_apc($line)           }
        when (/utility power/)        { $line = mangle_utility_power($line) }
        when (/CER_CERT/)             { $line = mangle_cer($line)           }
        when (/CCM_CALLMANAGER/)      { $line = mangle_ccm($line)           }
        when (/RTMT-ERROR-ALERT/)     { $line = mangle_rtmt($line)          }
        default                       { $line = $time . $SPACE . $line      }
      }
    }

    # Mangle NodeWatch messages
    when ('nodewatch.txt')            { $line = mangle_nodewatch($line)     }

    # Mangle UPS messages
    when ('ups.txt')                  { $line = mangle_apc($line)           }

    # Mangle WebVPNv2 messages
    when ('webvpn.txt')               { $line = mangle_webvpn($line)        }

    # Mangle WebVPNv2_Detailed messages
    when ('webvpn_detailed.txt')      { $line = mangle_webvpn($line)        }

    # Mangle Wireless messages
    when ('wireless.txt')             { $line = mangle_wireless($line)      }

    # Handle everything else
    default                           { $line = $time . $SPACE . $line      }
  }

  # Debug info
  if ($debug) {
    given ($line) {
      when (undef) { say 'mangle_line returns undef'   }
      default      { say "mangle_line returns:  $line" }
    }
  }

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

  # Return success or failure
  if (not defined $line or $line eq $EMPTY_STR) {
    return;
  }
  else {
    return $line;
  }

}




########################################################################
# Mangle Nagios messages
########################################################################
sub mangle_nagios {
  my $input = shift;
  my $output;
  my $trap;

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

  # Sanity check
  if (not defined $input or $input eq $EMPTY_STR) {
    log_it('Empty input in mangle_nagios');
    return;
  }

  # Do the work
  given ($input) {
    when (/SERVICE ALERT/) {
      ($trap) = ($input =~ /SERVICE ALERT: (.*)/);
    }
    when (/SERVICE EVENT HANDLER/) {
      ($trap) = ($input =~ /SERVICE EVENT HANDLER: (.*)/);
    }
  }

  # If that worked, create the line which we will log to the TOC
  if (defined $time and defined $trap and $time ne $EMPTY_STR and $trap ne $EMPTY_STR) {
    $output = $time . $SPACE . $trap;
    ($output = $output) =~ s/\"//g;
    ($output = $output) =~ s/\\//g;
  }
  else {
    log_it("Problem with mangle_nagios:  $input");
    return;
  }

  # Debug info
  say "mangle_nagios returns:  $output" if $debug;

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

  return $output;
}




########################################################################
# Mangle Nodewatch messages
########################################################################
sub mangle_nodewatch {
  my $input = shift;
  my $output;
  my $node;

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

  # Sanity check
  if (not defined $input or $input eq $EMPTY_STR) {
    log_it('Empty input in mangle_nodewatch');
    return;
  }

  # Extract fields from incoming line
  ($node) = ($input =~ /\w+ nodewatch.*?\s(.*)/);

  # Check for errors
  if (defined $node and $node ne $EMPTY_STR) {
    $output = $time . $SPACE . $node;
  }
  else {
    log_it("Problem with mangle_nodewatch:  $input");
    return;
  }

  # Debug info
  say "mangle_nodewatch returns:  $output" if $debug;

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

  return $output;
}




########################################################################
# Mangle Cisco Communications Manager RTMT messages
########################################################################
sub mangle_rtmt {
  my $input = shift;
  my $msg;
  my $node;
  my $output;

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

  # Sanity check
  if (not defined $input or $input eq $EMPTY_STR) {
    log_it('Empty input in mangle_rtmt');
    return;
  }

  # Grab node
  ($node) = ($input =~ /^(.*?)\s/);

  # Grab message
  given ($input) {
    when (/CiscoLicenseApprochingLimit/) {
      ($msg) = ($input =~ /CiscoLicenseApprochingLimit: (.*)/);
    }
    when (/WARNING/) {
      ($msg) = ($input =~ /WARNING: (.*)/);
    }
    when (/RTMT Alert Name/) {
      ($msg) = ($input =~ /RTMT Alert Name:.*?: (.*)\./);
    }
    default {
      $msg = $input;
    }
  }
  

  # If that worked, create the line which we will log to the TOC
  if (defined $time and defined $msg and defined $node) {
    $output = $time . $SPACE . $node . $SPACE . $msg;
    ($output = $output) =~ s/\"//g;
    ($output = $output) =~ s/\\//g;
  }
  else {
    log_it("Problem with mangle_rtmt:  $input");
    return;
  }

  # Debug info
  say "mangle_rtmt returns:  $output" if $debug;

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

  return $output;
}




########################################################################
# Mangle site-to-site VPN tunnel messages
########################################################################
sub mangle_tunnel {
  my $input = shift;
  my $ip;
  my $name;
  my $output;
  my $trap;

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

  # Sanity check
  if (not defined $input or $input eq $EMPTY_STR) {
    log_it('Empty input in mangle_tunnel');
    return;
  }

  # Grab IP address of tunnel peer
  ($ip) = ($input =~ /Peer\s(\d+\.\d+\.\d+\.\d+)/);

  # Assign tunnel name
  $name = defined $tunnel_name{$ip} ? $tunnel_name{$ip}
          :                           $ip;

  # Do the work
  given ($input) {
    when (/DOWN/) {
      $trap = "<font color=\"lightsalmon\">Crypto tunnel $name is down<\/font>";
    }
    when (/UP/) {
      $trap = "<font color=\"limegreen\">Crypto tunnel $name is up<\/font>";
    }
  }

  # If that worked, create the line which we will log to the TOC
  if (defined $time and defined $trap and $time ne $EMPTY_STR and $trap ne $EMPTY_STR) {
    $output = $time . $SPACE . $trap;
    ($output = $output) =~ s/\"//g;
    ($output = $output) =~ s/\\//g;
  }
  else {
    log_it("Problem with mangle_tunnel:  $input");
    return;
  }

  # Debug info
  say "mangle_tunnel returns:  $output" if $debug;

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

  return $output;
}




########################################################################
# Mangle utility power messages
########################################################################
sub mangle_utility_power {
  my $input = shift;
  my $output;
  my $trap;

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

  # Sanity check
  if (not defined $input or $input eq $EMPTY_STR) {
    log_it('Empty input in mangle_utility_power');
    return;
  }

  # Insert font tags
  if ($input =~ /lost/) {
    ($output = $input) =~ s/^/<font color=\"red\">/;
    $output =~ s/\Z/<\/font>/;
  }
  elsif ($input =~ /regained/) {
    ($output = $input) =~ s/^/<font color=\"347235\">/;
    $output =~ s/\Z/<\/font>/;
  }

  # Look for errors
  if (not defined $output or $output eq $EMPTY_STR) {
    log_it("Problem with mangle_utility_power:  $input");
    return;
  }

  # Construct message
  $output = $time . $SPACE . $output;

  # Debug info
  say "mangle_utility_power returns:  $output" if $debug;

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

  return $output;
}




########################################################################
# Mangle WebVPN messages
########################################################################
sub mangle_webvpn {
  my $input = shift;
  my $internal_time;
  my $output;
  my $node;

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

  # Sanity check
  if (not defined $input or $input eq $EMPTY_STR) {
    log_it('Empty input in mangle_webvpn');
    return;
  }

  # Extract fields from incoming line
  if ($input =~ /charon/) {
    if ($input =~ /SEV/) {
      ($node, $output) = ($input =~ /^(.*?)\s.*?(SEV.*)/);
    }
    elsif ($input =~ /%/) {
      ($node, $output) = ($input =~ /^(.*?)\s.*?\s(\%.*)/);
    }
  }
  elsif ($input =~/daphneWebVPN|velmaWebVPN/) {
    if ($input =~ /webvpn:/) {
      ($node, $internal_time, $output)
          = ($input =~ /^(\w+).*(\d\d:\d\d:\d\d).*(webvpn:.*)/);
    }
    else {
      ($node, $internal_time, $output)
          = ($input =~ /^(\w+).*(\d\d:\d\d:\d\d).*(vpn:.*)/);
    }
  }

  # Check for errors
  if ($input =~ /charon/) {
    if (defined $node and $node ne $EMPTY_STR and defined $output and $output ne $EMPTY_STR) {
      $output = $time . $SPACE . $node . $SPACE . $output;
    }
  }
  elsif ($input =~ /daphneWebVPN|velmaWebVPN/) {
    if (defined $node          and $node ne $EMPTY_STR and
        defined $output        and $output ne $EMPTY_STR and
        defined $internal_time and $internal_time ne $EMPTY_STR) {
      $output = $time . $SPACE . $node . $SPACE . $internal_time. $SPACE . $output;
    }
  }
  elsif ($input =~ /IAS:/) {
    if (defined $output and $output ne $EMPTY_STR) {
      $output = $time . $SPACE . $output;
    }
  }
  else {
    log_it("Problem with mangle_webvpn:  $input");
    return;
  }

  # Debug info
  say "mangle_webvpn returns:  $output" if $debug;

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

  return $output;
}




########################################################################
# Mangle Wireless messages
########################################################################
sub mangle_wireless {
  my $input = shift;
  my $output;
  my $node;

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

  # Extract fields from incoming line
  given ($input) {
    when (/cpl:/)    { ($node, $output) = ($input =~ /^(\w+).*(cpl:.*)/)      }
    when (/scharp:/) { ($node, $output) = ($input =~ /^(\w+).*(scharp:.*)/)   }
    when (/wap:/)    { ($node, $output) = ($input =~ /^(\w+).*(wap:.*)/)      }
  }

  # Check for errors
  given ($input) {
    when (/cpl:|scharp:|wap:/) {
      $output = $time . $SPACE . $node . $SPACE . $output 
          if (    defined $node 
              and $node ne $EMPTY_STR 
              and defined $output 
              and $output ne $EMPTY_STR);
    }
    when (/radius0\d NT:/) {
      $output = $time . $SPACE . $input 
          if (defined $input and $input ne $EMPTY_STR);
    }
    default {
      log_it("Unknown category in mangle_wireless:  $input");
      return;
    }
  }

  # Check output
  unless (defined $output) {
    log_it("Problem with mangle_wireless:  $input");
    return;
  }

  # Debug info
  say "mangle_wireless returns:  $output" if $debug;

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

  return $output;
}




########################################################################
# Cleans up before exit
########################################################################
sub shutdown {
  my $signal = shift;

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

  # Log event
  log_it("Shutting down v$version with $signal");

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

  exit 1;
}




########################################################################
# Write the line to the log.  Handle locking
########################################################################
sub write_line {
  my $line = shift;
  my $dest = $log_dir . '/' . $log;

  # Make things look pretty
  say('') if $debug;

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

  # Bail if $log is not defined
  if (not defined $log or $log eq $EMPTY_STR) {
    log_it('log is not defined in write_line');
    return;
  }

  # Bail if $line is empty
  if (not defined $line or $line eq $EMPTY_STR) {
    log_it('write_line received empty line');
    return;
  }

  # Open file
  if (sysopen(LOG, $dest, O_RDWR | O_CREAT)) {
    say "We opened $dest" if $debug;

    # Lock file
    if (flock (LOG, LOCK_EX)) {
      say "We locked $dest" if $debug;

      # Move to the end of the file
      if (seek LOG, 0, 2) {
        say "We sought to end of $dest" if $debug;

        # Write the line
        if (print LOG "$line\n") {
          say "We wrote to $dest" if $debug;
        }
        else {
          log_it("Problem writing to $dest:  $!");
        }
      }
      else {
        log_it("Problem seeking to end of $log: $!");
      }
    }
    else {
      log_it("Cannot open $log: $!");
    }
  }
  else {
    log_it("Cannot write-lock $log: $!");
  }

  # Debug info
  say "write_line to $dest returns:  $line" if $debug;

  # Close file
  close LOG or log_it("Cannot close $log: $!");

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

  return 1;
}