opt/ppetop.pl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright 2011 Daniel Borkmann <dborkma@tik.ee.ethz.ch>,
   4 # Swiss federal institute of technology (ETH Zurich)
   5 # Subject to the GPL.
   6 #
   7 # apt-get install libcurses-ui-perl
   8
   9 use warnings;
  10 use strict;
  11 use Curses::UI;
  12
  13 my @files;
  14 my %stats;
  15 my ($cui, $win, $widget);
  16 my $text;
  17
  18 pre();
  19 main();
  20 exit;
  21
  22 sub pre
  23 {
  24         $text = "";
  25         opendir(LD, "/proc/net/lana/") or die $!;
  26         @files = grep(/ppe\d/, readdir(LD));
  27         closedir(LD);
  28         if ($#files + 1 - $[ == 0) {
  29                 die "LANA not running?!";
  30         }
  31 }
  32
  33 sub fetch_stats
  34 {
  35         foreach my $file (@files) {
  36                 my %curr;
  37                 for (keys %curr) {
  38                         delete $curr{$_};
  39                 }
  40                 open(LH, "<", "/proc/net/lana/$file") or die $!;
  41                 while (<LH>) {
  42                         if (/(packets|bytes|errors|drops):\s+(\d+)/) {
  43                                 $curr{$1} += $2;
  44                         }
  45                 }
  46                 close(LH);
  47                 for (keys %curr) {
  48                         my $tmp = ${${$stats{$file}}{$_}}{new};
  49                         ${${$stats{$file}}{$_}}{old} = $tmp;
  50                         ${${$stats{$file}}{$_}}{new} = $curr{$_};
  51                 }
  52         }
  53 }
  54
  55 sub print_stats
  56 {
  57         my $pps_total = 0;
  58         my $mbs_total = 0;
  59         $text = "LANA ppe top:\n\n";
  60         foreach my $file (@files) {
  61                 my $pps = ${${$stats{$file}}{packets}}{new} -
  62                           ${${$stats{$file}}{packets}}{old};
  63                 my $mbs = int((${${$stats{$file}}{bytes}}{new} -
  64                                ${${$stats{$file}}{bytes}}{old}) /
  65                               (1 << 20));
  66                 my $eps = ${${$stats{$file}}{errors}}{new} -
  67                           ${${$stats{$file}}{errors}}{old};
  68                 my $dps = ${${$stats{$file}}{drops}}{new} -
  69                           ${${$stats{$file}}{drops}}{old};
  70                 $text .= "$file:\n";
  71                 $text .= "\t$pps\tpkts/s\n";
  72                 $text .= "\t$mbs\tMiB/s\n";
  73                 $text .= "\t$dps\tdrops/s\n";
  74                 $text .= "\t$eps\terr/s\n\n";
  75                 $pps_total += $pps;
  76                 $mbs_total += $mbs;
  77         }
  78         $text .= "total:\n";
  79         $text .= "\t$pps_total\tpkts/s\n";
  80         $text .= "\t$mbs_total\tMiB/s\n";
  81         $widget->text($text);
  82 }
  83
  84 sub exit_bind
  85 {
  86         exit;
  87 }
  88
  89 sub main_stats
  90 {
  91         fetch_stats();
  92         print_stats();
  93 }
  94
  95 sub main
  96 {
  97         fetch_stats();
  98         $text = "Collecting statistics, please wait ...\n";
  99         $cui = new Curses::UI(-color_support => 1);
 100         $cui->set_binding(\&exit_bind, "\cQ", "\cC");
 101         $win = $cui->add('screen', 'Window',
 102                          -border => 0,
 103                          -ipad => 0,);
 104         $widget = $win->add('ppetop', 'TextViewer',
 105                             -border => 1,
 106                             -wrapping => 0,
 107                             -text => $text,);
 108         $widget->clear_binding('loose_focus');
 109         $widget->focus;
 110         $cui->set_timer('ppetop_stats', \&main_stats, 1);
 111         $cui->enable_timer('ppetop_stats');
 112         $cui->mainloop;
 113 }