Home | History | Annotate | Line # | Download | only in perl
      1 #!/usr/bin/perl -wT
      2 #
      3 # Author: Jefferson Ogata (JO317) <jogata (at] pobox.com>
      4 # Date: 2000/04/22
      5 # Version: 0.10
      6 #
      7 # Please feel free to use or redistribute this program if you find it useful.
      8 # If you have suggestions, or even better, bits of new code, send them to me
      9 # and I will add them when I have time. The current version of this script
     10 # can always be found at the URL:
     11 #
     12 #    http://www.antibozo.net/ogata/webtools/plog.pl
     13 #    http://pobox.com/~ogata/webtools/plog.txt
     14 #
     15 # Parse ipmon output into a coherent form. This program only handles the
     16 # lines regarding filter actions. It does not parse nat and state lines.
     17 #
     18 # Present lines from ipmon to this program on standard input.
     19 #
     20 # EXAMPLES
     21 #
     22 # plog -AF block,log < /var/log/ipf
     23 #
     24 #    Generate source and destination reports of all packets logged with
     25 #    block or log actions, and report TCP flags and keep state actions.
     26 #
     27 # plog -S -s ./services www.example.com < /var/log/ipf
     28 #
     29 #    Generate a source report of traffic to or from www.example.com using
     30 #    the additional services defined in ./services.
     31 #
     32 # plog -nSA block < /var/log/ipf
     33 #
     34 #    Generate a source report of all blocked packets with no hostname
     35 #    lookups. This is handy for an initial pass to identify portscans or
     36 #    other aggressive traffic.
     37 #
     38 # plog -SFp 192.168.0.0/24 www.example.com/24 < /var/log/ipf
     39 #
     40 #    Generate a source report of all packets whose source or destination
     41 #    address is either in 192.168.0.0/24 or an address associated with
     42 #    the host www.example.com, report packet flags and perform paranoid
     43 #    hostname lookups. This is a handy usage for examining traffic more
     44 #    closely after identifying a potential attack.
     45 #
     46 # TODO
     47 #
     48 # - Handle output from ipmon -v.
     49 # - Handle timestamps from other locales. Anyone with a timestamp problem
     50 #   please email me the format of your timestamps.
     51 # - It looks as though short TCP or UDP packets will break things, but I
     52 #   haven't seen any yet.
     53 #
     54 # CHANGES
     55 #
     56 # 2000/04/22 (0.10):
     57 # - Restructured host name and address caches. Hosts are now cached using
     58 #   packed addresses as keys. Conversion to IPv6 should be simple now.
     59 # - Added paranoid hostname lookups.
     60 # - Added netmask qualifications for address arguments.
     61 # - Tweaked usage info.
     62 # 2000/04/20:
     63 # - Added parsing and tracking of TCP and state flags.
     64 # 2000/04/12 (0.9):
     65 # - Wasn't handling underscore in hostname,servicename fields; these may be
     66 #   logged using ipmon -n. Observation by <ark (at] eltex.ru>.
     67 # - Hadn't properly attributed observation and fix for repetition counter in
     68 #   0.8 change log. Added John Ladwig to attribution. Thanks, John.
     69 #
     70 # 2000/04/10 (0.8):
     71 # - Service names can also have hyphens, dummy. I wasn't allowing these
     72 #   either. Observation and fix thanks to Taso N. Devetzis
     73 #   <devetzis (at] snet.net>.
     74 # - IP Filter now logs a repetition counter. Observation and fixes (changed
     75 #   slightly) from Andy Kreiling <Andy (at] ntcs-inc.com> and John Ladwig
     76 #   <jladwig (at] nts.umn.edu>.
     77 # - Added fix to handle new Solaris log format, e.g.:
     78 #     Nov 30 04:49:37 raoul ipmon[121]: [ID 702911 local0.warning] 04:49:36.420541 hme0 @0:34 b 205.152.16.6,58596 -> 204.60.220.24,113 PR tcp len 20 44
     79 #   Fix thanks to Taso N. Devetzis <devetzis (at] SNET.Net>.
     80 # - Added services map option.
     81 # - Added options for generating only source/destination tables.
     82 # - Added verbosity option.
     83 # - Added option for reporting traffic for specific hosts.
     84 # - Added some more ICMP unreachable codes, and made code and type names
     85 #   match the ones in IP Filter parse.c.
     86 # - Condensed output format somewhat.
     87 # - Various minor improvements, perhaps slight speed improvements.
     88 # - Documented new options in usage() and tried to improve wording.
     89 #
     90 # 1999/08/02 (0.7):
     91 # - Hostnames can have hyphens, dummy. I wasn't allowing them in the syslog
     92 #   line. Fix from Antoine Verheijen <antoine.verheijen (at] ualberta.ca>.
     93 #
     94 # 1999/05/05 (0.6):
     95 # - IRIX syslog prefixes the hostname with a severity code. Handle it. Fix
     96 #   from John Ladwig <jladwig (at] nts.umn.edu>.
     97 #
     98 # 1999/05/05 (0.5):
     99 # - Protocols other than TCP, UDP, or ICMP have packet lengths reported in
    100 #   parentheses for some reason. The script now handles this. Thanks to
    101 #   Dispatcher <dispatch (at] blackhelicopters.org>.
    102 # - I had mixed up info-request and info-reply ICMP codes, and omitted the
    103 #   traceroute code. Sorted this out. I had also missed code 0 for type 6
    104 #   (alternate address for host). Thanks to John Ladwig <jladwig (at] nts.umn.edu>.
    105 #
    106 # 1999/05/03:
    107 # - Now accepts hostnames in the source and destination address fields, as
    108 #   well as port names in the port fields. This allows the people who are
    109 #   using ipmon -n to still use plog. Note that if you are logging
    110 #   hostnames, you are vulnerable to forgery of DNS information, modified
    111 #   DNS information, and your log files will be larger also. If you are
    112 #   using this program you can have it look up the names for you (still
    113 #   vulnerable to forgery) and keep your logged addresses all in numeric
    114 #   format, so that packets from the same source will always show the same
    115 #   source address regardless of what's up with DNS. Obviously, I don't
    116 #   favor using ipmon -n. Nevertheless, some people wanted this, so here it
    117 #   is.
    118 # - Added S and n flags to %acts hash. Thanks to Stephen J. Roznowski
    119 #   <sjr (at] home.net>.
    120 # - Stopped reporting host IPs twice when numeric output was requested.
    121 #   Thanks, yet again, to Stephen J. Roznowski <sjr (at] home.net>.
    122 # - Number of minor tweaks that might speed it up a bit, and some comments.
    123 # - Put the script back up on the web site. I had moved the site and
    124 #   forgotten to move the tool.
    125 #
    126 # 1999/02/04:
    127 # - Changed log line parser to accept fully-qualified name in the logging
    128 #   host field. Thanks to Stephen J. Roznowski <sjr (at] home.net>.
    129 #
    130 # 1999/01/22:
    131 # - Changed high port strategy to use 65536 for unknown high ports so that
    132 #   they are sorted last.
    133 #
    134 # 1999/01/21:
    135 # - Moved icmp parsing to output loop.
    136 # - Added parsing of icmp codes, and more types.
    137 # - Changed packet sort routine to sort by port number rather than service
    138 #   name.
    139 #
    140 # 1999/01/20:
    141 # - Fixed problem matching ipmon log lines. Sometimes they have "/ipmon" in
    142 #   them, sometimes just "ipmon".
    143 # - Added numeric parse option to turn off hostname lookups.
    144 # - Moved summary to usage() sub.
    145 
    146 use strict;
    147 use Socket;
    148 use IO::File;
    149 
    150 select STDOUT; $| = 1;
    151 
    152 my %hosts;
    153 
    154 my $me = $0;
    155 $me =~ s/^.*\///;
    156 
    157 # Map of log codes for various actions. Not all of these can occur, but
    158 # I've included everything in print_ipflog() from ipmon.c.
    159 my %acts = (
    160     'p'	=> 'pass',
    161     'P'	=> 'pass',
    162     'b'	=> 'block',
    163     'B'	=> 'block',
    164     'L'	=> 'log',
    165     'S' => 'short',
    166     'n' => 'nomatch',
    167 );
    168 
    169 # Map of ICMP types and their relevant codes.
    170 my %icmpTypeMap = (
    171     0	=> +{
    172 	name	=> 'echorep',
    173 	codes	=> +{0	=> undef},
    174     },
    175     3	=> +{
    176 	name	=> 'unreach',
    177 	codes	=> +{
    178 	    0	=> 'net-unr',
    179 	    1	=> 'host-unr',
    180 	    2	=> 'proto-unr',
    181 	    3	=> 'port-unr',
    182 	    4	=> 'needfrag',
    183 	    5	=> 'srcfail',
    184 	    6	=> 'net-unk',
    185 	    7	=> 'host-unk',
    186 	    8	=> 'isolate',
    187 	    9	=> 'net-prohib',
    188 	    10	=> 'host-prohib',
    189 	    11	=> 'net-tos',
    190 	    12	=> 'host-tos',
    191 	    13	=> 'filter-prohib',
    192 	    14	=> 'host-preced',
    193 	    15	=> 'preced-cutoff',
    194 	},
    195     },
    196     4	=> +{
    197 	name	=> 'squench',
    198 	codes	=> +{0	=> undef},
    199     },
    200     5	=> +{
    201 	name	=> 'redir',
    202 	codes	=> +{
    203 	    0	=> 'net',
    204 	    1	=> 'host',
    205 	    2	=> 'tos',
    206 	    3	=> 'tos-host',
    207 	},
    208     },
    209     6	=> +{
    210 	name	=> 'alt-host-addr',
    211 	codes	=> +{
    212 	    0	=> 'alt-addr'
    213 	},
    214     },
    215     8	=> +{
    216 	name	=> 'echo',
    217 	codes	=> +{0	=> undef},
    218     },
    219     9	=> +{
    220 	name	=> 'routerad',
    221 	codes	=> +{0	=> undef},
    222     },
    223     10	=> +{
    224 	name	=> 'routersol',
    225 	codes	=> +{0	=> undef},
    226     },
    227     11	=> +{
    228 	name	=> 'timex',
    229 	codes	=> +{
    230 	    0	=> 'in-transit',
    231 	    1	=> 'frag-assy',
    232 	},
    233     },
    234     12	=> +{
    235 	name	=> 'paramprob',
    236 	codes	=> +{
    237 	    0	=> 'ptr-err',
    238 	    1	=> 'miss-opt',
    239 	    2	=> 'bad-len',
    240 	},
    241     },
    242     13	=> +{
    243 	name	=> 'timest',
    244 	codes	=> +{0	=> undef},
    245     },
    246     14	=> +{
    247 	name	=> 'timestrep',
    248 	codes	=> +{0	=> undef},
    249     },
    250     15	=> +{
    251 	name	=> 'inforeq',
    252 	codes	=> +{0	=> undef},
    253     },
    254     16	=> +{
    255 	name	=> 'inforep',
    256 	codes	=> +{0	=> undef},
    257     },
    258     17	=> +{
    259 	name	=> 'maskreq',
    260 	codes	=> +{0	=> undef},
    261     },
    262     18	=> +{
    263 	name	=> 'maskrep',
    264 	codes	=> +{0	=> undef},
    265     },
    266     30	=> +{
    267 	name	=> 'tracert',
    268 	codes	=> +{ },
    269     },
    270     31	=> +{
    271 	name	=> 'dgram-conv-err',
    272 	codes	=> +{ },
    273     },
    274     32	=> +{
    275 	name	=> 'mbl-host-redir',
    276 	codes	=> +{ },
    277     },
    278     33	=> +{
    279 	name	=> 'ipv6-whereru?',
    280 	codes	=> +{ },
    281     },
    282     34	=> +{
    283 	name	=> 'ipv6-iamhere',
    284 	codes	=> +{ },
    285     },
    286     35	=> +{
    287 	name	=> 'mbl-reg-req',
    288 	codes	=> +{ },
    289     },
    290     36	=> +{
    291 	name	=> 'mbl-reg-rep',
    292 	codes	=> +{ },
    293     },
    294 );
    295 
    296 # Arguments we will parse from argument list.
    297 my $numeric = 0;	# Don't lookup hostnames.
    298 my $paranoid = 0;	# Do paranoid hostname lookups.
    299 my $verbosity = 0;	# Bla' bla' bla'.
    300 my $sTable = 0;		# Generate source table.
    301 my $dTable = 0;		# Generate destination table.
    302 my @services = ();	# Preload services tables.
    303 my $showFlags = 0;	# Show TCP flag combinations.
    304 my %selectAddrs;	# Limit report to these hosts.
    305 my %selectActs;		# Limit report to these actions.
    306 
    307 # Parse argument list.
    308 while (defined ($_ = shift))
    309 {
    310     if (s/^-//)
    311     {
    312 	while (s/^([vnpSD\?hsAF])//)
    313 	{
    314 	    my $flag = $1;
    315 	    if ($flag eq 'v')
    316 	    {
    317 		++$verbosity;
    318 	    }
    319 	    elsif ($flag eq 'n')
    320 	    {
    321 		$numeric = 1;
    322 	    }
    323 	    elsif ($flag eq 'p')
    324 	    {
    325 		$paranoid = 1;
    326 	    }
    327 	    elsif ($flag eq 'S')
    328 	    {
    329 		$sTable = 1;
    330 	    }
    331 	    elsif ($flag eq 'D')
    332 	    {
    333 		$dTable = 1;
    334 	    }
    335 	    elsif ($flag eq 'F')
    336 	    {
    337 		$showFlags = 1;
    338 	    }
    339 	    elsif (($flag eq '?') || ($flag eq 'h'))
    340 	    {
    341 		&usage (0);
    342 	    }
    343 	    else
    344 	    {
    345 		my $arg = shift;
    346 		defined ($arg) || &usage (1, qq{-$flag requires an argument});
    347 		if ($flag eq 's')
    348 		{
    349 		    push (@services, $arg);
    350 		}
    351 		elsif ($flag eq 'A')
    352 		{
    353 		    my @acts = split (/,/, $arg);
    354 		    my $a;
    355 		    foreach $a (@acts)
    356 		    {
    357 			my $aa;
    358 			my $match = 0;
    359 			foreach $aa (keys (%acts))
    360 			{
    361 			    if ($acts{$aa} eq $a)
    362 			    {
    363 				++$match;
    364 				$selectActs{$aa} = $a;
    365 			    }
    366 			}
    367 			$match || &usage (1, qq{unknown action $a});
    368 		    }
    369 		}
    370 	    }
    371 	}
    372 
    373 	&usage (1, qq{unknown option: -$_}) if (length);
    374 
    375 	next;
    376     }
    377 
    378     # Add host to hash of hosts we're interested in.
    379     (/^(.+)\/([\d+\.]+)$/) || (/^(.+)$/) || &usage (1, qq{invalid CIDR address $_});
    380     my ($addr, $mask) = ($1, $2);
    381     my @addr = &hostAddrs ($addr);
    382     (scalar (@addr)) || &usage (1, qq{cannot resolve hostname $_});
    383     if (!defined ($mask))
    384     {
    385 	$mask = (2 ** 32) - 1;
    386     }
    387     elsif (($mask =~ /^\d+$/) && ($mask <= 32))
    388     {
    389 	$mask = (2 ** 32) - 1 - ((2 ** (32 - $mask)) - 1);
    390     }
    391     elsif (defined ($mask = &isDottedAddr ($mask)))
    392     {
    393 	$mask = &integerAddr ($mask);
    394     }
    395     else
    396     {
    397 	&usage (1, qq{invalid CIDR address $_});
    398     }
    399     foreach $addr (@addr)
    400     {
    401 	# Save mask unless we already have a less specific one for this address.
    402 	my $a = &integerAddr ($addr) & $mask;
    403 	$selectAddrs{$a} = $mask unless (exists ($selectAddrs{$a}) && ($selectAddrs{$a} < $mask));
    404     }
    405 }
    406 
    407 # Which tables will we generate?
    408 $dTable = $sTable = 1 unless ($dTable || $sTable);
    409 my @dirs;
    410 push (@dirs, 'd') if ($dTable);
    411 push (@dirs, 's') if ($sTable);
    412 
    413 # Are we interested in specific hosts?
    414 my $selectAddrs = scalar (keys (%selectAddrs));
    415 
    416 # Are we interested in specific actions?
    417 if (scalar (keys (%selectActs)) == 0)
    418 {
    419     %selectActs = %acts;
    420 }
    421 
    422 # We use this hash to cache port name -> number and number -> name mappings.
    423 # Isn't it cool that we can use the same hash for both?
    424 my %pn;
    425 
    426 # Preload any services maps.
    427 my $sm;
    428 foreach $sm (@services)
    429 {
    430     my $sf = new IO::File ($sm, "r");
    431     defined ($sf) || &quit (1, qq{cannot open services file $sm});
    432 
    433     while (defined ($_ = $sf->getline ()))
    434     {
    435 	my $text = $_;
    436 	chomp;
    437 	s/#.*$//;
    438 	s/\s+$//;
    439 	next unless (length);
    440 	my ($name, $spec, @aliases) = split (/\s+/);
    441 	($spec =~ /^([\w\-]+)\/([\w\-]+)$/)
    442 	    || &quit (1, qq{$sm:$.: invalid definition: $text});
    443 	my ($pnum, $proto) = ($1, $2);
    444 
    445 	# Enter service definition in pn hash both forwards and backwards.
    446 	my $port;
    447 	my $pname;
    448 	foreach $port ($name, @aliases)
    449 	{
    450 	    $pname = "$pnum/$proto";
    451 	    $pn{$pname} = $port;
    452 	}
    453 	$pname = "$name/$proto";
    454 	$pn{$pname} = $pnum;
    455     }
    456 
    457     $sf->close ();
    458 }
    459 
    460 # Cache for host name -> addr mappings.
    461 my %ipAddr;
    462 
    463 # Cache for host addr -> name mappings.
    464 my %ipName;
    465 
    466 # Hash for protocol number <--> name mappings.
    467 my %pr;
    468 
    469 # Under IPv4 port numbers are unsigned shorts. The value below is higher
    470 # than the maximum value of an unsigned short, and is used in place of
    471 # high port numbers that don't correspond to known services. This makes
    472 # high ports get sorted behind all others.
    473 my $highPort = 0x10000;
    474 
    475 while (<STDIN>)
    476 {
    477     chomp;
    478 
    479     # For ipmon output that came through syslog, we'll have an asctime
    480     # timestamp, an optional severity code (IRIX), the hostname,
    481     # "ipmon"[process id]: prefixed to the line. For output that was
    482     # written directly to a file by ipmon, we'll have a date prefix as
    483     # dd/mm/yyyy (no y2k problem here!). Both formats then have a packet
    484     # timestamp and the log info.
    485     my ($log);
    486     if (s/^\w+\s+\d+\s+\d+:\d+:\d+\s+(?:\d\w:)?[\w\.\-]+\s+\S*ipmon\[\d+\]:\s+(?:\[ID\s+\d+\s+[\w\.]+\]\s+)?\d+:\d+:\d+\.\d+\s+//)
    487     {
    488 	$log = $_;
    489     }
    490     elsif (s/^(?:\d+\/\d+\/\d+)\s+(?:\d+:\d+:\d+\.\d+)\s+//)
    491     {
    492 	$log = $_;
    493     }
    494     else
    495     {
    496 	# It don't look like no ipmon output to me, baby.
    497 	next;
    498     }
    499     next unless (defined ($log));
    500 
    501     print STDERR "$log\n" if ($verbosity);
    502 
    503     # Parse the log line. We're expecting interface name, rule group and
    504     # number, an action code, a source host name or IP with possible port
    505     # name or number, a destination host name or IP with possible port
    506     # number, "PR", a protocol name or number, "len", a header length, a
    507     # packet length (which will be in parentheses for protocols other than
    508     # TCP, UDP, or ICMP), and maybe some additional info.
    509     my @fields = ($log =~ /^(?:(\d+)x)?\s*(\w+)\s+@(\d+):(\d+)\s+(\w)\s+([\w\-\.,]+)\s+->\s+([\w\-\.,]+)\s+PR\s+(\w+)\s+len\s+(\d+)\s+\(?(\d+)\)?\s*(.*)$/ox);
    510     unless (scalar (@fields))
    511     {
    512 	print STDERR "$me:$.: cannot parse: $_\n";
    513 	next;
    514     }
    515     my ($count, $if, $group, $rule, $act, $src, $dest, $proto, $hlen, $len, $more) = @fields;
    516 
    517     # Skip actions we're not interested in.
    518     next unless (exists ($selectActs{$act}));
    519 
    520     # Packet count defaults to 1.
    521     $count = 1 unless (defined ($count));
    522 
    523     my ($sport, $dport, @flags);
    524 
    525     if ($proto eq 'icmp')
    526     {
    527 	if ($more =~ s/^icmp (\d+)\/(\d+)\s*//)
    528 	{
    529 	    # We save icmp type and code in both sport and dport. This
    530 	    # allows us to sort icmp packets using the normal port-sorting
    531 	    # code.
    532 	    $dport = $sport = "$1.$2";
    533 	}
    534 	else
    535 	{
    536 	    $sport = '';
    537 	    $dport = '';
    538 	}
    539     }
    540     else
    541     {
    542 	if ($showFlags)
    543 	{
    544 	    if (($proto eq 'tcp') && ($more =~ s/^\-([A-Z]+)\s*//))
    545 	    {
    546 		push (@flags, $1);
    547 	    }
    548 	    if ($more =~ s/^K\-S\s*//)
    549 	    {
    550 		push (@flags, 'state');
    551 	    }
    552 	}
    553 	if ($src =~ s/,([\-\w]+)$//)
    554 	{
    555 	    $sport = &portSimplify ($1, $proto);
    556 	}
    557 	else
    558 	{
    559 	    $sport = '';
    560 	}
    561 	if ($dest =~ s/,([\-\w]+)$//)
    562 	{
    563 	    $dport = &portSimplify ($1, $proto);
    564 	}
    565 	else
    566 	{
    567 	    $dport = '';
    568 	}
    569     }
    570 
    571     # Make sure addresses are numeric at this point. We want to sort by
    572     # IP address later. If the hostname doesn't resolve, punt. If you
    573     # must use ipmon -n, be ready for weirdness. Use only the first
    574     # address returned.
    575     my $x;
    576     $x = (&hostAddrs ($src))[0];
    577     unless (defined ($x))
    578     {
    579 	print STDERR "$me:$.: cannot resolve hostname $src\n";
    580 	next;
    581     }
    582     $src = $x;
    583     $x = (&hostAddrs ($dest))[0];
    584     unless (defined ($x))
    585     {
    586 	print STDERR "$me:$.: cannot resolve hostname $dest\n";
    587 	next;
    588     }
    589     $dest = $x;
    590 
    591     # Skip hosts we're not interested in.
    592     if ($selectAddrs)
    593     {
    594 	my ($a, $m);
    595 	my $s = &integerAddr ($src);
    596 	my $d = &integerAddr ($dest);
    597 	my $cute = 0;
    598 	while (($a, $m) = each (%selectAddrs))
    599 	{
    600 	    if ((($s & $m) == $a) || (($d & $m) == $a))
    601 	    {
    602 		$cute = 1;
    603 		last;
    604 	    }
    605 	}
    606 	next unless ($cute);
    607     }
    608 
    609     # Convert proto to proto number.
    610     $proto = &protoNumber ($proto);
    611 
    612     sub countPacket
    613     {
    614 	my ($host, $dir, $peer, $proto, $count, $packet, @flags) = @_;
    615 
    616 	# Make sure host is in the hosts hash.
    617 	$hosts{$host} =
    618 	    +{
    619 		'd'	=> +{ },
    620 		's'	=> +{ },
    621 	    } unless (exists ($hosts{$host}));
    622 
    623 	# Get the source/destination traffic hash for the host in question.
    624 	my $trafficHash = $hosts{$host}->{$dir};
    625 
    626 	# Make sure there's a hash for the peer.
    627 	$trafficHash->{$peer} = +{ } unless (exists ($trafficHash->{$peer}));
    628 
    629 	# Make sure the peer hash has a hash for the protocol number.
    630 	my $peerHash = $trafficHash->{$peer};
    631 	$peerHash->{$proto} = +{ } unless (exists ($peerHash->{$proto}));
    632 
    633 	# Make sure there's a counter for this packet type in the proto hash.
    634 	my $protoHash = $peerHash->{$proto};
    635 	$protoHash->{$packet} = +{ '' => 0 } unless (exists ($protoHash->{$packet}));
    636 
    637 	# Increment the counter and mark flags.
    638 	my $packetHash = $protoHash->{$packet};
    639 	$packetHash->{''} += $count;
    640 	map { $packetHash->{$_} = undef; } (@flags);
    641     }
    642 
    643     # Count the packet as outgoing traffic from the source address.
    644     &countPacket ($src, 's', $dest, $proto, $count, "$sport:$dport:$if:$act", @flags) if ($sTable);
    645 
    646     # Count the packet as incoming traffic to the destination address.
    647     &countPacket ($dest, 'd', $src, $proto, $count, "$dport:$sport:$if:$act", @flags) if ($dTable);
    648 }
    649 
    650 my $dir;
    651 foreach $dir (@dirs)
    652 {
    653     my $order = ($dir eq 's' ? 'source' : 'destination');
    654     my $arrow = ($dir eq 's' ? '->' : '<-');
    655 
    656     print "###\n";
    657     print "### Traffic by $order address:\n";
    658     print "###\n";
    659 
    660     sub ipSort
    661     {
    662 	&integerAddr ($a) <=> &integerAddr ($b);
    663     }
    664 
    665     sub packetSort
    666     {
    667 	my ($asport, $adport, $aif, $aact) = split (/:/, $a);
    668 	my ($bsport, $bdport, $bif, $bact) = split (/:/, $b);
    669 	$bact cmp $aact || $aif cmp $bif || $asport <=> $bsport || $adport <=> $bdport;
    670     }
    671 
    672     my $host;
    673     foreach $host (sort ipSort (keys %hosts))
    674     {
    675 	my $traffic = $hosts{$host}->{$dir};
    676 
    677 	# Skip hosts with no traffic.
    678 	next unless (scalar (keys (%{$traffic})));
    679 
    680 	if ($numeric)
    681 	{
    682 	    print &dottedAddr ($host), "\n";
    683 	}
    684 	else
    685 	{
    686 	    print &hostName ($host), " \[", &dottedAddr ($host), "\]\n";
    687 	}
    688 
    689 	my $peer;
    690 	foreach $peer (sort ipSort (keys %{$traffic}))
    691 	{
    692 	    my $peerHash = $traffic->{$peer};
    693 	    my $peerName = ($numeric ? &dottedAddr ($peer) : &hostName ($peer));
    694 	    my $proto;
    695 	    foreach $proto (sort (keys (%{$peerHash})))
    696 	    {
    697 		my $protoHash = $peerHash->{$proto};
    698 		my $protoName = &protoName ($proto);
    699 
    700 		my $packet;
    701 		foreach $packet (sort packetSort (keys %{$protoHash}))
    702 		{
    703 		    my ($sport, $dport, $if, $act) = split (/:/, $packet);
    704 		    my $packetHash = $protoHash->{$packet};
    705 		    my $count = $packetHash->{''};
    706 		    $act = '?' unless (defined ($act = $acts{$act}));
    707 		    if (($protoName eq 'tcp') || ($protoName eq 'udp'))
    708 		    {
    709 			printf ("    %-6s %7s %4d %4s %16s %2s %s.%s", $if, $act, $count, $protoName, &portName ($sport, $protoName), $arrow, $peerName, &portName ($dport, $protoName));
    710 		    }
    711 		    elsif ($protoName eq 'icmp')
    712 		    {
    713 			printf ("    %-6s %7s %4d %4s %16s %2s %s", $if, $act, $count, $protoName, &icmpType ($sport), $arrow, $peerName);
    714 		    }
    715 		    else
    716 		    {
    717 			printf ("    %-6s %7s %4d %4s %16s %2s %s", $if, $act, $count, $protoName, '', $arrow, $peerName);
    718 		    }
    719 		    if ($showFlags)
    720 		    {
    721 			my @flags = sort (keys (%{$packetHash}));
    722 			if (scalar (@flags))
    723 			{
    724 			    shift (@flags);
    725 			    print ' (', join (',', @flags), ')' if (scalar (@flags));
    726 			}
    727 		    }
    728 		    print "\n";
    729 		}
    730 	    }
    731 	}
    732     }
    733 
    734     print "\n";
    735 }
    736 
    737 exit (0);
    738 
    739 # Translates a numeric port/named protocol to a port name. Reserved ports
    740 # that do not have an entry in the services database are left numeric. High
    741 # ports that do not have an entry in the services database are mapped
    742 # to '<high>'.
    743 sub portName
    744 {
    745     my $port = shift;
    746     my $proto = shift;
    747     my $pname = "$port/$proto";
    748     unless (exists ($pn{$pname}))
    749     {
    750 	my $name = getservbyport ($port, $proto);
    751 	$pn{$pname} = (defined ($name) ? $name : ($port <= 1023 ? $port : '<high>'));
    752     }
    753     return $pn{$pname};
    754 }
    755 
    756 # Translates a named port/protocol to a port number.
    757 sub portNumber
    758 {
    759     my $port = shift;
    760     my $proto = shift;
    761     my $pname = "$port/$proto";
    762     unless (exists ($pn{$pname}))
    763     {
    764 	my $number = getservbyname ($port, $proto);
    765 	unless (defined ($number))
    766 	{
    767 	    # I don't think we need to recover from this. How did the port
    768 	    # name get into the log file if we can't find it? Log file from
    769 	    # a different machine? Fix /etc/services on this one if that's
    770 	    # your problem.
    771 	    die ("Unrecognized port name \"$port\" at $.");
    772 	}
    773 	$pn{$pname} = $number;
    774     }
    775     return $pn{$pname};
    776 }
    777 
    778 # Convert all unrecognized high ports to the same value so they are treated
    779 # identically. The protocol should be by name.
    780 sub portSimplify
    781 {
    782     my $port = shift;
    783     my $proto = shift;
    784 
    785     # Make sure port is numeric.
    786     $port = &portNumber ($port, $proto)
    787 	unless ($port =~ /^\d+$/);
    788 
    789     # Look up port name.
    790     my $portName = &portName ($port, $proto);
    791 
    792     # Port is an unknown high port. Return a value that is too high for a
    793     # port number, so that high ports get sorted last.
    794     return $highPort if ($portName eq '<high>');
    795 
    796     # Return original port number.
    797     return $port;
    798 }
    799 
    800 # Translates a numeric address into a hostname. Pass only packed numeric
    801 # addresses to this routine.
    802 sub hostName
    803 {
    804     my $ip = shift;
    805     return $ipName{$ip} if (exists ($ipName{$ip}));
    806 
    807     # Do an inverse lookup on the address.
    808     my $name = gethostbyaddr ($ip, AF_INET);
    809     unless (defined ($name))
    810     {
    811 	# Inverse lookup failed, so map the IP address to its dotted
    812 	# representation and cache that.
    813 	$ipName{$ip} = &dottedAddr ($ip);
    814 	return $ipName{$ip};
    815     }
    816 
    817     # For paranoid hostname lookups.
    818     if ($paranoid)
    819     {
    820 	# If this address already matches, we're happy.
    821 	unless (exists ($ipName{$ip}) && (lc ($ipName{$ip}) eq lc ($name)))
    822 	{
    823 	    # Do a forward lookup on the resulting name.
    824 	    my @addr = &hostAddrs ($name);
    825 	    my $match = 0;
    826 
    827 	    # Cache the forward lookup results for future inverse lookups,
    828 	    # but don't stomp on inverses we've already cached, even if they
    829 	    # are questionable. We want to generate consistent output, and
    830 	    # the cache is growing incrementally.
    831 	    foreach (@addr)
    832 	    {
    833 		$ipName{$_} = $name unless (exists ($ipName{$_}));
    834 		$match = 1 if ($_ eq $ip);
    835 	    }
    836 
    837 	    # Was this one of the addresses? If not, tack on a ?.
    838 	    $name .= '?' unless ($match);
    839 	}
    840     }
    841     else
    842     {
    843 	# Just believe it and cache it.
    844 	$ipName{$ip} = $name;
    845     }
    846 
    847     return $name;
    848 }
    849 
    850 # Translates a hostname or dotted address into a list of packed numeric
    851 # addresses.
    852 sub hostAddrs
    853 {
    854     my $name = shift;
    855     my $ip;
    856 
    857     # Check if it's a dotted representation.
    858     return ($ip) if (defined ($ip = &isDottedAddr ($name)));
    859 
    860     # Return result from cache.
    861     $name = lc ($name);
    862     return @{$ipAddr{$name}} if (exists ($ipAddr{$name}));
    863 
    864     # Look up the addresses.
    865     my @addr = gethostbyname ($name);
    866     splice (@addr, 0, 4);
    867 
    868     unless (scalar (@addr))
    869     {
    870 	# Again, I don't think we need to recover from this gracefully.
    871 	# If we can't resolve a hostname that ended up in the log file,
    872 	# punt. We want to be able to sort hosts by IP address later,
    873 	# and letting hostnames through will snarl up that code. Users
    874 	# of ipmon -n will have to grin and bear it for now. The
    875 	# functions that get undef back should treat it as an error or
    876 	# as some default address, e.g. 0 just to make things work.
    877 	return ();
    878     }
    879 
    880     $ipAddr{$name} = [ @addr ];
    881     return @{$ipAddr{$name}};
    882 }
    883 
    884 # If the argument is a valid dotted address, returns the corresponding
    885 # packed numeric address, otherwise returns undef.
    886 sub isDottedAddr
    887 {
    888     my $addr = shift;
    889     if ($addr =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
    890     {
    891 	my @a = (int ($1), int ($2), int ($3), int ($4));
    892 	foreach (@a)
    893 	{
    894 	    return undef if ($_ >= 256);
    895 	}
    896 	return pack ('C*', @a);
    897     }
    898     return undef;
    899 }
    900 
    901 # Unpacks a packed numeric address and returns an integer representation.
    902 sub integerAddr
    903 {
    904     my $addr = shift;
    905     return unpack ('N', $addr);
    906 
    907     # The following is for generalized IPv4/IPv6 stuff. For now, it's a
    908     # lot faster to assume IPv4.
    909     my @a = unpack ('C*', $addr);
    910     my $a = 0;
    911     while (scalar (@a))
    912     {
    913 	$a = ($a << 8) | shift (@a);
    914     }
    915     return $a;
    916 }
    917 
    918 # Unpacks a packed numeric address into a dotted representation.
    919 sub dottedAddr
    920 {
    921     my $addr = shift;
    922     my @a = unpack ('C*', $addr);
    923     return join ('.', @a);
    924 }
    925 
    926 # Translates a protocol number into a protocol name, or a number if no name
    927 # is found in the protocol database.
    928 sub protoName
    929 {
    930     my $code = shift;
    931     return $code if ($code !~ /^\d+$/);
    932     unless (exists ($pr{$code}))
    933     {
    934 	my $name = scalar (getprotobynumber ($code));
    935 	if (defined ($name))
    936 	{
    937 	    $pr{$code} = $name;
    938 	}
    939 	else
    940 	{
    941 	    $pr{$code} = $code;
    942 	}
    943     }
    944     return $pr{$code};
    945 }
    946 
    947 # Translates a protocol name or number into a protocol number.
    948 sub protoNumber
    949 {
    950     my $name = shift;
    951     return $name if ($name =~ /^\d+$/);
    952     unless (exists ($pr{$name}))
    953     {
    954 	my $code = scalar (getprotobyname ($name));
    955 	if (defined ($code))
    956 	{
    957 	    $pr{$name} = $code;
    958 	}
    959 	else
    960 	{
    961 	    $pr{$name} = $name;
    962 	}
    963     }
    964     return $pr{$name};
    965 }
    966 
    967 sub icmpType
    968 {
    969     my $typeCode = shift;
    970     my ($type, $code) = split ('\.', $typeCode);
    971 
    972     return "?" unless (defined ($code));
    973 
    974     my $info = $icmpTypeMap{$type};
    975 
    976     return "\(type=$type/$code?\)" unless (defined ($info));
    977 
    978     my $typeName = $info->{name};
    979     my $codeName;
    980     if (exists ($info->{codes}->{$code}))
    981     {
    982 	$codeName = $info->{codes}->{$code};
    983 	$codeName = (defined ($codeName) ? "/$codeName" : '');
    984     }
    985     else
    986     {
    987 	$codeName = "/$code";
    988     }
    989     return "$typeName$codeName";
    990 }
    991 
    992 sub quit
    993 {
    994     my $ec = shift;
    995     my $msg = shift;
    996 
    997     print STDERR "$me: $msg\n";
    998     exit ($ec);
    999 }
   1000 
   1001 sub usage
   1002 {
   1003     my $ec = shift;
   1004     my @msg = @_;
   1005 
   1006     if (scalar (@msg))
   1007     {
   1008 	print STDERR "$me: ", join ("\n", @msg), "\n\n";
   1009     }
   1010 
   1011     print <<EOT;
   1012 usage: $me [-nSDF] [-s servicemap] [-A act1,...] [address...]
   1013 
   1014 Parses logging from ipmon and presents it in a comprehensible format. This
   1015 program generates two reports: one organized by source address and another
   1016 organized by destination address. For the first report, source addresses are
   1017 sorted by IP address. For each address, all packets originating at the address
   1018 are presented in a tabular form, where all packets with the same source and
   1019 destination address and port are counted as a single entry. Any port number
   1020 greater than 1023 that does not match an entry in the services table is treated
   1021 as a "high" port; all high ports are coalesced into the same entry. The fields
   1022 for the source address report are:
   1023     iface action packet-count proto src-port dest-host.dest-port \[\(flags\)\]
   1024 The fields for the destination address report are:
   1025     iface action packet-count proto dest-port src-host.src-port \[\(flags\)\]
   1026 
   1027 Options are:
   1028 -n           Disable hostname lookups, and report only IP addresses.
   1029 -p           Perform paranoid hostname lookups.
   1030 -S           Generate a source address report.
   1031 -D           Generate a destination address report.
   1032 -F           Show all flag combinations associated with packets.
   1033 -s map       Supply an alternate services map to be preloaded. The map should
   1034 	     be in the same format as /etc/services. Any service name not found
   1035              in the map will be looked for in the system services file.
   1036 -A act1,...  Limit the report to the specified actions. The possible actions
   1037 	     are pass, block, log, short, and nomatch.
   1038 
   1039 If any addresses are supplied on the command line, the report is limited to
   1040 these hosts. Addresses may be given as dotted IP addresses or hostnames, and
   1041 may be qualified with netmasks in CIDR \(/24\) or dotted \(/255.255.255.0\) format.
   1042 If a hostname resolves to multiple addresses, all addresses are used.
   1043 
   1044 If neither -S nor -D is given, both reports are generated.
   1045 
   1046 Note: if you are logging traffic with ipmon -n, ipmon will already have looked
   1047 up and logged addresses as hostnames where possible. This has an important side
   1048 effect: this program will translate the hostnames back into IP addresses which
   1049 may not match the original addresses of the logged packets because of numerous
   1050 DNS issues. If you care about where packets are really coming from, you simply
   1051 cannot rely on ipmon -n. An attacker with control of his reverse DNS can map
   1052 the reverse lookup to anything he likes. If you haven't logged the numeric IP
   1053 address, there's no way to discover the source of an attack reliably. For this
   1054 reason, I strongly recommend that you run ipmon without the -n option, and use
   1055 this or a similar script to do reverse lookups during analysis, rather than
   1056 during logging.
   1057 EOT
   1058 
   1059     exit ($ec);
   1060 }
   1061 
   1062