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 };
  28 print $dfh "
  29 #pragma D option quiet
  30 #pragma D option switchrate=10Hz
  31
  32 profile:::tick-1sec
  33 {
  34     printf(\"T\\n\");
  35 }\n";
  36 if ($ARGV[0] eq "tcp") {
  37     sub tcpprobe {
  38         my ($probe, $dir) = @_;
  39         print $dfh "
  40 $probe
  41 {
  42     @" . $dir . "[args[2]->ip_saddr,
  43         args[4]->tcp_sport,
  44         args[2]->ip_daddr,
  45         args[4]->tcp_dport] = sum(args[2]->ip_plength);
  46     " . $dir . "pkts++;
  47 }\n";
  48     };
  49     tcpprobe "tcp:::send", "tx";
  50     tcpprobe "tcp:::receive", "rx";
  51     print $dfh '
  52 profile:::tick-1sec
  53 {
  54     printa("< [%s]:%d [%s]:%d %@d\n", @rx);
  55     clear(@rx);
  56     printa("> [%s]:%d [%s]:%d %@d\n", @tx);
  57     clear(@tx);
  58     printf("I %d\n", rxpkts);
  59     printf("O %d\n", txpkts);
  60     rxpkts = 0;
  61     txpkts = 0;
  62     printf("T\n");
  63 }';
  64 } else {
  65     sub ipprobe {
  66         my ($probe, $dir) = @_;
  67         my $conds = join " || ", map { "args[3]->if_name == \"$_\"" } @ARGV;
  68         print $dfh "
  69 $probe
  70 /$conds/
  71 {
  72     @" . $dir . "[args[2]->ip_saddr,
  73         args[2]->ip_daddr] = sum(args[2]->ip_plength);
  74     " . $dir . "pkts++;
  75 }\n";
  76     };
  77     ipprobe "ip:::send", "tx";
  78     ipprobe "ip:::receive", "rx";
  79     print $dfh '
  80 profile:::tick-1sec
  81 {
  82     printa("< %s %s %@d\n", @rx);
  83     clear(@rx);
  84     printa("> %s %s %@d\n", @tx);
  85     clear(@tx);
  86     printf("I %d\n", rxpkts);
  87     printf("O %d\n", txpkts);
  88     rxpkts = 0;
  89     txpkts = 0;
  90     printf("T\n");
  91 }';
  92 };
  93
  94 my $height = (defined $ENV{DMON_HEIGHT}) ? $ENV{DMON_HEIGHT} : 40;
  95 $height--;
  96
  97 ########################################################################
  98
  99 my @sizePrefix = ("E", "P", "T", "G", "M", "K");
 100 my @countBound = (1e18, 1e15, 1e12, 1e9, 1e6, 1e3);
 101 my @sizeBound = (1<<60, 1<<50, 1<<40, 1<<30, 1<<20, 1<<10);
 102
 103 sub human {
 104     my ($s, $suffix, $bounds) = @_;
 105     foreach my $i (0 .. $#{$bounds}) {
 106         next if $s < @{$bounds}[$i];
 107         return sprintf "%.2f %s%s", $s / @{$bounds}[$i], $sizePrefix[$i], $suffix;
 108     };
 109     return "$s $suffix";
 110 }
 111
 112 sub humanCount { return human shift, "", \@countBound }
 113
 114 sub humanSize { return human shift, "iB", \@sizeBound }
 115 #
 116 ########################################################################
 117
 118 my (%tx, %rx);
 119 my ($pktsRx, $pktsTx, $bytesRx, $bytesTx) = (0, 0, 0, 0);
 120 format STDOUT_TOP =
 121 @>>>>>>>>>> / @<<<<<<<<<<                  @>>>>>>>>>>>> / @<<<<<<<<<<<<
 122 humanCount($pktsRx), humanCount($pktsTx), humanSize($bytesRx), humanSize($bytesTx)
 123 ------------------------------------------------------------------------
 124 .
 125
 126 my ($left, $dir, $right, $size);
 127 format STDOUT =
 128 @<<<<<<<<<<<<<<<<<<<<<<<<<< @| @>>>>>>>>>>>>>>>>>>>>>>>>>> @>>>>>>>>>>>>
 129 $left, $dir, $right, humanSize($size)
 130 .
 131
 132 ########################################################################
 133
 134 my $dexec;
 135 open $dexec, "-|", "dtrace -s $dfn" or die "$!";
 136 sleep 1;
 137 unlink $dfn;
 138
 139 my $xx;
 140 while (<$dexec>) {
 141     next unless /^[<>TIO]/;
 142     my @cols = split;
 143     if ($cols[0] eq "T") {
 144         my @res;
 145         foreach my $src (keys %rx) {
 146             foreach my $dst (keys %{$rx{$src}}) {
 147                 push @res, [$dst, "<", $src, $rx{$src}{$dst}];
 148             };
 149         };
 150         foreach my $src (keys %tx) {
 151             foreach my $dst (keys %{$tx{$src}}) {
 152                 push @res, [$src, ">", $dst, $tx{$src}{$dst}];
 153             };
 154         };
 155         @res = sort { @{$b}[-1] <=> @{$a}[-1] } @res;
 156         printf "\033[H\033[J";
 157         $- = 0;
 158         foreach (@res[0..$height]) {
 159             last unless defined;
 160             ($left, $dir, $right, $size) = @{$_};
 161             write STDOUT;
 162         };
 163         (%rx, %tx) = (), ();
 164         ($pktsRx, $pktsTx, $bytesRx, $bytesTx) = (0, 0, 0, 0);
 165         next;
 166     };
 167     if ($cols[0] eq "I") {
 168         $pktsRx += $cols[1];
 169         next;
 170     };
 171     if ($cols[0] eq "O") {
 172         $pktsTx += $cols[1];
 173         next;
 174     };
 175     if ($cols[0] eq "<") {
 176         $xx = \%rx;
 177         $pktsRx++;
 178         $bytesRx += $cols[3];
 179     } else {
 180         $xx = \%tx;
 181         $pktsTx++;
 182         $bytesTx += $cols[3];
 183     };
 184     if (defined ${$xx}{$cols[1]}) {
 185         ${$xx}{$cols[1]}{$cols[2]} += $cols[3];
 186     } else {
 187         ${$xx}{$cols[1]} = {$cols[2] => $cols[3]};
 188     };
 189 };