2 # dmon -- DTrace-backed TCP/IP real-time monitoring utility
3 # Copyright (C) 2022 Sergey Matveev <stargrave@stargrave.org>
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.
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.
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/>.
20 ########################################################################
23 die "Usage: $0 [tcp|ifname0 ifname1 ...]\n";
25 use File::Temp qw/tempfile/;
26 my ($dfh, $dfn) = tempfile();
27 END { unlink $dfn if defined $dfn }
29 #pragma D option quiet
30 #pragma D option switchrate=10Hz
32 if ($ARGV[0] eq "tcp") {
34 my ($probe, $dir) = @_;
38 @" . $dir . "[args[2]->ip_saddr,
41 args[4]->tcp_dport] = sum(args[2]->ip_plength);
42 @" . $dir . "pkts = count();
43 @" . $dir . "bytes = sum(args[2]->ip_plength);
46 tcpprobe "tcp:::send", "tx";
47 tcpprobe "tcp:::receive", "rx";
51 printa("< [%s]:%d [%s]:%d %@d\n", @rx);
53 printa("> [%s]:%d [%s]:%d %@d\n", @tx);
55 printa("T %@d %@d %@d %@d\n", @rxpkts, @txpkts, @rxbytes, @txbytes);
63 my ($probe, $dir) = @_;
64 my $conds = join " || ", map { "args[3]->if_name == \"$_\"" } @ARGV;
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);
75 ipprobe "ip:::send", "tx";
76 ipprobe "ip:::receive", "rx";
80 printa("< %s %s %@d\n", @rx);
82 printa("> %s %s %@d\n", @tx);
84 printa("T %@d %@d %@d %@d\n", @rxpkts, @txpkts, @rxbytes, @txbytes);
92 my $height = (exists $ENV{DMON_HEIGHT}) ? $ENV{DMON_HEIGHT} : 40;
95 ########################################################################
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);
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;
110 sub humanCount { return human shift, "", \@countBound }
112 sub humanSize { return human shift, "B", \@sizeBound }
114 ########################################################################
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 ----------------------------------------------------------------------------------------------------
151 @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @|| @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> @|||||| @|||||| @||||||
152 $left, $dir, $right, humanSize($bytes1), humanSize($bytes5), humanSize($bytes10)
155 ########################################################################
159 if (exists $ENV{DMON_ONLY_SCRIPT}) {
160 open $dexec, "<", "$dfn" or die "$!";
161 while (<$dexec>) { print }
164 if (exists $ENV{DMON_ONLY_PARSE}) {
167 open $dexec, "-|", "dtrace -s $dfn" or die "$!";
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);
180 next unless /^[<>T]/;
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];
194 my $sum = $allRxPkts[0];
196 foreach (@allRxPkts[1 .. 4]) { $sum += $_ }
197 $allRxPkts5 = $sum / 5;
198 foreach (@allRxPkts[5 .. 9]) { $sum += $_ }
199 $allRxPkts10 = $sum / 10;
201 $sum = $allTxPkts[0];
203 foreach (@allTxPkts[1 .. 4]) { $sum += $_ }
204 $allTxPkts5 = $sum / 5;
205 foreach (@allTxPkts[5 .. 9]) { $sum += $_ }
206 $allTxPkts10 = $sum / 10;
209 foreach (@allRxBytes[1 .. 4]) { $sum += $_ }
210 $allRxBytes5 = $sum / 5;
211 foreach (@allRxBytes[5 .. 9]) { $sum += $_ }
212 $allRxBytes10 = $sum / 10;
214 $sum = $allTxBytes[0];
216 foreach (@allTxBytes[1 .. 4]) { $sum += $_ }
217 $allTxBytes5 = $sum / 5;
218 foreach (@allTxBytes[5 .. 9]) { $sum += $_ }
219 $allTxBytes10 = $sum / 10;
221 $sum = $totalBytes[0];
223 foreach (@totalBytes[1 .. 4]) { $sum += $_ }
224 $totalBytes5 = $sum / 5;
225 foreach (@totalBytes[5 .. 9]) { $sum += $_ }
226 $totalBytes10 = $sum / 10;
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})) {
237 if ($#{$vals} >= 10) {
238 $bytes{$dir}{$src}{$dst} = [@{$vals}[0 .. 9]];
240 my @r = ($dir eq "<") ? ($dst, "<=", $src) : ($src, "=>", $dst);
243 foreach (@{$vals}[1 .. 4]) { $sum += $_ }
245 foreach (@{$vals}[5 .. 9]) { $sum += $_ }
247 delete $bytes{$dir}{$src}{$dst};
255 @res = sort { @{$b}[-1] <=> @{$a}[-1] } @res;
256 printf "\033[H\033[J";
258 foreach (@res[0 .. $height]) {
260 ($left, $dir, $right, $bytes1, $bytes5, $bytes10) = @{$_};
266 %seen = ("<" => {}, ">" => {});
269 if (not exists $bytes{$cols[0]}{$cols[1]}) {
270 %{$bytes{$cols[0]}{$cols[1]}} = ();
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);
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]}} = ();
279 $seen{$cols[0]}{$cols[1]}{$cols[2]} = 1;