#!/usr/bin/perl

# WaldoGPS 0.1 (C) 2005 Richard G Harman Jr waldogps (((__NOSPAM__))) richardharman.com
#
# This program is licensed under the GNU Public License

use strict;
use warnings;
use POSIX 'setsid';
use Sys::Syslog qw(:DEFAULT setlogsock);
use Getopt::Long qw(:config pass_through);
use Pod::Usage;
use vars qw($VERSION);

$VERSION = "0.1";

=pod

=head1 NAME

WaldoGPS - Snort Barnyard Waldo Global Positioning Service

=head1 SYNOPSIS

waldogps [options]

=head1 DESCRIPTION

B<WaldoGPS> will monitor multiple barnyard processes that are processing
unified snort logs, and delete the log files after all barnyard processes
have finished processing them.  B<WaldoGPS> utilizes the contents of the
waldo files to figure out where the snort logs are.

=head1 OPTIONS

=over 8

=item B<-detach>

Detach and become a daemon.

=item B<-delete>

Delete snort log files after they have been processed.

=item B<-debuglevel>

Print out debugging messages.  Range is 0 through 255, bitmask.

=item B<-waldodir>

Directory containing barnyard waldo files.

=item B<-waldopat>

A regular expression that matches waldo files.

=item B<-pidfile>

Where to write the pidfile for WaldoGPS.

=item B<-help>

Print a brief help message and exits.

=item B<-man>

Prints the manual page and exits.

=back

=cut

# defaults
my %opts = (
  detach     => 1,                          # detach and setsid
  delete     => 1,                          # delete logs when no longer needed
  debuglevel => 0,                          # increase verbosity
  waldodir   => "/snort/logs",              # directory to find waldo files
  waldopat   => ".+\.waldo\$",              # waldo file regex pattern
  pidfile    => "/var/run/waldogps.pid",    # where to write our pid file
);

GetOptions( \%opts, 'detach!', 'delete!', 'debuglevel=i', 'pidfile=s', 'barnpat=s', 'waldodir=s', 'help|?', 'man' );

pod2usage( -verbose => 1 ) if ( $opts{help} );
pod2usage( -verbose => 2 ) if ( $opts{man} );

## Check for unknown arguments
pod2usage(
  -verbose => 1,
  -exitval => 1,
  -message => "$0: Unknown arguments: @ARGV.\n"
  )
  if ( scalar @ARGV );

setlogsock('unix');
openlog( "WaldoGPS", 'cons,pid', 'daemon' );

# sanity check

die "Couldn't open waldodir $opts{waldodir} for reading! ($!)"
  unless ( -r $opts{waldodir} );

&daemonize if ( $opts{detach} );

if ( $opts{pidfile} ) {
  open( PID_FILE, ">", $opts{pidfile} )
    or debug( 0, "Couldn't open pidfile $opts{pidfile} for writing ($!)" ) && die;
  print PID_FILE "$$\n";
  close PID_FILE;
}

$SIG{INT}  = \&shutdown;
$SIG{TERM} = \&shutdown;
$SIG{HUP}  = \&shutdown;

while (1) {
  my %waldo_stats;
  my $retry_loop = 0;
  my @safe_to_delete;

WALDO_FILE: foreach my $waldo_file (&find_waldo_files) {

    # this will get reset each time we read a timestamp from a waldo file
    my $oldest_stamp = time;

    if ( ++$retry_loop >= 10 ) {
      debug( 0, "Gave up attempting to parse the contents of waldo file $waldo_file, looped 10 times and still failed." )
        && die;
    }

    open( WALDO_FILE, "<", $waldo_file )
      or debug( 0, "Can't open waldo file $waldo_file for reading! ($!)" ) && die;
    $/ = undef;    # slurp mode
    my @waldo = split( /\n/, <WALDO_FILE>, 4 );
    close WALDO_FILE;

    # sanity check the contents of the waldo file against the filesystem
    # waldo offset
    unless ( length( $waldo[3] ) > 0 ) {
      debug( 0, "Had a problem reading waldo file $waldo_file, it appears to be truncated, the data offset doesn't appear to exist.  Retrying..." );
      sleep 5;
      redo WALDO_FILE;
    }

    # log directory exists
    unless ( -d $waldo[0] ) {
      debug( 0, "Had a problem reading waldo file $waldo_file, the log dirtectory doesn't exist.  Retrying..." );
      sleep 5;
      redo WALDO_FILE;
    }

    # check to make sure there are files in there that match the format barnyard is looking for
    opendir( LOG_DIR, $waldo[0] )
      or debug( 0, "Couldn't open log dir $waldo[0] from waldo file $waldo_file for reading! ($!)" ) && die;
    unless ( ( scalar grep { m/$waldo[1]/ } readdir LOG_DIR ) >= 1 ) {
      closedir LOG_DIR;
      sleep 5;
      debug( 0, "Had a problem reading waldo file $waldo_file, there don't appear to be any log files to process.  Retrying..." );
      redo WALDO_FILE;
    }
    close LOG_DIR;

    # we successfully read this waldo file!  Reset the counter!
    $retry_loop = 0;

    # set directory -> logfile pattern = datestamp
    #  unless the existing one is older
    $waldo_stats{ $waldo[0] }->{ $waldo[1] } = $waldo[2]
      unless ( defined( $waldo_stats{ $waldo[0] }->{ $waldo[1] } )
      && $waldo_stats{ $waldo[0] }->{ $waldo[1] } <= $waldo[2] );
  }

  while ( my ( $log_dir, $log_prefix_ref ) = each %waldo_stats ) {
    foreach my $log_prefix ( keys %$log_prefix_ref ) {
      my $oldest_stamp = $log_prefix_ref->{$log_prefix};
      debug( 0x8, "Oldest in-use stamp in $log_dir for $log_prefix is $oldest_stamp" );
      opendir( LOG_DIR, $log_dir )
        or debug( 0, "Couldn't open logdir $log_dir for reading! ($!)" ) && die;

      my @log_files =
        map { "$log_dir/$_" } grep { m/^$log_prefix\.\d+/ } readdir(LOG_DIR);
      debug( 0x8, sprintf( "Found snort log files: %s", join( ", ", @log_files ) ) );
      foreach my $log_file (@log_files) {

        debug( 0x8, "$log_file prefix is $log_prefix" );
        my ($log_stamp) = ( $log_file =~ m/$log_prefix\.(\d+)/ );

        if ( $log_stamp < $oldest_stamp ) {
          debug( 0x8, "$log_file is older than $log_stamp, safe to delete." );
          push @safe_to_delete, $log_file;
        }
      }
    }
  }
  debug( 0x8, sprintf( "Log files safe to delete: %s", join( ", ", @safe_to_delete ) ) );
  if ( $opts{delete} ) {
    foreach my $file_to_delete (@safe_to_delete) {
      unlink $file_to_delete
        or debug( 0, sprintf( "Unable to delete %s! (%s)", $file_to_delete, $! ) ) && die;
    }
  }
  debug( 0x8, "Sleeping..\n" );
  sleep 5;
}

##############

sub debug {
  my ( $level, $msg ) = @_;
  if ( $level == 0 || $opts{debuglevel} & $level ) {
    if ( $opts{detach} ) { syslog( 'info', $msg ); }
    else { printf STDERR "%s\n", $msg; }
  }
}

sub daemonize {
  debug( 0x8, "Forking off into the background" );

  # prevent us from holding a mountpoint
  chdir '/' or die "Can't chdir to /: $!";

  # redirect all stuff -> /dev/null
  open STDIN, '/dev/null' or debug( 0, "Can't read /dev/null: $!" ) && die;
  open STDOUT, '>/dev/null'
    or debug( 0, "Can't write to /dev/null: $!" ) && die;
  defined( my $pid = fork ) or debug( 0, "Can't fork: $!" ) && die;
  debug( 0x8, "Parent process exiting" ) if ($pid);
  exit if $pid;
  setsid or debug( 0, "Can't start a new session: $!" ) && die;
  open STDERR, '>&STDOUT' or debug( 0, "Can't dup stdout: $!" ) && die;
  debug( 0x8, "Child running, pid $$." );
}

sub find_waldo_files {
  opendir( WALDO_DIR, $opts{waldodir} )
    or die "Couldn't open $opts{waldodir} for reading ($!)";
  my @waldo_files =
    map { "$opts{waldodir}/$_" }
    grep { $_ =~ m/$opts{waldopat}/ } readdir WALDO_DIR;
  close WALDO_DIR;
  return @waldo_files;
}

sub shutdown {
  debug( 0, "Received signal, shutting down" );
  if ( $opts{pidfile} ) {
    unlink $opts{pidfile};
  }
  exit 0;
}

=pod

=head1 SEE ALSO

L<http://www.snort.org> the Snort IDS homepage, L<http://www.snort.org/dl/barnyard> the barnyard download page.

=head1 AUTHOR

Richard G Harman Jr, <waldogps ((__NOSPAM__)) richardharman.com>

=cut