#!/usr/bin/perl -w
###########################################
# Nettop - Top-like TCP Monitor
# Mike Schilli, 2007 (m@perlmeister.com)
###########################################
use strict;
use Curses::UI::POE;
use List::Util qw(max);

my ($STATS, $CONNS);
my $netstat = "netstat";
my $REFRESH_RATE = 1;

use PoCoRunner;

PoCoRunner->new(
    command  => $netstat,
    args     => "-s",
    data     => \my $stats_data,
    interval => 1,
);
PoCoRunner->new(
    command  => $netstat,
    args     => "-put",
    data     => \my $conns_data,
    interval => 1,
);

my $CUI = Curses::UI::POE->new(
  -color_support => 1, 
  inline_states  => {
    _start => sub {
      $poe_kernel->delay('wake_up', 
                         $REFRESH_RATE)},
    wake_up => \&wake_up_handler,
    chld    => sub { waitpid $_[ARG1], 0; },
});

my $WIN = $CUI->add(qw( win_id Window ));

my $TOP = $WIN->add(qw( top Label 
  -y 0 -width -1 -paddingspaces 1 
  -fg white -bg blue
  ), -text => top_text());

my $LBOX = $WIN->add(qw( lb Listbox
    -padtop 1 -padbottom 1 -border 1 ),
);

my $BOTTOM = $WIN->add(qw( bottom Label
  -y -1 -width -1 -paddingspaces 1 
  -fg white -bg blue
  ), -text => "TCP Watcher v1.0"
);

$CUI->set_binding(sub { exit 0; }, "q");
$poe_kernel->sig("CHLD", "chld");
$CUI->mainloop;

###########################################
sub wake_up_handler {
###########################################
        # Re-enable timer
  $poe_kernel->delay('wake_up', 
                     $REFRESH_RATE);
  data_refresh();
  $TOP->text(top_text());
  $TOP->draw();

  my $state_fmt = col_fmt([map $_->{state}, 
                           @$CONNS], 8);
  my $prog_fmt  = col_fmt([map $_->{prog}, 
                           @$CONNS], 20);
  my $rem_fmt  = col_fmt([map $_->{remote}, 
                           @$CONNS], 32);
  my $loc_fmt  = col_fmt([map $_->{local}, 
                           @$CONNS], 20);

  my @lines = map { 
         $state_fmt->($_->{state}) . " " .
         $prog_fmt->($_->{prog}) . " " .
         $rem_fmt->($_->{remote}) . " " .
         $loc_fmt->($_->{local}) . " " .
         "";
      } sort conn_sort @$CONNS;

  $LBOX->{-values} = [@lines];
  $LBOX->{-labels} = { map { $_ => $_ } 
                           @lines };
  
  $LBOX->draw(1);
}

###########################################
sub top_text {
###########################################
  my $ip  = $STATS->{Ip};
  my $tcp = $STATS->{Tcp};

  return sprintf 
    "Packets rcvd:%s sent:%s TCPopen " .
    "active:%s passive:%s",
    $ip->{'total packets received'},
    $ip->{'requests sent out'},
    $tcp->{'active connections openings'},
    $tcp->{'passive connection openings'};
}

###########################################
sub data_refresh {
###########################################
    $STATS = stats_parse($stats_data);
    $CONNS = conns_parse($conns_data);
}

###########################################
sub stats_parse {
###########################################
  my($output) = @_;

  my $section;
  my $data = {};
  my $key = qr/\w[\w\s]+/;

  for (split /\n/, $output) {
    if( /($key):$/ ) {
        $section = $1;
        next;
    } elsif( /($key): (\d+)/ ) {
        $data->{$section}->{$1} = $2;
    } elsif( /(\d+)\s+($key)/ ) {
        $data->{$section}->{$2} = $1;
    } else {
        die "Cannot parse stats line '$_'";
    }
  }

  return $data;
}

###########################################
sub conn_sort {
###########################################
 return -1 if $a->{state} eq "ESTABLISHED";
 return  1 if $b->{state} eq "ESTABLISHED";
 return  0;
}

###########################################
sub col_fmt {
###########################################
  my($cols, $max_space) = @_;

  my $max_len = max map { 
                        length $_ } @$cols;
  $max_len = $max_space if 
                     $max_len > $max_space;

  return sub {
      return sprintf("%${max_len}s", 
               substr(shift, 0, $max_len));
  };
}

###########################################
sub conns_parse {
###########################################
  my($output) = @_;

  my $data = [];

  for (split /\n/, $output) {
    my($proto, $rec, $snd, $local, $remote, 
       $state, $prog) = split ' ', $_;

    next if $proto ne "tcp";
    push @$data,
         { local  => $local,
           remote => $remote,
           state  => $state,
           prog   => $prog };
  }

  return $data;
}