new perls v5.39.10
[andk-cpan-tools.git] / bin / parse-tcpdump-20160507.pl
blob828a36720fcc9c095036c532ff51cf07b349ad41
1 #!/usr/bin/perl
3 # use 5.010;
4 use strict;
5 use warnings;
7 =head1 NAME
11 =head1 SYNOPSIS
15 =head1 OPTIONS
17 =over 8
19 =cut
21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
23 =item B<--help|h!>
25 This help
27 =back
29 =head1 DESCRIPTION
33 =cut
36 use FindBin;
37 use lib "$FindBin::Bin/../lib";
38 BEGIN {
39 push @INC, qw( );
42 use Dumpvalue;
43 use File::Basename qw(dirname);
44 use File::Path qw(mkpath);
45 use File::Spec;
46 use File::Temp;
47 use Getopt::Long;
48 use Pod::Usage;
49 use Hash::Util qw(lock_keys);
51 our %Opt;
52 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
53 GetOptions(\%Opt,
54 @opt,
55 ) or pod2usage(1);
56 if ($Opt{help}) {
57 pod2usage(0);
60 use Net::Pcap;
61 use Net::Pcap::Easy;
62 use Term::ANSIColor;
64 my $file = shift @ARGV or die "Usage:...";
65 my $dumper = new Dumpvalue tick => "\"";
66 my $pc;
68 my $err;
69 $pc = Net::Pcap::open_offline($file,\$err);
70 die $err if $err;
72 my $cnt = 0;
74 XXX
76 my $open_connections = 0;
77 my @color_code =
78 ("on_red",
79 "on_green",
80 "on_yellow",
81 "yellow on_blue",
82 "on_magenta",
83 "on_cyan",
84 "on_white",
86 my(%reverse_portcolor, %open_connections, %startpack);
87 my(%Seen);
89 use Time::HiRes qw(gettimeofday); { our($cached_t, $cached_ts);sub itms { my($t)=shift||[gettimeofday]; my $ts; if ($cached_ts && $cached_t == $t->[0]){ $ts = $cached_ts; } else { $cached_t = $t->[0]; $cached_ts = $ts = sub { sprintf q{%04d-%02d-%02dT%02d:%02d:%02d}, $_[5]+1900, $_[4] +1,@_[3, 2, 1, 0];}->(localtime $t->[0]); } return sprintf "%s.%06d", $ts, $t->[1];}}
91 my $npe = Net::Pcap::Easy->new
93 pcap => $pc,
94 packets_per_loop => -1,
95 udp_callback => sub {
96 my ($npe, $ether, $ip, $udp, $header, $packet) = @_;
97 $cnt++;
99 # $DB::single = 1;
101 # printf "%8d %-15s %-15s %5d %5d %d\n", $cnt, $ip->{src_ip}, $ip->{dest_ip}, $udp->{src_port}, $udp->{dest_port}, $udp->{data} ? length($udp->{data}) : 0;
102 my $show = 1;
103 if ( $Opt{port} ) {
104 unless ( $udp->{src_port}==$Opt{port} || $udp->{dest_port}==$Opt{port} ) {
105 $show = 0;
108 return unless $show;
110 my(%dbmd);
111 my(@dbmdfields) = qw(vers seq type status namelen keylen datalen data);
112 @dbmd{@dbmdfields} = unpack "(N)7 A*", $udp->{data}; # typedef struct _dbmrsp from rz/lib/rdbm/dbmproto.h
113 $dbmd{data} = "" if $dbmd{datalen} == 0 and $dbmd{namelen} == 0 and $dbmd{keylen}==0;
115 my $color_on = color "on_white";
116 if ( ! grep { $udp->{src_port} == $_ } 201, 203 ) {
117 $color_on = color "black on_white";
118 } elsif ( $ip->{src_ip} eq "192.168.96.210") { # effrafax
119 $color_on = color "black on_magenta";
120 } elsif ( $ip->{src_ip} eq "192.168.98.210") { # bartlett
121 $color_on = color "black on_green";
122 } elsif ( $ip->{src_ip} eq "192.168.96.253") { # greebo
123 $color_on = color "black on_yellow";
124 } elsif ( $ip->{src_ip} eq "192.168.100.223") { # deepthought
125 $color_on = color "bold red on_magenta";
126 } elsif ( $ip->{src_ip} eq "192.168.100.224") { # eddie
127 $color_on = color "bold red on_yellow";
128 } elsif ( $ip->{src_ip} eq "192.168.100.228") { # marvin
129 $color_on = color "bold red on_green";
131 my $color_off = color "reset";
132 my @record = map {defined $dbmd{$_} ? sprintf("%s%-7s %s%s\n", $color_on, $_, $color_off, $dbmd{$_}) : ()} @dbmdfields;
133 my $record = join("", @record);
134 printf
136 "%sUDP %5d %s %s:%s->%s:%s%s\n%s",
137 $color_on,
138 $cnt,
139 itms([$header->{tv_sec}, $header->{tv_usec}]),
140 $ip->{src_ip},
141 $udp->{src_port},
142 $ip->{dest_ip},
143 $udp->{dest_port},
144 $color_off,
145 $record,
149 my $mcb = sub {
150 my ($user_data, $header, $packet) = @_;
151 my $ether = NetPacket::Ethernet->decode($packet);
152 $npe->{_pp} ++;
153 # $DB::single++;
154 return $npe->_ipv4( $ether, NetPacket::IP -> decode($ether->{data}), $header, $packet);
157 $npe->loop($mcb);
161 # Local Variables:
162 # mode: cperl
163 # cperl-indent-level: 4
164 # End:
166 # Local Variables:
167 # mode: cperl
168 # cperl-indent-level: 4
169 # End: