#!/perl

use strict;
use warnings;
use Win32::EventLog;
use DateTime;
use Net::Syslog;

my @servers = (
  "MAN-EVENTLOG-01"
);

my @logs = (
  "Setup",              # appears to work but actually reads from "Application"
  "System",             # works as expected
  "Security",           # works as expected for "administrator", otherwise returns 0 events
  "Application",        # works as extected
  "Forwarded Events"    # appears to work but actually reads from "Application"
);

my %priority = (
  EVENTLOG_ERROR_TYPE           => 'error',
  EVENTLOG_WARNING_TYPE         => 'warning',
  EVENTLOG_INFORMATION_TYPE     => 'notice',
  EVENTLOG_AUDIT_SUCCESS        => 'debug',
  EVENTLOG_AUDIT_FAILURE        => 'informational'
);



my %DEBUG = (
  loop => 0,
  event => 0,
  rule => 0,
  syslog => 0,
  history => 1,
);

my %last = ();
my $HISTORY_FNAME = 'syslog-events.dat';
load_history();
my $need_save = 0;

my %rules = (); # EventID processing rules go here as they are loaded

while (1) { 
  my $syslog = Net::Syslog->new( SyslogHost => '10.80.8.252' );
  foreach my $server (sort @servers) {
    foreach my $log (@logs) {
      my $handle = Win32::EventLog->new($log, $server) or die;
      if ($handle) {
        my $recs;
        print "$server $log Get number of events...\n" if $DEBUG{loop};
        $handle->GetNumber($recs);
        next unless $recs;
        my $base;
        print "$server $log Get oldest event...\n" if $DEBUG{loop};
        $handle->GetOldest($base);
        print "$server $log has $recs events, first one is $base\n" if $DEBUG{loop};
        my $index = 0;
        if ($last{$server}->{$log} && $last{$server}->{$log} >= $base) {
          my $skip = 1 + $last{$server}->{$log} - $base;
          $index = $skip;
          print "$server $log Skipping $skip already seen\n" if $DEBUG{loop};
        }
        while ($index < $recs) {
          my $hashref;
          my $discard = 0;
          
          # As demonstrated by Win32::EventLog docs, read one event by record number
          if ($handle->Read(EVENTLOG_FORWARDS_READ|EVENTLOG_SEEK_READ, $base+$index, $hashref)) {
            $hashref->{'_EventID'} = $hashref->{'EventID'} & 0x0000ffff; # Seems to solve the "-2xxxxxxxxx" event IDs
            my ($timestamp) = unixtime_to_timestamp($hashref->{'TimeGenerated'});
            $hashref->{'_DateTime'} = "$timestamp";
            Win32::EventLog::GetMessageText($hashref); # This is where the Registry & DLL nightmare takes place
            if ($DEBUG{event}) {
              # Dump the event $hashref for debugging
              foreach my $key (sort keys %{$hashref}) { print "\t$key: $hashref->{$key}\n"; }
            }
            
            # Trim the host name, we're all friends here
            my ($host) = split(/\./, $hashref->{'Computer'}, 2);
            
            # Reduce the Message to a single line by replacing CR/LF with spaces, then eliminate double spaces
            my $message = $hashref->{'Message'} || '';
            $message =~ s/[\r\n]/ /g;
            $message =~ s/\s+/ /g;
            my $original = length($message);
            
            # Check for matching rule for this EventID
            # A rule consists of a short perl script that aims to reduce the size of $message
            # A rule may also set $discard to a true value, meaning 'do not syslog this event'
            # A rule may also wipe your hard disk or install SilverLight so be careful
            # Example filename: event-7001.pl
            # We keep track of "modified" timestamp to reload changed rules on the fly
            my $rule = 'event-'.$hashref->{'_EventID'}.".pl";
            if ($rules{$rule} || -e $rule) {
              # A rule exists for this EventID, load if necessary
              print "A rule exists for this event ID: $rule modified ".(-M $rule)."\n" if $DEBUG{rule};
              print "Cached version modified ".$rules{$rule}->{'modified'}."\n" if $rules{$rule}->{'modified'} && $DEBUG{rule};
              if (!defined $rules{$rule}->{'modified'} || -M $rule < $rules{$rule}->{'modified'}) {
                # Rule is not cached or it has been modified
                print "Loading rule $rule\n" if $DEBUG{rule};
                $rules{$rule}->{'code'} = '';
                open(my $fh, $rule) || die "Error reading $rule: $!";
                while (my $line = <$fh>) {
                  $rules{$rule}->{'code'} .= $line;
                }
                close $fh;
                $rules{$rule}->{'modified'} = -M $rule;
              }
              # Now execute the rule using eval()
              print "Executing $rule:\n" if $DEBUG{rule};
              eval $rules{$rule}->{'code'};
              warn $@ if $@; # Perhaps syslog this?
              
              # If the rule set $discard to a true value then throw this message away
              next if $discard;
              
            } else {
              print "No rule exists for this event ID: $rule\n" if $DEBUG{rule};
            }
            
            # Time to assemble the actual syslog message and send it
            my $syslog_msg = "$message Log=".$log." EventID=".$hashref->{'_EventID'}." EventType=".$hashref->{'EventType'}." Source=".$hashref->{'Source'}."\n";
            if (length($message) < $original) {
              $syslog_msg .= " [f~".($original-length($message)."]"); # Indicate that we tampered with this message
            }
            print $syslog_msg if $DEBUG{syslog};
  
            # TODO: Set meaningful facility values somehow. Use the default 'local5' for now.
            my $fac = 'local5';
            my $pri = $priority{$hashref->{'EventType'}};
  
            $syslog->send("$syslog_msg", Timestamp => $timestamp, Host => $host, rfc3164 => 1, Facility => $fac, Priority => $pri );
            
            # We logged an event, make a note of it for later and remember we have to save that info
            $last{$server}->{$log} = $base+$index;
            $need_save = 1;
          } else {
            warn "Could not read event ".($index+$base)." from $server log $log";
          }
          $index++;
        }
      } else {
        warn "Error collecting $log log from $server";
      }
    }
  }
  
  # We finished a pass. Save information if needed, then take a (short) break
  save_history() if $need_save;
  $need_save = 0;
  sleep 1;
}

sub unixtime_to_timestamp {
  my $unixtime = shift;
  my $dt = DateTime->from_epoch( epoch => $unixtime );
  $dt->set_time_zone( 'local' ); # $unixtime from Win32::EventLog appears to be in localtime, not UTC.
  return sprintf("%s %2d %s", $dt->month_abbr(), $dt->day(), $dt->hms());
}

sub load_history {
  print "Loading history to $HISTORY_FNAME\n" if $DEBUG{history};
  open(my $fh, $HISTORY_FNAME) || warn "Error reading $HISTORY_FNAME: $!";
  while (my $line = <$fh>) {
    chomp $line;
    # Line should contain "SERVERNAME/LOGNAME key=value [key2=value3] .. [keyN=valueN]"
    if ($line =~ /^(.+?)\/(.+?) (([a-z]+\=[a-z0-9]+\s*)+)/i) {
      my ($server, $log, $pairs) = ($1, $2, $3);
      print "server=$server, log=$log, pairs: $pairs\n" if $DEBUG{history};
      foreach my $pair (split(/\s/, $pairs)) {
        my ($key, $value) = split(/\=/, $pair, 2);
        # For now, the only supported key name is "last" but format is extensible
        if ($key eq 'last') {
          $last{$server}->{$log} = $value;
        }
      }
    } else {
      print "Failed to parse '$line'\n" if $DEBUG{history};
    }
  }
  close $fh;
}

sub save_history {
  print "Saving history to $HISTORY_FNAME\n" if $DEBUG{history};
  my $tempname = $HISTORY_FNAME . '.temp';
  open(my $fh, '>', $tempname) || warn "Error writing $tempname: $!";
  foreach my $server (sort keys %last) {
    foreach my $log (sort keys %{$last{$server}}) {
      print $fh "$server/$log last=".$last{$server}->{$log}."\n";
    }
  }
  close $fh;
  rename($tempname, $HISTORY_FNAME);
}

END {
  save_history() if $need_save;
}