dmon.pl

   1 #!/usr/bin/env perl
   2 # dmon -- DTrace-backed TCP/IP real-time monitoring utility
   3 # Copyright (C) 2022 Sergey Matveev <stargrave@stargrave.org>
   4 #
   5 # This program is free software: you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation, version 3 of the License.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17 use strict;
  18 use warnings;
  19
  20 ########################################################################
  21
  22 if ($#ARGV < 0) {
  23     die "Usage: $0 [tcp|ifname0 ifname1 ...]\n";
  24 }
  25 use File::Temp qw/tempfile/;
  26 my ($dfh, $dfn) = tempfile();
  27 END { unlink $dfn if defined $dfn }
  28 print $dfh "
  29 #pragma D option quiet
  30 #pragma D option switchrate=10Hz
  31 ";
  32 if ($ARGV[0] eq "tcp") {
  33     sub tcpprobe {
  34         my ($probe, $dir) = @_;
  35         print $dfh "
  36 $probe
  37 {
  38     @" . $dir . "[args[2]->ip_saddr,
  39         args[4]->tcp_sport,
  40         args[2]->ip_daddr,
  41         args[4]->tcp_dport] = sum(args[2]->ip_plength);
  42     @" . $dir . "pkts = count();
  43     @" . $dir . "bytes = sum(args[2]->ip_plength);
  44 }\n";
  45     }
  46     tcpprobe "tcp:::send", "tx";
  47     tcpprobe "tcp:::receive", "rx";
  48     print $dfh '
  49 profile:::tick-1sec
  50 {
  51     printa("< [%s]:%d [%s]:%d %@d\n", @rx);
  52     trunc(@rx);
  53     printa("> [%s]:%d [%s]:%d %@d\n", @tx);
  54     trunc(@tx);
  55     printa("T %@d %@d %@d %@d\n", @rxpkts, @txpkts, @rxbytes, @txbytes);
  56     clear(@rxpkts);
  57     clear(@txpkts);
  58     clear(@rxbytes);
  59     clear(@txbytes);
  60 }';
  61 } else {
  62     sub ipprobe {
  63         my ($probe, $dir) = @_;
  64         my $conds = join " || ", map { "args[3]->if_name == \"$_\"" } @ARGV;
  65         print $dfh "
  66 $probe
  67 /$conds/
  68 {
  69     @" . $dir . "[args[2]->ip_saddr,
  70         args[2]->ip_daddr] = sum(args[2]->ip_plength);
  71     @" . $dir . "pkts = count();
  72     @" . $dir . "bytes = sum(args[2]->ip_plength);
  73 }\n";
  74     }
  75     ipprobe "ip:::send", "tx";
  76     ipprobe "ip:::receive", "rx";
  77     print $dfh '
  78 profile:::tick-1sec
  79 {
  80     printa("< %s %s %@d\n", @rx);
  81     trunc(@rx);
  82     printa("> %s %s %@d\n", @tx);
  83     trunc(@tx);
  84     printa("T %@d %@d %@d %@d\n", @rxpkts, @txpkts, @rxbytes, @txbytes);
  85     clear(@rxpkts);
  86     clear(@txpkts);
  87     clear(@rxbytes);
  88     clear(@txbytes);
  89 }';
  90 }
  91
  92 my $height = (exists $ENV{DMON_HEIGHT}) ? $ENV{DMON_HEIGHT} : 40;
  93 $height--;
  94
  95 ########################################################################
  96
  97 my @sizePrefix = ("E", "P", "T", "G", "M", "K");
  98 my @countBound = (1e18, 1e15, 1e12, 1e9, 1e6, 1e3);
  99 my @sizeBound = (1<<60, 1<<50, 1<<40, 1<<30, 1<<20, 1<<10);
 100
 101 sub human {
 102     my ($s, $suffix, $bounds) = @_;
 103     foreach my $i (0 .. $#{$bounds}) {
 104         next if $s < @{$bounds}[$i];
 105         return sprintf "%.2f%s%s", $s / @{$bounds}[$i], $sizePrefix[$i], $suffix;
 106     }
 107     return "$s$suffix";
 108 }
 109
 110 sub humanCount { return human shift, "", \@countBound }
 111
 112 sub humanSize { return human shift, "B", \@sizeBound }
 113
 114 ########################################################################
 115
 116 my $allRxPkts1;
 117 my $allRxPkts5;
 118 my $allRxPkts10;
 119 my $allTxPkts1;
 120 my $allTxPkts5;
 121 my $allTxPkts10;
 122 my $allRxBytes1;
 123 my $allRxBytes5;
 124 my $allRxBytes10;
 125 my $allTxBytes1;
 126 my $allTxBytes5;
 127 my $allTxBytes10;
 128 my $allRxBytesPeak;
 129 my $allTxBytesPeak;
 130 my $totalBytes1;
 131 my $totalBytes5;
 132 my $totalBytes10;
 133 my $totalBytesPeak;
 134 format STDOUT_TOP =
 135 Rx: @||||||  @||||||  @||||||    @||||||  @||||||  @||||||    peak: @||||||
 136 humanCount($allRxPkts1), humanCount($allRxPkts5), humanCount($allRxPkts10), humanSize($allRxBytes1), humanSize($allRxBytes5), humanSize($allRxBytes10), humanSize($allRxBytesPeak)
 137 Tx: @||||||  @||||||  @||||||    @||||||  @||||||  @||||||    peak: @||||||
 138 humanCount($allTxPkts1), humanCount($allTxPkts5), humanCount($allTxPkts10), humanSize($allTxBytes1), humanSize($allTxBytes5), humanSize($allTxBytes10), humanSize($allTxBytesPeak)
 139 Total:                           @||||||  @||||||  @||||||    peak: @||||||
 140 humanSize($totalBytes1), humanSize($totalBytes5), humanSize($totalBytes10), humanSize($totalBytesPeak)
 141 ----------------------------------------------------------------------------------------------------
 142 .
 143
 144 my $left;
 145 my $dir;
 146 my $right;
 147 my $bytes1;
 148 my $bytes5;
 149 my $bytes10;
 150 format STDOUT =
 151 @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @|| @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  @||||||  @||||||  @||||||
 152 $left, $dir, $right, humanSize($bytes1), humanSize($bytes5), humanSize($bytes10)
 153 .
 154
 155 ########################################################################
 156
 157 close $dfh;
 158 my $dexec;
 159 if (exists $ENV{DMON_ONLY_SCRIPT}) {
 160     open $dexec, "<", "$dfn" or die "$!";
 161     while (<$dexec>) { print }
 162     exit;
 163 }
 164 if (exists $ENV{DMON_ONLY_PARSE}) {
 165     $dexec = \*STDIN;
 166 } else {
 167     open $dexec, "-|", "dtrace -s $dfn" or die "$!";
 168     sleep 1;
 169 }
 170 unlink $dfn;
 171
 172 my %bytes = ("<" => {}, ">" => {});
 173 my %seen = ("<" => {}, ">" => {});
 174 my @allRxPkts = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
 175 my @allTxPkts = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
 176 my @allRxBytes = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
 177 my @allTxBytes = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
 178 my @totalBytes = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
 179 while (<$dexec>) {
 180     next unless /^[<>T]/;
 181     my @cols = split;
 182     if ($cols[0] eq "T") {
 183         unshift @allRxPkts, $cols[1]; pop @allRxPkts;
 184         unshift @allTxPkts, $cols[2]; pop @allTxPkts;
 185         unshift @allRxBytes, $cols[3]; pop @allRxBytes;
 186         unshift @allTxBytes, $cols[4]; pop @allTxBytes;
 187         unshift @totalBytes, $cols[3] + $cols[4]; pop @totalBytes;
 188         if ($cols[3] > $allRxBytesPeak) { $allRxBytesPeak =  $cols[3] }
 189         if ($cols[4] > $allTxBytesPeak) { $allTxBytesPeak =  $cols[4] }
 190         if (($cols[3] + $cols[4]) > $totalBytesPeak) {
 191             $totalBytesPeak =  $cols[3] + $cols[4];
 192         }
 193
 194         my $sum = $allRxPkts[0];
 195         $allRxPkts1 = $sum;
 196         foreach (@allRxPkts[1 .. 4]) { $sum += $_ }
 197         $allRxPkts5 = $sum / 5;
 198         foreach (@allRxPkts[5 .. 9]) { $sum += $_ }
 199         $allRxPkts10 = $sum / 10;
 200
 201         $sum = $allTxPkts[0];
 202         $allTxPkts1 = $sum;
 203         foreach (@allTxPkts[1 .. 4]) { $sum += $_ }
 204         $allTxPkts5 = $sum / 5;
 205         foreach (@allTxPkts[5 .. 9]) { $sum += $_ }
 206         $allTxPkts10 = $sum / 10;
 207
 208         $allRxBytes1 = $sum;
 209         foreach (@allRxBytes[1 .. 4]) { $sum += $_ }
 210         $allRxBytes5 = $sum / 5;
 211         foreach (@allRxBytes[5 .. 9]) { $sum += $_ }
 212         $allRxBytes10 = $sum / 10;
 213
 214         $sum = $allTxBytes[0];
 215         $allTxBytes1 = $sum;
 216         foreach (@allTxBytes[1 .. 4]) { $sum += $_ }
 217         $allTxBytes5 = $sum / 5;
 218         foreach (@allTxBytes[5 .. 9]) { $sum += $_ }
 219         $allTxBytes10 = $sum / 10;
 220
 221         $sum = $totalBytes[0];
 222         $totalBytes1 = $sum;
 223         foreach (@totalBytes[1 .. 4]) { $sum += $_ }
 224         $totalBytes5 = $sum / 5;
 225         foreach (@totalBytes[5 .. 9]) { $sum += $_ }
 226         $totalBytes10 = $sum / 10;
 227
 228         my @res;
 229         foreach my $dir (keys %bytes) {
 230             foreach my $src (keys %{$bytes{$dir}}) {
 231                 foreach my $dst (keys %{$bytes{$dir}{$src}}) {
 232                     my $vals = $bytes{$dir}{$src}{$dst};
 233                     if ((not exists $seen{$dir}{$src}) or
 234                         (not exists $seen{$dir}{$src}{$dst})) {
 235                         unshift @{$vals}, 0;
 236                     }
 237                     if ($#{$vals} >= 10) {
 238                         $bytes{$dir}{$src}{$dst} = [@{$vals}[0 .. 9]];
 239                     }
 240                     my @r = ($dir eq "<") ? ($dst, "<=", $src) : ($src, "=>", $dst);
 241                     $sum = $vals->[0];
 242                     push @r, $sum;
 243                     foreach (@{$vals}[1 .. 4]) { $sum += $_ }
 244                     push @r, $sum;
 245                     foreach (@{$vals}[5 .. 9]) { $sum += $_ }
 246                     if ($sum == 0) {
 247                         delete $bytes{$dir}{$src}{$dst};
 248                         next;
 249                     }
 250                     push @r, $sum;
 251                     push @res, \@r;
 252                 }
 253             }
 254         }
 255         @res = sort { @{$b}[-1] <=> @{$a}[-1] } @res;
 256         printf "\033[H\033[J";
 257         $- = 0;
 258         foreach (@res[0 .. $height]) {
 259             last unless defined;
 260             ($left, $dir, $right, $bytes1, $bytes5, $bytes10) = @{$_};
 261             $bytes5 /= 5;
 262             $bytes10 /= 10;
 263             write STDOUT;
 264         }
 265
 266         %seen = ("<" => {}, ">" => {});
 267         next;
 268     }
 269     if (not exists $bytes{$cols[0]}{$cols[1]}) {
 270         %{$bytes{$cols[0]}{$cols[1]}} = ();
 271     }
 272     if (not exists $bytes{$cols[0]}{$cols[1]}{$cols[2]}) {
 273         @{$bytes{$cols[0]}{$cols[1]}{$cols[2]}} = (0, 0, 0, 0, 0, 0, 0, 0, 0);
 274     }
 275     unshift @{$bytes{$cols[0]}{$cols[1]}{$cols[2]}}, $cols[3];
 276     if (not exists $seen{$cols[0]}{$cols[1]}) {
 277         %{$seen{$cols[0]}{$cols[1]}} = ();
 278     }
 279     $seen{$cols[0]}{$cols[1]}{$cols[2]} = 1;
 280 }