#!/usr/local/bin/perl -nwT
#
# Copyright Hank Leininger <hlein@korelogic.com>, <hlein@progressive-comp.com>

INIT {
  $::V = '$Id: probe_summ,v 1.4 2005/10/19 17:22:58 hlein Exp $';
  $::V =~ s/^.*,v //; $::V =~ s/ .*//;
}

# Crunch Linux firewall logs and print a summary of top scanners,
# top scanned ports, etc.  Optionally ignore the most boring, noisy
# scanned ports, so that they don't bury things which are potentially
# more interesting.

INIT
{
  use strict;
  delete($ENV{'PATH'});

  # Should we filter out known noisy ports?
  $::skip_boring = 1;

  # How many of each category to print?  Top 5, Top 10, etc
  $::print_entries = 5;

  # Do logs with no prefix at all ('kernel IN=...') mean a packet was
  # accepted, or that it was dropped?
  $::bare_is_accept = 0;

  # How many distinct source IPs are we willing to track?
  $::MAX_SIPS = 50000;

  # How many distinct dest IPs are we willing to track?
  $::MAX_DIPS = 10000;

  # Set up our lists of port-probes to ignore:

  # TCP ports probed so often they are boring
  %::IGNORE_TCPS = map { $_, 1 } qw(
	22	25	80	111	113	135	139	443	445
	1433	3128	3389	4899	5554	6112	6129	8000	8080
	9898	12345	17300
  );

  # UDP ports probed so often they are boring
  %::IGNORE_UDPS = map { $_, 1 } qw(
	53	135	137	138	1025	1026	1027	1028	1029
	1434
  );

  # ICMP mesage-types that are boring
  %::IGNORE_ICMPS = map { $_, 1 } qw(
	0
  );

  # If the firewall is set up to log unserved packets,
  # should we ignore those for certain common ports?
  %::IGNORE_UNSERVED = map { $_, 1 } qw(
	21	22	23	52	80	443	465	993	3128
	8080	8088
  );

  # Any source IPs that we should whitelist, not report on?
  %::IGNORE_SIPS = map { $_, 1 } qw(
	127.0.0.1
  );

  # Any dest IPs that we should whitelist, not report on?
  %::IGNORE_DIPS = map { $_, 1 } qw(
	127.0.0.1
  );

  $::TotalScans = 0;
  $::NonBoringScans = 0;
  keys(%::SIPs) = 4096;
  keys(%::DIPs) = 4096;

  # This is funky: if an unlabelled log is an accept,
  # our regexes will tune them out anyway.
  # But if it is a deny, we need to add to our regex
  # so that we do not ignore it.
  if ($::bare_is_accept)
  {
    $::skip_in_regex = '';
  }
  else
  {
    $::skip_in_regex = '|IN=';
  }

  if (  (@ARGV and $ARGV[0] =~ /^-./) or
	(-t STDIN and not @ARGV) )
  {
    (my $basename = $0) =~ s%.*/%%;
    warn "
  Usage: $basename /var/log/messages
     or: egrep kernel /var/log/messages | $basename 

 There are no options yet; edit the script to set various tunables.

$basename version: $::V
";
    exit;
  }
}

# toss out lines that are not well-formed kernel logs
# it is so much faster to match only, and not s/ / /,
# that we do this now and then repeat it almost
# exactly the same next line.

next unless /^[A-Z][a-z][a-z]\s[0-9 ]{2}\s[ 0-9:]{8} [^ ]+ kernel: (?:Packet log: |FW: |(?:FW-IN )?PDROP[: ]|HACKERLAN ${::skip_in_regex})/o;

# strip timestamp and originating host off the front of the log message
next unless s/^([A-Z][a-z][a-z]\s[0-9 ]{2}\s[ 0-9:]{8}) ([^ ]+)\skernel:\s(?:Packet log: |FW: |(?:FW-IN )?PDROP[: ]|HACKERLAN ${::skip_in_regex})//;
my $timestamp = $1;
my $host = $2;

# Skip all firewall accepts
next if (/^[^ ]+ (?:MASQ|ACCEPT|accept)/);

# Avoid uninitialized-value warnings
my ($sip, $dip, $proto, $spt, $dpt) = ('', '', '', '', '');

# normalize logs: remove MAC= entries, if any, so
# we don't have to allow for them in our regexes below
s/MAC=[0-9a-fA-F:]+ //;

# Parse various different flavors of Linux firewall logs
if (/SRC=([0-9.]+) DST=([0-9.]+).*PROTO=([^ ]+)(?: SPT=([0-9]+) DPT=([0-9]+) )?/)
{
  ($sip, $dip, $proto, $spt, $dpt) = ($1, $2, $3, $4, $5);
}
elsif (/PROTO=([A-Z0-9]+) ([0-9.]+)(?::([0-9]+))? ([0-9.]+)(?::([0-9]+))? /)
{
  ($proto, $sip, $spt, $dip, $dpt) = ($1, $2, $3, $4, $5);
}
elsif (/PROTO=(ICMP)\/([0-9]+):[0-9]+ ([0-9.]+) ([0-9.]+) /)
{
  ($proto, $spt, $sip, $dip) = ($1, $2, $3, $4);
}
else
{
  # Keep a count of unparsable log lines.  A fairly small number
  # probably means handfuls of corrupt log entries (printk is racy).
  # But large numbers means something is substantially different,
  # and we are seeing a new format of log entry.
  $::Unknown++;
  next;
}

$::TotalScans++;

# Normalize protocols
if	($proto eq '1')		{ $proto='ICMP' }
elsif	($proto eq '6')		{ $proto='TCP' }
elsif	($proto eq '17')	{ $proto='UDP' }

# For ICMP the type we care about is actually in $spt, not $dpt
$dpt = $spt if ($proto eq 'ICMP');

# we will not get ports for oddball protocols
# fill in dummy values
$dpt = '0' unless $dpt;
$spt = '0' unless $spt;

# Skip any white-listed IPs (always, not just when skipping boring)
next if $::IGNORE_SIPS{$sip};
next if $::IGNORE_DIPS{$dip};

# Skip known-boring port probes
if ($::skip_boring)
{
  next if ( ($proto eq 'TCP')	and $::IGNORE_TCPS{$dpt});
  next if ( ($proto eq 'UDP')	and $::IGNORE_UDPS{$dpt});
  next if ( ($proto eq 'ICMP')	and $::IGNORE_ICMPS{$dpt});
  next if ( /UNSERVED/		and $::IGNORE_UNSERVED{$dpt});
}

$::NonBoringScans++;

$::SIPs{$sip}++;
die "More than $::MAX_SIPS unique source IPs; probably massive forged packets!\n" .
	"Quitting before I run out of memory.\n" if scalar(keys %::SIPs) > $::MAX_SIPS;

$::DIPs{$dip}++;
die "More than $::MAX_DIPS unique dest IPs; probably massive forged packets!\n" .
	"Quitting before I run out of memory.\n" if scalar(keys %::DIPs) > $::MAX_DIPS;

$::Scans{$proto}{$dpt}++;

(my $hour = $timestamp) =~ s/:[0-9]+$//;
$::Hourly{$hour}++;

END {
  exit unless $::TotalScans;
  print "Saw $::TotalScans total connection attempts",
	($::skip_boring ? ", $::NonBoringScans of which were not boring" : ''),
	".\n";
  print "Saw $::Unknown unparsable lines.\n" if ($::Unknown);

  foreach my $proto (qw(TCP UDP ICMP))
  {
    if (keys %{ $::Scans{$proto} })
    {
      my $total = (scalar keys %{ $::Scans{$proto} });
      my $count = 0;
      print "Top " .
		($total > $::print_entries ? $::print_entries : $total) .
				" of $total total $proto targets:\n";
      foreach my $key (sort { $::Scans{$proto}{$b} <=> $::Scans{$proto}{$a} }
						(keys %{ $::Scans{$proto} }))
      {
        last if $count++ >= $::print_entries;
        printf "%8d  %s\n", $::Scans{$proto}{$key}, $key;
      }
    }
  }

  if (keys %::SIPs)
  {
    my $total = (scalar(keys %::SIPs));
    print "Top " .
		($total > $::print_entries ? $::print_entries : $total) .
				" of $total total source IPs:\n";
    my $count = 0;
    foreach my $host (sort { $::SIPs{$b} <=> $::SIPs{$a} }
						(keys %::SIPs))
    {
      last if $count++ >= $::print_entries;
      printf "%8d  %s\n", $::SIPs{$host}, $host;
    }
  }

  if (keys %::DIPs)
  {
    my $total = (scalar(keys %::DIPs));
    print "Top " .
		($total > $::print_entries ? $::print_entries : $total) .
				" of $total total dest IPs:\n";
    my $count = 0;
    foreach my $host (sort { $::DIPs{$b} <=> $::DIPs{$a} }
						(keys %::DIPs))
    {
      last if $count++ >= $::print_entries;
      printf "%8d  %s\n", $::DIPs{$host}, $host;
    }
  }

  if (keys %::Hourly)
  {
    my $total = (scalar(keys %::Hourly));
    print "Top " .
		($total > $::print_entries ? $::print_entries : $total) .
				" of $total total Hours:\n";
    my $count = 0;
    foreach my $timeslice (sort { $::Hourly{$b} <=> $::Hourly{$a} }
						(keys %::Hourly))
    {
      last if $count++ >= $::print_entries;
      printf "%8d  %s\n", $::Hourly{$timeslice}, $timeslice;
    }
  }
}