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     printf(\"$dir [%s]:%d [%s]:%d %d\\n\",
  43         args[2]->ip_saddr,
  44         args[4]->tcp_sport,
  45         args[2]->ip_daddr,
  46         args[4]->tcp_dport,
  47         args[2]->ip_plength);
  48 }\n";
  49     };
  50     tcpprobe "tcp:::send", ">";
  51     tcpprobe "tcp:::receive", "<";
  52 } else {
  53     sub ipprobe {
  54         my ($probe, $dir) = @_;
  55         my $conds = join " || ", map { "args[3]->if_name == \"$_\"" } @ARGV;
  56         print $dfh "
  57 $probe
  58 /$conds/
  59 {
  60     printf(\"$dir %s %s %d %s\\n\",
  61         args[2]->ip_saddr,
  62         args[2]->ip_daddr,
  63         args[2]->ip_plength,
  64         args[3]->if_name);
  65 }\n";
  66     };
  67     ipprobe "ip:::send", ">";
  68     ipprobe "ip:::receive", "<";
  69 };
  70
  71 my $height = (defined $ENV{DMON_HEIGHT}) ? $ENV{DMON_HEIGHT} : 40;
  72 $height--;
  73
  74 ########################################################################
  75
  76 my @sizePrefix = ("E", "P", "T", "G", "M", "K");
  77 my @countBound = (1e18, 1e15, 1e12, 1e9, 1e6, 1e3);
  78 my @sizeBound = (1<<60, 1<<50, 1<<40, 1<<30, 1<<20, 1<<10);
  79
  80 sub human {
  81     my ($s, $suffix, $bounds) = @_;
  82     foreach my $i (0 .. $#{$bounds}) {
  83         next if $s < @{$bounds}[$i];
  84         return sprintf "%.2f %s%s", $s / @{$bounds}[$i], $sizePrefix[$i], $suffix;
  85     };
  86     return "$s $suffix";
  87 }
  88
  89 sub humanCount { return human shift, "", \@countBound }
  90
  91 sub humanSize { return human shift, "iB", \@sizeBound }
  92 #
  93 ########################################################################
  94
  95 my (%tx, %rx);
  96 my ($pktsRx, $pktsTx, $bytesRx, $bytesTx) = (0, 0, 0, 0);
  97 format STDOUT_TOP =
  98 @>>>>>>>>>> / @<<<<<<<<<<                  @>>>>>>>>>>>> / @<<<<<<<<<<<<
  99 humanCount($pktsRx), humanCount($pktsTx), humanSize($bytesRx), humanSize($bytesTx)
 100 ------------------------------------------------------------------------
 101 .
 102
 103 my ($left, $dir, $right, $size);
 104 format STDOUT =
 105 @<<<<<<<<<<<<<<<<<<<<<<<<<< @| @>>>>>>>>>>>>>>>>>>>>>>>>>> @>>>>>>>>>>>>
 106 $left, $dir, $right, humanSize($size)
 107 .
 108
 109 ########################################################################
 110
 111 my $dexec;
 112 open $dexec, "-|", "dtrace -s $dfn" or die "$!";
 113 sleep 1;
 114 unlink $dfn;
 115
 116 my $xx;
 117 while (<$dexec>) {
 118     next unless /^[<>T]/;
 119     my @cols = split;
 120     if ($cols[0] eq "T") {
 121         my @res;
 122         foreach my $src (keys %rx) {
 123             foreach my $dst (keys %{$rx{$src}}) {
 124                 push @res, [$dst, "<", $src, $rx{$src}{$dst}];
 125             };
 126         };
 127         foreach my $src (keys %tx) {
 128             foreach my $dst (keys %{$tx{$src}}) {
 129                 push @res, [$src, ">", $dst, $tx{$src}{$dst}];
 130             };
 131         };
 132         @res = sort { @{$b}[-1] <=> @{$a}[-1] } @res;
 133         printf "\033[H\033[J";
 134         $- = 0;
 135         foreach (@res[0..$height]) {
 136             last unless defined;
 137             ($left, $dir, $right, $size) = @{$_};
 138             write STDOUT;
 139         };
 140         (%rx, %tx) = (), ();
 141         next;
 142     };
 143     if ($cols[0] eq "<") {
 144         $xx = \%rx;
 145         $pktsRx++;
 146         $bytesRx += $cols[3];
 147     } else {
 148         $xx = \%tx;
 149         $pktsTx++;
 150         $bytesTx += $cols[3];
 151     };
 152     if (defined ${$xx}{$cols[1]}) {
 153         ${$xx}{$cols[1]}{$cols[2]} += $cols[3];
 154     } else {
 155         ${$xx}{$cols[1]} = {$cols[2] => $cols[3]};
 156     };
 157 };