jv@mh.nl (Johan Vromans) (04/18/91)
In article <1991Apr17.120911.23528@ux1.cso.uiuc.edu> ejk@ux2.cso.uiuc.edu (Ed Kubaitis - CSO ) writes: > The '.' terminating a Perl format, newer versions of shar that "optimize" > away "unnecessary" prefix characters, and something in ucbmail or SMTP > conspire to truncate your mail. Reposting time ... ---- Cut Here and feed the following to sh ---- #!/bin/sh # This is a shell archive (produced by shar 3.49) # To extract the files from this archive, save it to a file, remove # everything above the "!/bin/sh" line above, and type "sh file_name". # # made 04/18/1991 10:18 UTC by jv@largo # Source directory /u1/users/jv # # existing files will NOT be overwritten unless -c is specified # # This shar contains: # length mode name # ------ ---------- ------------------------------------------ # 5454 -r--r--r-- uutraf.pl # # ============= uutraf.pl ============== if test -f 'uutraf.pl' -a X"$1" != X"-c"; then echo 'x - skipping uutraf.pl (File already exists)' else echo 'x - extracting uutraf.pl (Text)' sed 's/^X//' << 'SHAR_EOF' > 'uutraf.pl' && X#!/usr/bin/perl Xeval "exec /usr/bin/perl -S $0 $*" X if $running_under_some_shell; Xdo verify_perl_version (3001); X X# @(#)@ uutraf 1.4 - uutraf.pl X# X# UUCP Traffic Analyzer X# X# Reads /usr/lib/uucp/.Admin/xferstats, and generates a report from it. X# Also understands Ultrix SYSLOG format. X# X# Created by Johan Vromans <jv@mh.nl> X# Loosely based on an idea by Greg Hackney (hack@texbell.swbt.com) X X# Usage: uutraf [xferstats] X X$type = "unknown"; X Xif ( $#ARGV >= 0 ) { X open (STDIN, $ARGV[0]) || die "Cannot open $ARGV[0]"; X open (IN, $ARGV[0]) || die "Cannot open $ARGV[0]"; X $line = <IN>; X split (/ /, $line); X $type = ($_[0] =~ /!/) ? "HDB" : "U"; X} Xelsif ( -r "/usr/spool/uucp/.Admin/xferstats" ) { X open (STDIN, "/usr/spool/uucp/.Admin/xferstats"); X $type = "HDB"; X} Xelsif ( -r "/usr/spool/uucp/SYSLOG" ) { X open (STDIN, "/usr/spool/uucp/SYSLOG"); X $type = "U"; X} Xelse { die "Sorry, don't know what"; } X Xif ( $type eq "HDB" ) { X $pat = "([^!]+)![^(]+\\(([-0-9:/]+)\\).+([<>])-? (\\d+) / (\\d+)\\.(\\d+) secs"; X $recv = "<"; X} Xelse { X $pat = "\\S+\\s+(\\S+)\\s+\\(([-0-9:/]+)\\)\\s+\\(\\d+\\)\\s+(\\w+) (\\d+) b (\\d+) secs"; X $recv = "received"; X} X X%hosts = (); # hosts seen X%bytes_in = (); # of bytes received from host X%bytes_out = (); # of bytes sent to host X%secs_in = (); # of seconds connect for recving X%secs_out = (); # of seconds connect for sending X%files_in = (); # of input requests X%files_out = (); # of output requests X X# read info, break the lines and tally X Xwhile ( <STDIN> ) { X if ( /^$pat/o ) { X# print "host $1, date $2, dir $3, bytes $4, secs $5.$6\n"; X $6 = 0 if $type eq "U"; X # gather timestamps X $last_date = $2; X $first_date = $last_date unless defined $first_date; X X # initialize new hosts X unless ( defined $hosts{$1} ) { X $hosts{$1} = $files_in{$1} = $files_out{$1} = X $bytes_in{$1} = $bytes_out{$1} = X $secs_in{$1} = $secs_out{$1} = 0; X } X X # tally X if ( $3 eq $recv ) { # recv X $bytes_in{$1} += $4; X $files_in{$1}++; X $secs_in{$1} += $5 + $6/1000; X } X else { # xmit X $bytes_out{$1} += $4; X $files_out{$1}++; X $secs_out{$1} += $5 + $6/1000; X } X } X else { X print STDERR "Possible garbage: $_"; X } X} X X@hosts = keys (%hosts); Xdie "No info found, stopped" if $#hosts < 0; X X################ report section ################ X X$thishost = do gethostname(); X$thishost = (defined $thishost) ? "on node $thishost" : "report"; X Xformat std_head = X@||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| X"UUCP traffic $thishost from $first_date to $last_date" X XRemote -----------K-Bytes----------- ----Hours---- --Avg CPS-- --Files-- X Host Recv Sent Total Recv Sent Recv Sent Recv Sent X. Xformat std_out = X@<<<<<<< @>>>>>>>> @>>>>>>>> @>>>>>>>> @>>>>> @>>>>> @>>>> @>>>> @>>> @>>> X$Zhost, $Zi_bytes, $Zo_bytes, $Zt_bytes, $Zi_hrs, $Zo_hrs, $Zi_acps, $Zo_acps, $Zi_count, $Zo_count X. X X$^ = "std_head"; X$~ = "std_out"; X Xdo print_dashes (); X Xreset "T"; # reset totals X Xforeach $host (@hosts) { X do print_line ($host, $bytes_in{$host}, $bytes_out{$host}, X $secs_in{$host}, $secs_out{$host}, X $files_in{$host}, $files_out{$host}); X X} X Xdo print_dashes (); Xdo print_line ("Total", $Ti_bytes, $To_bytes, X $Ti_secs, $To_secs, $Ti_count, $To_count); X X################ that's it ################ X Xsub print_line { X reset "Z"; # reset print fields X local ($Zhost, X $Zi_bytes, $Zo_bytes, X $Zi_secs, $Zo_secs, X $Zi_count, $Zo_count) = @_; X $Ti_bytes += $Zi_bytes; X $To_bytes += $Zo_bytes; X $Zt_bytes = $Zi_bytes + $Zo_bytes; X $Tt_bytes += $Zt_bytes; X $Zi_acps = ($Zi_secs > 0) ? sprintf ("%.0f", $Zi_bytes/$Zi_secs) : "0"; X $Zo_acps = ($Zo_secs > 0) ? sprintf ("%.0f", $Zo_bytes/$Zo_secs) : "0"; X $Zi_bytes = sprintf ("%.1f", $Zi_bytes/1000); X $Zo_bytes = sprintf ("%.1f", $Zo_bytes/1000); X $Zt_bytes = sprintf ("%.1f", $Zt_bytes/1000); X $Zi_hrs = sprintf ("%.1f", $Zi_secs/3600); X $Zo_hrs = sprintf ("%.1f", $Zo_secs/3600); X $Ti_secs += $Zi_secs; X $To_secs += $Zo_secs; X $Ti_count += $Zi_count; X $To_count += $Zo_count; X write; X} X Xsub print_dashes { X $Zhost = $Zi_bytes = $Zo_bytes = $Zt_bytes = X $Zi_hrs = $Zo_hrs = $Zi_acps = $Zo_acps = $Zi_count = $Zo_count = X "------------"; X write; X # easy, isn't it? X} X X################ missing ################ X Xsub gethostname { X $ENV{"SHELL"} = "/bin/sh"; X $try = `hostname 2>/dev/null`; X chop $try; X return $+ if $try =~ /^[-.\w]+$/; X $try = `uname -n 2>/dev/null`; X chop $try; X return $+ if $try =~ /^[-.\w]+$/; X $try = `uuname -l 2>/dev/null`; X chop $try; X return $+ if $try =~ /^[-.\w]+$/; X return undef; X} X X################ verify perl version ################ X X# do verify_perl_version ( [ required , [ message ] ] ) X Xsub verify_perl_version { X local ($version,$patchlevel) = $] =~ /(\d+.\d+).*\nPatch level: (\d+)/; X $version = $version * 1000 + $patchlevel; X X # did the caller pass a required version? X if ( $#_ >= 0 ) { X local ($req, $msg, @req); X @req = split (//, $req = shift); X # if the request is valid - check it X if ( $#req == 3 && $req > $version ) { X if ( $#_ >= 0 ) { # user supplied message X $msg = shift; X } X else { X $msg = "Sorry, this program requires perl " . $req[0] . "." . $req[1] . X " patch level " . $req % 100 ." or later.\nStopped"; X } X die $msg; X } X } X return $version; X} SHAR_EOF chmod 0444 uutraf.pl || echo 'restore of uutraf.pl failed' Wc_c="`wc -c < 'uutraf.pl'`" test 5454 -eq "$Wc_c" || echo 'uutraf.pl: original size 5454, current size' "$Wc_c" fi exit 0 -- Johan Vromans jv@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 62911/62500 ------------------------ "Arms are made for hugging" -------------------------