uutraffic report (in perl)

Johan Vromans jv at mhres.mh.nl
Tue Nov 21 09:15:13 AEST 1989


This is where perl is designed for ...

Produces a nice report from the UUCP statistics info. Based on an idea
by Greg Hackney (hack at texbell.swbt.com) and others.

Sample report:

      UUCP traffic on node mhres from 11/19-4:25:50 to 11/20-22:28:10

Remote   -----------K-Bytes----------- ----Hours---- --Avg CPS-- --Files--
 Host         Recv      Sent     Total   Recv   Sent  Recv  Sent Recv Sent
-------- --------- --------- --------- ------ ------ ----- ----- ---- ----
hp4nl       4386.1    2363.7    6749.8    2.1    0.8   570   869  344  140
asacsg         0.0    1375.8    1375.8    0.0    3.5     0   109    0   88
bsp2           0.0       4.4       4.4    0.0    0.0     0   576    0    2
-------- --------- --------- --------- ------ ------ ----- ----- ---- ----
Total       4386.1    3743.9    8129.9    2.1    4.3   570   244  344  230

Have fun!

Johan
--
Johan Vromans				       jv at mh.nl via internet backbones
Multihouse Automatisering bv		       uucp: ..!{uunet,hp4nl}!mh.nl!jv
Doesburgweg 7, 2803 PL Gouda, The Netherlands  phone/fax: +31 1820 62944/62500
------------------------ "Arms are made for hugging" -------------------------

#!/bin/sh
# This is a shell archive.  Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by Johan Vromans <jv at mhres> on Mon Nov 20 23:08:43 1989
#
# This archive contains:
#	uutraf.pl	
#

LANG=""; export LANG

echo x - uutraf.pl
cat >uutraf.pl <<'@EOF'
#!/usr/bin/perl
eval "exec /usr/bin/perl -S $0 $*"
  if $running_under_some_shell;
do verify_perl_version (3001);

# @(#)@ uutraf	1.1 - uutraf.pl
#
# UUCP [HDB-version] Traffic Analyzer
#
# Reads /usr/lib/uucp/.Admin/xferstats, and generates a report from it.
#
# Created by Johan Vromans <jv at mh.nl>
# Loosely based on an idea by Greg Hackney (hack at texbell.swbt.com)

# Usage: uutraf [xferstats]

@ARGV = ("/usr/spool/uucp/.Admin/xferstats") unless $#ARGV >= 0;

%hosts = ();		# hosts seen
%bytes_in = ();		# of bytes received from host
%bytes_out = ();	# of bytes sent to host
%secs_in = ();		# of seconds connect for recving
%secs_out = ();		# of seconds connect for sending
%files_in = ();		# of input requests
%files_out = ();	# of output requests

# read info, break the lines and tally

while ( $line = <> ) {
  if ( $line =~ /^([^!]+)![^(]+\(([-0-9:\/]+)\).+([<>])-* (\d+) \/ (\d+)\.(\d+) secs/ ) {
#   print "host $1, date $2, dir $3, bytes $4, secs $5.$6\n";

    # gather timestamps
    $last_date = $2;
    $first_date = $last_date unless defined $first_date;

    # initialize new hosts
    unless ( defined $hosts{$1} ) {
      $hosts{$1} = $files_in{$1} = $files_out{$1} = 
	$bytes_in{$1} = $bytes_out{$1} =
	  $secs_in{$1} = $secs_out{$1} = 0;
    }

    # tally
    if ( $3 eq "<" ) {		# recv
      $bytes_in{$1} += $4;
      $files_in{$1}++;
      $secs_in{$1} += $5 + $6/1000;
    }
    else {			# xmit
      $bytes_out{$1} += $4;
      $files_out{$1}++;
      $secs_out{$1} += $5 + $6/1000;
    }
  }
}

@hosts = keys (%hosts);
die "No info found, stopped" if $#hosts < 0;

################ report section ################

$thishost = do gethostname();
$thishost = (defined $thishost) ? "on node $thishost" : "report";

format std_head =
@|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
"UUCP traffic $thishost from $first_date to $last_date"

Remote   -----------K-Bytes----------- ----Hours---- --Avg CPS-- --Files--
 Host         Recv      Sent     Total   Recv   Sent  Recv  Sent Recv Sent
.
format std_out =
@<<<<<<< @>>>>>>>> @>>>>>>>> @>>>>>>>> @>>>>> @>>>>> @>>>> @>>>> @>>> @>>>
$Zhost,   $Zi_bytes, $Zo_bytes, $Zt_bytes, $Zi_hrs, $Zo_hrs, $Zi_acps, $Zo_acps, $Zi_count, $Zo_count
.

$^ = "std_head";
$~ = "std_out";

do print_dashes ();

reset "T";	       # reset totals

foreach $host (@hosts) {
  do print_line ($host, $bytes_in{$host}, $bytes_out{$host},
		 $secs_in{$host},  $secs_out{$host},
		 $files_in{$host}, $files_out{$host});

}

do print_dashes ();
do print_line ("Total", $Ti_bytes, $To_bytes,
	       $Ti_secs, $To_secs, $Ti_count, $To_count);

################ that's it ################

sub print_line {
  reset "Z";		# reset print fields
  local ($Zhost, 
	 $Zi_bytes, $Zo_bytes, 
	 $Zi_secs, $Zo_secs, 
	 $Zi_count, $Zo_count) = @_;
  $Ti_bytes += $Zi_bytes;
  $To_bytes += $Zo_bytes;
  $Zt_bytes = $Zi_bytes + $Zo_bytes;
  $Tt_bytes += $Zt_bytes;
  $Zi_acps = ($Zi_secs > 0) ? sprintf ("%.0f", $Zi_bytes/$Zi_secs) : "0";
  $Zo_acps = ($Zo_secs > 0) ? sprintf ("%.0f", $Zo_bytes/$Zo_secs) : "0";
  $Zi_bytes = sprintf ("%.1f", $Zi_bytes/1000);
  $Zo_bytes = sprintf ("%.1f", $Zo_bytes/1000);
  $Zt_bytes = sprintf ("%.1f", $Zt_bytes/1000);
  $Zi_hrs = sprintf ("%.1f", $Zi_secs/3600);
  $Zo_hrs = sprintf ("%.1f", $Zo_secs/3600);
  $Ti_secs += $Zi_secs;
  $To_secs += $Zo_secs;
  $Ti_count += $Zi_count;
  $To_count += $Zo_count;
  write;
}

sub print_dashes {
  $Zhost = $Zi_bytes = $Zo_bytes = $Zt_bytes =
    $Zi_hrs = $Zo_hrs = $Zi_acps = $Zo_acps = $Zi_count = $Zo_count = 
      "------------";
  write;
  # easy, isn't it?
}

################ missing ################

sub gethostname {
  $ENV{"SHELL"} = "/bin/sh";
  $try = `hostname 2>/dev/null`;
  chop $try;
  return $+ if $try =~ /^[-.\w]+$/;
  $try = `uname -n 2>/dev/null`;
  chop $try;
  return $+ if $try =~ /^[-.\w]+$/;
  $try = `uuname -l 2>/dev/null`;
  chop $try;
  return $+ if $try =~ /^[-.\w]+$/;
  return undef;
}

################ verify perl version ################

# do verify_perl_version ( [ required , [ message ] ] )

sub verify_perl_version {
  local ($version,$patchlevel) = $] =~ /(\d+.\d+).*\nPatch level: (\d+)/;
  $version = $version * 1000 + $patchlevel;

  # did the caller pass a required version?
  if ( $#_ >= 0 ) {
    local ($req, $msg, @req);
    @req = split (//, $req = shift);
    # if the request is valid - check it
    if ( $#req == 3 && $req > $version ) {
      if ( $#_ >= 0 ) {	# user supplied message
	$msg = shift;
      }
      else {
        $msg = "Sorry, this program requires perl " . $req[0] . "." . $req[1] .
	        " patch level " . $req % 100 ." or later.\nStopped";
      }
      die $msg;
    }
  }
  return $version;
}
@EOF

chmod 444 uutraf.pl

exit 0
-- 
Johan Vromans				       jv at mh.nl via internet backbones
Multihouse Automatisering bv		       uucp: ..!{uunet,hp4nl}!mh.nl!jv
Doesburgweg 7, 2803 PL Gouda, The Netherlands  phone/fax: +31 1820 62944/62500
------------------------ "Arms are made for hugging" -------------------------



More information about the Alt.sources mailing list