netmeter.pl

#!/usr/bin/perl -w
# ---------------------------------------------------------
# netmeter.pl (v 0.2): shows the network's load;
# based on Loris Degioanni's NetMeter program in C
# (see the Packet Capture Driver Developer's Pack).
# This simple example shows how to use statistics
# mode with Win32::NetPacket.
# This program is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
# (c) 2003-2006 J-L Morel jlmorel@cpan.org
# ---------------------------------------------------------

use strict;
use Tk;
use Win32::NetPacket qw/ GetAdapterNames :ndis :mode /;

my $mw = MainWindow->new;
my $go = 1;
$mw->protocol( 'WM_DELETE_WINDOW' => sub { $go = 0 } );

my $w   = 300;
my $h   = 110;
my $t   = 2;
my $nbb = $w / $t + 1;

my $can = $mw->Canvas(
  -width      => $w,
  -height     => $h + 10,
  -background => 'black',
)->pack();

$can->configure( -scrollregion => [ 0, 0, $w, $h + 20 ] );
$can->createGrid( 0, 10, $w, 30, -line => 1, -fill => 'green' );

# open adapter
my $nic = Win32::NetPacket->new(
  driver_buff_size => 0,            # no buffer needed
  read_timeout     => 1000,         # every second
  mode             => MODE_STAT,    # statistics mode
) or die $@;

$nic->SetHwFilter(NDIS_PACKET_TYPE_PROMISCUOUS); # set nic in promiscuous mode
my $Buff;
$nic->SetUserBuffer( $Buff, 36 );    # 36 bytes user's buffer, it's enough

# initialisation
my ( $old_tv_sec, $old_tv_usec ) = ( 0, 0 );
my @group  = ();
my $count  = 0;
my $BpsMax = 1_000_000;              # max grad = 1 Mbps

# 2 padding bytes (xx) in the bpf_hdr structure under WinNT
my $patern = Win32::IsWinNT() ? "llIISxxLLLL" : "llIISLLLL";

# my MainLoop !
while ($go) {
  $nic->ReceivePacket();             # get stat
  my ( $tv_sec, $tv_usec, $caplen, $datalen, $hdrlen, $p0, $p1, $b0, $b1 )
    = unpack $patern, $Buff;         # read the buffer

  # Calculate the delay in seconds from the last sample.
  my $delay = ( $tv_sec - $old_tv_sec ) + ( $tv_usec - $old_tv_usec ) * 1e-6;
  $old_tv_sec  = $tv_sec;
  $old_tv_usec = $tv_usec;

  # get the number of bits per second
  my $Bps = int( ( $b1 * 2**32 + $b0 ) * 8 / $delay );

  my $band = $Bps * 100 / $BpsMax;
  push @group,
    $can->createRectangle( $w, $h, $w - $t, $h - $band, -outline => 'yellow',
    );
  $can->delete( shift @group ) if @group >= $nbb;
  $can->move( $_, -$t, 0 ) foreach (@group);
  $count++;
  $mw->update();
}