From 2d4898b0f954b4b933be9617554c3495fb2b65a0 Mon Sep 17 00:00:00 2001 From: Sergey Matveev Date: Thu, 8 Sep 2022 17:13:15 +0300 Subject: [PATCH] Async hostnames resolution, documentation, argparsing --- dmon.pl | 377 ++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 242 insertions(+), 135 deletions(-) diff --git a/dmon.pl b/dmon.pl index 5ef1845..36981c5 100755 --- a/dmon.pl +++ b/dmon.pl @@ -1,5 +1,5 @@ #!/usr/bin/env perl -# dmon -- DTrace-backed TCP/IP real-time monitoring utility +# dmon -- DTrace-backed IP network real-time monitoring utility # Copyright (C) 2022 Sergey Matveev # # This program is free software: you can redistribute it and/or modify @@ -13,85 +13,168 @@ # # You should have received a copy of the GNU General Public License # along with this program. If not, see . +=pod + +=head1 DESCRIPTION + +dmon is DTrace-backed IP network real-time monitoring utility. It can be +treated as a replacement for iftop utility, that does not always work +properly with IPv6. + +It generates DTrace script to gather data about send and received IP +packets, or about TCP, UDP, UDP-Lite, SCTP ones. It collects and +aggregates necessary data and sends it back to that Perl program, that +prettifies its output. + +=head1 USAGE + +There are two modes of operation: + +=over + +=item IP packets monitoring + +You have to specify exact network interface names you wish to take into +account. Pay attention that all packets are captured, even forwarded +ones, that is useful on router. + +=item TCP/UDP/UDP-Lite/SCTP packets monitoring + +With C<-p> option you have to specify the transport protocol you want to +monitor. Only explicit send and receive calls are gathered, so no +forwarded packets won't be counted. + +=back + +=head2 Hostnames resolving + +By default this program tries to asynchronously resolve all hostname for +IP addresses in background. You can turn this off with C<-H> option. +C<-P> option also disables service name lookup for the port numbers. + +=head1 DISPLAY + +Each line shows source and destination addresses with the traffic +direction. If transport mode monitoring is active, then each address +also contains the transport-level port. Unless explicitly disabled by +command lines options, ports and IP addresses are tried to be resolved +to human readable names. + +Number of transferred bytes is shown nearby. There are three numbers: +bytes passed for the last second, for last 5 seconds and for the 10 +seconds. All calculations are done in powers of two, so C actually +means C, but it is shortened to save the terminal space. +Only the payload is considered, so transport/IP headers overhead is +not counted. All entries are ordered by 10sec speed value. + +Top section contains number of send/received packets (also as a tuple of +1s/5s/10s) and total amount of send/received traffic with corresponding +peak values. + +=head1 AUTHOR + +Sergey Matveev L + +=cut use strict; use warnings; +my $VERSION = "0.1.0"; + ######################################################################## -if ($#ARGV < 0) { - die "Usage: $0 [tcp|ifname0 ifname1 ...]\n"; +use Getopt::Std; +$Getopt::Std::STANDARD_HELP_VERSION = 1; + +sub VERSION_MESSAGE { print "dmon $VERSION\n" } + +my $HeightDefault = 40; +my %Opts = (h => $HeightDefault); + +sub HELP_MESSAGE { + print "Usage: $0 [{-d|-D}] [-h HEIGHT] [-H] [-P] + {-p [tcp|udp|udplite|sctp] | ifname0 ifname1 ...} +-d -- output only generated DTrace script +-D -- take input from stdin, not summoned DTrace +-h -- set output height, by default it is $HeightDefault +-H -- do not lookup host names +-P -- do not lookup service names +-p -- do not collect IP packets, but specified protocol ones +"; } + +getopts "dDh:HPp:", \%Opts; +if ((not exists $Opts{p}) and ($#ARGV < 0)) { die HELP_MESSAGE } +$Opts{h}--; + +######################################################################### + use File::Temp qw/tempfile/; my ($dfh, $dfn) = tempfile(); END { unlink $dfn if defined $dfn } +my $Proto = (defined $Opts{p}) ? $Opts{p} : "ip"; print $dfh " #pragma D option quiet #pragma D option switchrate=10Hz "; -if ($ARGV[0] eq "tcp") { - sub tcpprobe { +my $tick1secT = ' + printa("T %@d %@d %@d %@d\n", @rxpkts, @txpkts, @rxbytes, @txbytes); + clear(@rxpkts); + clear(@txpkts); + clear(@rxbytes); + clear(@txbytes); +'; +if ($Proto eq "ip") { + my $conds = join " || ", map { "args[3]->if_name == \"$_\"" } @ARGV; + sub ipprobe { my ($probe, $dir) = @_; print $dfh " $probe +/$conds/ { - @" . $dir . "[args[2]->ip_saddr, - args[4]->tcp_sport, - args[2]->ip_daddr, - args[4]->tcp_dport] = sum(args[2]->ip_plength); - @" . $dir . "pkts = count(); - @" . $dir . "bytes = sum(args[2]->ip_plength); + @" . $dir . "[args[2]->ip_saddr, args[2]->ip_daddr] = sum(args[2]->ip_plength); + \@${dir}pkts = count(); + \@${dir}bytes = sum(args[2]->ip_plength); }\n"; } - tcpprobe "tcp:::send", "tx"; - tcpprobe "tcp:::receive", "rx"; - print $dfh ' + ipprobe "ip:::send", "tx"; + ipprobe "ip:::receive", "rx"; + print $dfh " profile:::tick-1sec { - printa("< [%s]:%d [%s]:%d %@d\n", @rx); - trunc(@rx); - printa("> [%s]:%d [%s]:%d %@d\n", @tx); - trunc(@tx); - printa("T %@d %@d %@d %@d\n", @rxpkts, @txpkts, @rxbytes, @txbytes); - clear(@rxpkts); - clear(@txpkts); - clear(@rxbytes); - clear(@txbytes); -}'; + printa(\"< %s %s %\@d\\n\", \@rx); + trunc(\@rx); + printa(\"> %s %s %\@d\\n\", \@tx); + trunc(\@tx); + $tick1secT +}\n"; } else { - sub ipprobe { + sub nonipprobe { my ($probe, $dir) = @_; - my $conds = join " || ", map { "args[3]->if_name == \"$_\"" } @ARGV; print $dfh " $probe -/$conds/ { @" . $dir . "[args[2]->ip_saddr, - args[2]->ip_daddr] = sum(args[2]->ip_plength); - @" . $dir . "pkts = count(); - @" . $dir . "bytes = sum(args[2]->ip_plength); + args[4]->${Proto}_sport, + args[2]->ip_daddr, + args[4]->${Proto}_dport] = sum(args[2]->ip_plength); + \@${dir}pkts = count(); + \@${dir}bytes = sum(args[2]->ip_plength); }\n"; } - ipprobe "ip:::send", "tx"; - ipprobe "ip:::receive", "rx"; - print $dfh ' + nonipprobe "${Proto}:::send", "tx"; + nonipprobe "${Proto}:::receive", "rx"; + print $dfh " profile:::tick-1sec { - printa("< %s %s %@d\n", @rx); - trunc(@rx); - printa("> %s %s %@d\n", @tx); - trunc(@tx); - printa("T %@d %@d %@d %@d\n", @rxpkts, @txpkts, @rxbytes, @txbytes); - clear(@rxpkts); - clear(@txpkts); - clear(@rxbytes); - clear(@txbytes); -}'; + printa(\"< [%s]:%d [%s]:%d %\@d\\n\", \@rx); + trunc(\@rx); + printa(\"> [%s]:%d [%s]:%d %\@d\\n\", \@tx); + trunc(\@tx); +$tick1secT\n}\n"; } -my $height = (exists $ENV{DMON_HEIGHT}) ? $ENV{DMON_HEIGHT} : 40; -$height--; - ######################################################################## my @sizePrefix = ("E", "P", "T", "G", "M", "K"); @@ -108,60 +191,124 @@ sub human { } sub humanCount { return human shift, "", \@countBound } - sub humanSize { return human shift, "B", \@sizeBound } ######################################################################## -my $allRxPkts1; -my $allRxPkts5; -my $allRxPkts10; -my $allTxPkts1; -my $allTxPkts5; -my $allTxPkts10; -my $allRxBytes1; -my $allRxBytes5; -my $allRxBytes10; -my $allTxBytes1; -my $allTxBytes5; -my $allTxBytes10; -my $allRxBytesPeak; -my $allTxBytesPeak; -my $totalBytes1; -my $totalBytes5; -my $totalBytes10; -my $totalBytesPeak; +use Socket qw(AF_INET AF_INET6 inet_pton); + +sub gethost { + my $host = shift; + my $family = (index($host, ":") == -1) ? AF_INET : AF_INET6; + my $packed = inet_pton $family, $host; + my @addr = gethostbyaddr $packed, $family; + return (@addr > 0) ? $addr[0] : "[$host]"; +} + +use threads; +use threads::shared; +my %HostCache :shared; +my $ResolverQueue; + +unless (defined $Opts{H}) { + use Thread::Queue; + $ResolverQueue = Thread::Queue->new(); + $ResolverQueue->limit = 0; + threads->create(sub { + while (my $host = $ResolverQueue->dequeue()) { + my $name = gethost $host; + lock %HostCache; + $HostCache{$host} = $name; + } + })->detach(); +} + +######################################################################## + +my %ServCache; + +sub humanHost { + my $pair = shift; + my ($host, $port); + if ($Proto eq "ip") { + $host = $pair; + } else { + my $i = rindex($pair, ":"); + $host = substr $pair, 1, $i-2; + $port = substr $pair, $i+1; + } + + my $name; + if ($Opts{H}) { + $name = "[$host]"; + } else { + { + lock %HostCache; + $name = $HostCache{$host}; + } + unless (defined $name) { + $ResolverQueue->enqueue($host); + $name = $host; + } + } + if ($Proto eq "ip") { return $name }; + + my $serv; + if ($Opts{P}) { + $serv = $port; + } else { + $serv = $ServCache{$port}; + unless (defined $serv) { + $serv = getservbyport $port, $Proto; + unless (defined $serv) { $serv = $port } + $ServCache{$port} = $serv; + } + } + return "$name:$serv"; +} + +######################################################################## + +sub agg1510 { + my $sum = $_[0]; + my @r = ($sum); + foreach (@_[1 .. 4]) { $sum += $_ } + push @r, int($sum / 5); + foreach (@_[5 .. 9]) { $sum += $_ } + push @r, int($sum / 10); + return @r; +} + +my (@allRxPktsAgg, @allTxPktsAgg); +my (@allRxBytesAgg, @allTxBytesAgg); +my @totalBytesAgg; +my ($allRxBytesPeak, $allTxBytesPeak, $totalBytesPeak) = (0, 0, 0); format STDOUT_TOP = Rx: @|||||| @|||||| @|||||| @|||||| @|||||| @|||||| peak: @|||||| -humanCount($allRxPkts1), humanCount($allRxPkts5), humanCount($allRxPkts10), humanSize($allRxBytes1), humanSize($allRxBytes5), humanSize($allRxBytes10), humanSize($allRxBytesPeak) +humanCount($allRxPktsAgg[0]), humanCount($allRxPktsAgg[1]), humanCount($allRxPktsAgg[2]), humanSize($allRxBytesAgg[0]), humanSize($allRxBytesAgg[1]), humanSize($allRxBytesAgg[2]), humanSize($allRxBytesPeak) Tx: @|||||| @|||||| @|||||| @|||||| @|||||| @|||||| peak: @|||||| -humanCount($allTxPkts1), humanCount($allTxPkts5), humanCount($allTxPkts10), humanSize($allTxBytes1), humanSize($allTxBytes5), humanSize($allTxBytes10), humanSize($allTxBytesPeak) +humanCount($allTxPktsAgg[0]), humanCount($allTxPktsAgg[1]), humanCount($allTxPktsAgg[2]), humanSize($allTxBytesAgg[0]), humanSize($allTxBytesAgg[1]), humanSize($allTxBytesAgg[2]), humanSize($allTxBytesPeak) Total: @|||||| @|||||| @|||||| peak: @|||||| -humanSize($totalBytes1), humanSize($totalBytes5), humanSize($totalBytes10), humanSize($totalBytesPeak) ----------------------------------------------------------------------------------------------------- +humanSize($allRxBytesAgg[0] + $allTxBytesAgg[0]), humanSize($allRxBytesAgg[1] + $allTxBytesAgg[1]), humanSize($allRxBytesAgg[2] + $allTxBytesAgg[2]), humanSize($totalBytesPeak) +------------------------------------------------------------------------------------------------------------------------ . -my $left; -my $dir; -my $right; -my $bytes1; -my $bytes5; -my $bytes10; -format STDOUT = -@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @|| @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> @|||||| @|||||| @|||||| -$left, $dir, $right, humanSize($bytes1), humanSize($bytes5), humanSize($bytes10) +my ($left, $dir, $right, $agg); +format = +@>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>... @| @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<... @|||||| @|||||| @|||||| +humanHost($left), $dir, humanHost($right), humanSize($agg->[0]), humanSize($agg->[1]), humanSize($agg->[2]) . ######################################################################## close $dfh; my $dexec; -if (exists $ENV{DMON_ONLY_SCRIPT}) { +if ($Opts{d}) { open $dexec, "<", "$dfn" or die "$!"; while (<$dexec>) { print } exit; } -if (exists $ENV{DMON_ONLY_PARSE}) { +if ($Opts{D}) { $dexec = \*STDIN; } else { open $dexec, "-|", "dtrace -s $dfn" or die "$!"; @@ -175,7 +322,6 @@ my @allRxPkts = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0); my @allTxPkts = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0); my @allRxBytes = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0); my @allTxBytes = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0); -my @totalBytes = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0); while (<$dexec>) { next unless /^[<>T]/; my @cols = split; @@ -184,46 +330,15 @@ while (<$dexec>) { unshift @allTxPkts, $cols[2]; pop @allTxPkts; unshift @allRxBytes, $cols[3]; pop @allRxBytes; unshift @allTxBytes, $cols[4]; pop @allTxBytes; - unshift @totalBytes, $cols[3] + $cols[4]; pop @totalBytes; if ($cols[3] > $allRxBytesPeak) { $allRxBytesPeak = $cols[3] } if ($cols[4] > $allTxBytesPeak) { $allTxBytesPeak = $cols[4] } if (($cols[3] + $cols[4]) > $totalBytesPeak) { - $totalBytesPeak = $cols[3] + $cols[4]; + $totalBytesPeak = $cols[3] + $cols[4]; } - - my $sum = $allRxPkts[0]; - $allRxPkts1 = $sum; - foreach (@allRxPkts[1 .. 4]) { $sum += $_ } - $allRxPkts5 = $sum / 5; - foreach (@allRxPkts[5 .. 9]) { $sum += $_ } - $allRxPkts10 = $sum / 10; - - $sum = $allTxPkts[0]; - $allTxPkts1 = $sum; - foreach (@allTxPkts[1 .. 4]) { $sum += $_ } - $allTxPkts5 = $sum / 5; - foreach (@allTxPkts[5 .. 9]) { $sum += $_ } - $allTxPkts10 = $sum / 10; - - $allRxBytes1 = $sum; - foreach (@allRxBytes[1 .. 4]) { $sum += $_ } - $allRxBytes5 = $sum / 5; - foreach (@allRxBytes[5 .. 9]) { $sum += $_ } - $allRxBytes10 = $sum / 10; - - $sum = $allTxBytes[0]; - $allTxBytes1 = $sum; - foreach (@allTxBytes[1 .. 4]) { $sum += $_ } - $allTxBytes5 = $sum / 5; - foreach (@allTxBytes[5 .. 9]) { $sum += $_ } - $allTxBytes10 = $sum / 10; - - $sum = $totalBytes[0]; - $totalBytes1 = $sum; - foreach (@totalBytes[1 .. 4]) { $sum += $_ } - $totalBytes5 = $sum / 5; - foreach (@totalBytes[5 .. 9]) { $sum += $_ } - $totalBytes10 = $sum / 10; + @allRxPktsAgg = agg1510 @allRxPkts; + @allTxPktsAgg = agg1510 @allTxPkts; + @allRxBytesAgg = agg1510 @allRxBytes; + @allTxBytesAgg = agg1510 @allTxBytes; my @res; foreach my $dir (keys %bytes) { @@ -234,46 +349,38 @@ while (<$dexec>) { (not exists $seen{$dir}{$src}{$dst})) { unshift @{$vals}, 0; } - if ($#{$vals} >= 10) { + if (@{$vals} > 10) { $bytes{$dir}{$src}{$dst} = [@{$vals}[0 .. 9]]; } my @r = ($dir eq "<") ? ($dst, "<=", $src) : ($src, "=>", $dst); - $sum = $vals->[0]; - push @r, $sum; - foreach (@{$vals}[1 .. 4]) { $sum += $_ } - push @r, $sum; - foreach (@{$vals}[5 .. 9]) { $sum += $_ } - if ($sum == 0) { + push @r, [agg1510 @{$vals}]; + if ($r[-1][-1] == 0) { delete $bytes{$dir}{$src}{$dst}; next; } - push @r, $sum; push @res, \@r; } } } - @res = sort { @{$b}[-1] <=> @{$a}[-1] } @res; + @res = sort { $b->[-1][2] <=> $a->[-1][2] } @res; printf "\033[H\033[J"; $- = 0; - foreach (@res[0 .. $height]) { + foreach (@res[0 .. $Opts{h}]) { last unless defined; - ($left, $dir, $right, $bytes1, $bytes5, $bytes10) = @{$_}; - $bytes5 /= 5; - $bytes10 /= 10; - write STDOUT; + ($left, $dir, $right, $agg) = @{$_}; + write; } - %seen = ("<" => {}, ">" => {}); next; } - if (not exists $bytes{$cols[0]}{$cols[1]}) { + unless (exists $bytes{$cols[0]}{$cols[1]}) { %{$bytes{$cols[0]}{$cols[1]}} = (); } - if (not exists $bytes{$cols[0]}{$cols[1]}{$cols[2]}) { + unless (exists $bytes{$cols[0]}{$cols[1]}{$cols[2]}) { @{$bytes{$cols[0]}{$cols[1]}{$cols[2]}} = (0, 0, 0, 0, 0, 0, 0, 0, 0); } unshift @{$bytes{$cols[0]}{$cols[1]}{$cols[2]}}, $cols[3]; - if (not exists $seen{$cols[0]}{$cols[1]}) { + unless (exists $seen{$cols[0]}{$cols[1]}) { %{$seen{$cols[0]}{$cols[1]}} = (); } $seen{$cols[0]}{$cols[1]}{$cols[2]} = 1; -- 2.44.0