#!/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.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 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 Perl6::Say;
use POSIX;
use Switch;
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 $version;           # Our version number

# Define global variables
@defined_logs = qw/apager          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/dolomite jurbanite jane george/;
$version           = '1.4.3';

# Assign signals
assign_signals();

# Announce start-up
log_it("Starting toclogd $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{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
  ($text = $input) =~ s/httpd:\s//;
  ($text = $input) =~ s/httpd2-prefork\[\d+\]:\s//;
  ($text = $text) =~ s/\w+\sapager.*?://;
  ($text = $text) =~ s/^://;
  ($text = $text) =~ s/\(//;
  ($text = $text) =~ s/\)//;
  ($text = $text) =~ s/^\s+//;

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

  # 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 messages
########################################################################
sub mangle_cisco {
  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_cisco');
    return;
  }

  # Do the work
  ($node) = ($input =~ /^(.*?)\s/);
  ($msg) = ($input =~ /(%.*)$/);

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

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

  # Debug trace
  trace_location('end') 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 $input = shift;
  my $node;             # Nodename of IPS box
  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;
  }

  # Name the source of this message
  ($node) = ($input =~ /(\w+(?:-\w-|-)ips)\s/);

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

  # Find filter_num
  ($filter_num) = ($input =~ /$filter_id:\s.*?\s+(\d+)\s+\w+\s+/);

  # Find filter name
  ($filter_name) = ($input =~ /\s+$filter_id:(.*)\s+$filter_num/);

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

  # If the extraction worked, create the line which we will log to the TOC
  if (defined $time and defined $node and defined $filter_id and defined $filter_name and defined $src and $time ne $EMPTY_STR and $node ne $EMPTY_STR and $filter_id ne $EMPTY_STR and $filter_name ne $EMPTY_STR and $src ne $EMPTY_STR) {
    $output = $time   . $SPACE . $node . $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 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
  switch ($log) {

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

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

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

    # Mangle Ops messages
    case 'ops.txt' {
      switch ($line) {
        case /Microsoft Exchange/   { $line = mangle_exchange($line)      }
        case /nagios:/              { $line = mangle_nagios($line)        }
        case /PowerNet-MIB/         { $line = mangle_apc($line)           }
        case /utility power/        { $line = mangle_utility_power($line) }
        case /-ap|-esx|-rtr|-dgw/   { $line = mangle_cisco($line)         }
        else                        { $line = $time . $SPACE . $line      }
      }
    }

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

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

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

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

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

    # Handle everything else
    else                            { $line = $time . $SPACE . $line      }
  }
  $debug = 0;

  # Debug info
  say "mangle_line returns:  $line" if $debug;

  # 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
  switch ($input) {
    case /SERVICE ALERT/ {
      ($trap) = ($input =~ /SERVICE ALERT: (.*)/);
    }
    case /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 WebVPN messages
########################################################################
sub mangle_webvpn {
  my $input = shift;
  my $internal_time;
  my $output;
  my $node;

  $debug = 0;

  # 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:.*)/);
    }
  }
  elsif ($input =~ /IAS:/) {
    $output = $input;
  }

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

  $debug = 0;


########################################################################
# 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: (.*)/);

  # 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 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=\"lightsalmon\">/;
    $output =~ s/\Z/<\/font>/;
  }
  elsif ($input =~ /regained/) {
    ($output = $input) =~ s/^/<font color=\"limegreen\">/;
    $output =~ s/\Z/<\/font>/;
  }

  # Insert time
  if (defined $time and defined $output) {
    $output = $time . $SPACE . $output;
  }

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

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

  # Debug trace
  trace_location('end') 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;

  # 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
  switch($input) {
    case /cf-vpn|charon|ga-vpn/ {
      ($node, $output) = ($input =~ /^(.*?)\s.*?([SEV|%].*)/);
    }
    case /daphneVPN|velmaVPN/ {
      ($node, $internal_time, $output) 
          = ($input =~ /^(\w+).*(\d\d:\d\d:\d\d).*(vpn:.*)/);
    }
    case /IAS/ {
      ($output = $input)  =~ s/72.14.50.10/walc00/;
      ($output = $output) =~ s/72.14.50.12/walc01/;
    }
  }  # End 'Extract fields from incoming lines'


  # Check for errors
  switch($input) {
    case /cf-vpn|charon|ga-vpn/ {
      if (defined $node and $node ne $EMPTY_STR and defined $output and $output ne $EMPTY_STR) {
        $output = $time . $SPACE . $node . $SPACE . $output;
      }
    }
    case /daphneVPN|velmaVPN/ {
      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;
     }
    }
    case /IAS/ {
      if (defined $output and $output ne $EMPTY_STR) {
        $output = $time . $SPACE . $output;
      }
    }
    else {
      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 Wireless messages
########################################################################
sub mangle_wireless {
  my $input = shift;
  my $output;
  my $node;

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

  # Extract fields from incoming line
  switch ($input) {
    case /cpl:/    { ($node, $output) = ($input =~ /^(\w+).*(cpl:.*)/)        }
    case /scharp:/ { ($node, $output) = ($input =~ /^(\w+).*(scharp:.*)/)     }
    case /wap:/    { ($node, $output) = ($input =~ /^(\w+).*(wap:.*)/)        }
    case /IAS:/    {
      ($output = $input)  =~ s/72.14.50.10/walc00/;
      ($output = $output) =~ s/72.14.50.12/walc01/;
    }
  }

  # Check for errors
  switch ($input) {
    case /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);
    }
    case /IAS:/ {
      $output = $time . $SPACE . $input 
          if (defined $input and $input ne $EMPTY_STR);
    }
    else {
      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;
}