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