I had a few enquiries about my diald-load perl script, and then sent
various people a version that didn't work.
Just to clear the confusion, here's an earlier "stable" version. To try
it, you will need to edit the top of the script to set your local config
(using a non-wrapping editor like pico -w), make it chmod +x and run it as
root on a text console. It works fine here, but suffers, like all the
diald monitors, from the occasional problem of /var/log/messages getting
clobbered with diald "Writing error on pipe" messages.
Ben
#!/usr/bin/perl
# diald-load
# July 1997
#
#
# This Perl script gives a continous update on the traffic passing
# through the diald device(s). Sort of.
# Requires Perl 5.
#
# (c) Ben Parker <[EMAIL PROTECTED]> July 1997.
# INSTALL
# Edit the following two lines to reflect your diald program and FIFO location.
#
$FIFO = "/var/local/diald.ctl";
$dialdcommand = "/usr/sbin/diald";
#
# Fill in your domain name and IP number (if possible)
# If this isn't possible, you will get some blank entries on
# the services/ports reporting - but nothing fatal.
#
$mydomain = "dha.unon.org"; # Your domain (without host if on a LAN)
$myip = "172.16.1"; # Your ip number (first three numbers only
# if on a class C LAN setup)
# COPYING/COPYRIGHT/COPYLEFT/LEGAL
#
# This file is free software; you can redsitribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 2, or (at your option) any later
# version.
#
# Also, I would like to hear from you if you are using it.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
# README
#
# Much better-written programs for monitoring and controlling diald are:
# diald-top (from which I got the basic idea), and dcon (from which I
# lifted some tips on how to do this in Perl. There is another monitor for
# X Windows called dialdmon. However, AFAIK, none can give the
# bandwidth-hungry LAN-watching information that diald-load tries to give.
#
# As they say in FIDOnet - we stand on the shoulders of giants. Thanks
# Eric for diald.
#
# Throughput figures are obviously much higher when diald is talking to the
# fake device (sl0) or whatever. For this reason, all measurements relating
# to throughput (peaks, etc) are reset when the interface changes.
#
# I am no expert on UNIX security. This script needs to be run as root only
# to give an initial command to your control FIFO.
#
#
#
#
# TODO/CHANGES
# Look into running suid (homnework required)
# Put DNS lookups in background (threading?) (not yet)
# Get an idea of whether we are losing much data from the pipe in delaying it.
# Splitting input differently -
# loses less data but more errors on /var/log/messages (0.4)
# Stop the log being blasted with "error writing on pipe messages" (todo)
# DNS lookups optional with -n switch (0.4)
# Help/usage message (0.4)
# Monitor FIFO deleted when accidently run non-root (0.4)
# Added services/ports monitoring (0.4)
# Reset counters when interface changes (0.4)
# Work out if the transmit/receive mixup is mine or diald's (todo)
# Color (todo)
# HTML /GIF output? (todo)
#
%wks = (25, "smtp (25)", 80 ,"web (80)", 540, "uucp (540)", 21, "ftp (21)",
23, "telnet (23)" ,53, "dns (53)",110, "pop3 (110)");
#
#
# GET ON WITH IT
#
# Nothing to edit below here unless you wan to hack
#
#
#use strict;
#use diagnostics;
#$dns_cache = "/tmp/diald-load.cache"; # Not implemented yet
$version = "0.4";
use Fcntl;
# Look for command-line switches
if (grep(/h/,@ARGV)) {;
print "$0 (diald-load $version) (c) 1997 Ben Parker <ben\@dha.unon.org>\n";
die "usage: $0 [-help] [-nodns] \n";
}
if (grep(/n/,@ARGV)) {;
$lookups = "off";
warn "no DNS lookups mode requested ...\n";
}
if ($lookups ne "off") {$lookups = "on";}
if (grep(/w/,@ARGV)) {;
$html_report = "on";
warn "HTML report mode requested ...\n";
}
if ($html_report ne "on") {$html_report = "off";}
$date = `date`; # Get start time
print "$0 starting ...\n";
print "$0: Press Ctrl-C to quit at any time ...\n";
$dialdup = 0;
$peakboth = 0;
$both = 0;
# Nothing to edit below here
$MONITOR="/tmp/diald.fifo$$";
# Check if diald is running
open (PS, "ps -aux |") || die "Can't run ps -ax: $!\n";
while (<PS>) {
if (/$dialdcommand/)
{
$dialdup=1;
print "$0: $dialdcommand is running...\n";
}
}
if ($dialdup eq 0) { print "$0: Error: Can't see $dialdcommand running.\n"; $exit =
"$dialdcommand not running"; &quit ;}
# Create and open for reading the monitor pipe
system('mkfifo', $MONITOR, "-m0660");
if (-p $MONITOR) {
print "$0: Opening monitor: $MONITOR ...\n";
}
else { die "$0: Failed to create monitor\n";
}
#open2($MONITOR,"$MONITOR","cat $MONITOR") || die "$0: Can't open monitor $MONITOR:
$!\n";
sysopen(MONITOR,"$MONITOR",O_RDWR|O_NDELAY|O_EXCL,0600) || die "$0: Can't open monitor
$MONITOR: $!\n";
# Tell the diald FIFO we want monitoring ....
print "$0: Opening FIFO: $FIFO ...\n";
#open(FIFO, "> $FIFO") || die "$0: can't access $FIFO: $!\n";
open(FIFO, "> $FIFO") || &kill_monitor;
print "$0: Requesting start of monitoring...\n";
print FIFO "monitor $MONITOR\n" || &quit;
$start_time = time;
close FIFO;
print "\n\n";
$/ = "END"; # each round is one chunk of input
#$/ = "\n\n[A-Z]"; # each round is one lump of input
LOOP:
while (<MONITOR>) {
$SIG{'INT'}="quit";
$SIG{__DIE__}="quit";
++$count;
# if ($count <= 2) {
# goto LOOP;
# }
$_ =~ s/\n/!/g;
#print "begin",$_,"end";
@elements = split(/!/);
$number_of_entries = @elements;
# if ($number_of_entries < 15) {
# goto LOOP;
# }
$counter = 0;
$number_of_names = 0;
@queue = grep(/tcp|udp|icmp/,@elements);
$number_of_queueitems = @queue;
if ($lookups ne "off") {
&names;
}
@fqdns=values(%numtoname);
@ip_numbers=keys(%numtoname);
$number_of_names = @fqdns;
&parse_pipe;
&maths;
# unless (fork) {
# unless (fork) {
# sleep 1 until getppid ==1 ;
# # &crap;
# exit 0;
# }
# exit 0;
# }
# wait;
&topsites;
&topports;
system("clear");
write;
sleep 1;
}
++$fell_out_of_loop;
goto LOOP;
# Try to clean up
print "Unexpected exit: pipe empty?... \n";
$exit = "Unexpected";
&quit;
exit;
# Clean up nicely
sub quit {
$end_time = time;
$end_date = `date`;
# $exit = "User Requested a Quit";
print "Exiting ...\n";
print "Removing cache ...\n";
unlink $dns_cache;
$running_time = $end_time - $start_time;
$lost_data = $running_time - $count;
$pct_lost = ($lost_data/$running_time)*100;
print "Removing monitor $MONITOR ...\n";
unlink $MONITOR;
&report;
exit;
}
sub kill_monitor {
print "Error: $!\n";
print "Removing monitor $MONITOR ...\n";
unlink $MONITOR;
exit
}
sub names {
$blip = 0;
foreach $queueitem(@queue) {
# ++$number_of_queueitems;
@queueitem_array = split(/\s+|\//,$queueitem);
# Information on data received
$quadto_unsplit = ($queueitem_array[1]);
$quadfrom_unsplit = ($queueitem_array[3]);
@quadto_split = split(/\./,$queueitem_array[1]);
@quadfrom_split = split(/\./,$queueitem_array[3]);
# Name lookups
if ($upordown eq "UP") { # Only try lookups when the link is up
if (!defined($numtoname{$quadto_unsplit})) {
$blip++;
$quadto_number = pack("C4",@quadto_split);
$quadto_name = gethostbyaddr($quadto_number,2);
$numtoname{"$quadto_unsplit"} = $quadto_name;
# If lookup comes up blank, don't look again
if ($quadto_name eq "") {
$numtoname{"$quadto_unsplit"} = $quadto_unsplit;}
}
if (!defined($numtoname{$quadfrom_unsplit})) {
$blip++;
$quadfrom_number = pack("C4",@quadfrom_split);
$quadfrom_name = gethostbyaddr($quadfrom_number,2);
$numtoname{"$quadfrom_unsplit"} = $quadfrom_name;
# If lookup comes up blank, don't look again
if ($quadfrom_name eq "")
{$numtoname{"$quadfrom_unsplit"} = $quadfrom_unsplit;}
}
# Replace number with name
$queueitem =~
s/$quadfrom_unsplit\//$numtoname{"$quadfrom_unsplit"}\:/g ;
$queueitem =~ s/$quadto_unsplit\//$numtoname{"$quadto_unsplit"}\:/g;
}
}
}
sub parse_pipe {
foreach $elem(@elements) {
# print "Element $counter: $elem\n";
if ($elem =~ "STATE") {
$state=$elements[($counter+1)];
}
elsif ($elem =~ "MESSAGE") {
$message=$elements[($counter+1)];
}
elsif ($elem =~ "INTERFACE") {
$interface=$elements[($counter+1)];
$local_interface=$elements[($counter+2)];
$remote_interface=$elements[($counter+3)];
&reset_counters;
}
elsif ($elem =~ "STATUS") {
$status=$elements[($counter+1)];
if ($status eq "0") {$upordown = "DOWN";}
if ($status eq "1") {$upordown = "UP";}
}
# elsif ($elem eq "QUEUE") {
# $queuestart = $elements[($counter+1)];
# }
elsif ($elem =~ "LOAD") {
$transmit=$elements[($counter+1)];
$receive=$elements[($counter+2)];
}
$counter++;
}
}
sub topsites {
$topnames{$numtoname{$quadfrom_unsplit}} =
$topnames{$numtoname{$quadfrom_unsplit}} + 1;
$topnames{$numtoname{$quadto_unsplit}} =
$topnames{$numtoname{$quadto_unsplit}} + 1;
@topnames_sorted = sort { $topnames{$b} <=> $topnames{$a} } keys %topnames;
$number_of_topnames = @topnames_sorted;
}
sub topports {
$blip = 0;
foreach $queueitem(@queue) {
@queueitem_array = split(/\s+|\/|:/,$queueitem);
# Information on data received
$port_one = ($queueitem_array[2]);
$port_two = ($queueitem_array[4]);
if (($queueitem_array[1] !~ "$mydomain") && ($queueitem_array[1] !~ $myip)) {
$topports{$port_one} = $topports{$port_one} + 1;
++$total_ports;
}
if (($queueitem_array[3] !~ $mydomain) && ($queueitem_array[3] !~ $myip)) {
$topports{$port_two} = $topports{$port_two} + 1;
++$total_ports;
}
@topports_sorted = sort { $topports{$b} <=> $topports{$a} }
keys(%topports);
@topports_sorted_numbers = sort { $topports{$b} <=> $topports{$a} }
values(%topports);
$number_of_topports = @topports_sorted;
}
$topports_name[0] = $wks{$topports_sorted[0]};
$topports_name[1] = $wks{$topports_sorted[1]};
$topports_name[2] = $wks{$topports_sorted[2]};
if ($total_ports != 0) {
$pct_topports[0] =
($topports{"$topports_sorted[0]"}/$total_ports)*100;
$pct_topports[1] =
($topports{"$topports_sorted[1]"}/$total_ports)*100;
$pct_topports[2] =
($topports{"$topports_sorted[2]"}/$total_ports)*100;
}
}
sub reset_counters {
$peaktransmit = 0;
$peakboth = 0;
$peakkbits = 0;
$peakreceive = 0;
$peakkbytes = 0;
}
sub maths {
$totalreceive += $receive;
$totaltransmit += $transmit;
$both = $receive + $transmit;
$totalboth += $both;
if ($totalboth != 0) {
$pct_receive = ($totalreceive/$totalboth)*100;
$pct_transmit = ($totaltransmit/$totalboth)*100;
}
$average = $totalboth / $count ;
if ($receive > $peakreceive) {
$peakreceive=$receive;
}
if ($transmit > $peaktransmit) {
$peaktransmit=$transmit;
}
if ($both > $peakboth) {
$peakboth=$both;
$peakkbits=(($peakboth*8)/1024);
$peakkbytes=(($peakboth)/1024);
}
if ($peakboth != 0) {
$load = ($both/$peakboth)*100;
$total_load += $load;
$average_load = $total_load / $count;
}
}
sub report {
# open (REPORT, "> /tmp/diald-load.report.$$");
system("clear");
print "$0 $version SUMMARY REPORT\n";
print "----------------------------------------------------------\n";
print "Started at: $date";
print "Ended at: $end_date\n";
print "Exit : $exit\n";
print "DNS lookups : $lookups\n";
print "HTML report : $html_report\n";
print "Chunks read : $count\n";
print "Running time : $running_time\n";
print "Lost data : $lost_data ($pct_lost%)\n";
print "PID : $$\n";
print "Peak throughput: $peakkbits Kilobits per second.\n";
print "Average load : $average_load %\n";
print "Total traffic : $totalboth\n";
print "Active sites : $number_of_names\n";
print "Active services: @topports_sorted\n";
# print "IP Numbers : @ip_numbers\n";
# print "Site names : @fqdns\n";
print "\nThank you for using $0 $version.\n";
print "\e[31;01mSend comments to ben\@dha.unon.org.\e[0m\n";
}
# Output formatting
format STDOUT =
diald-load @<<< started: @<<<<<<<<<<<<<<< Press Ctrl-C to quit
$version,$date
Status: @<<<< Last message: @<<<<<<<<<<<<<<<<<<
$upordown,$message
State : @<<<<<<<< Peak throughput (Kbits/sec):@###.#
$state,$peakkbits
Average Load : @##.#% Current load:@###.#%
$average_load,$load
Stats: ----------------------------------------------------------------------
bytes peak (cps) total percent services
Transmit: @>>>>> @>>>>>>> @>>>>>>>>> @###.#% @<<<<<<<<<<< @<<<%
$transmit,$peaktransmit,$totaltransmit,$pct_transmit,$wks{$topports_sorted[0]},$pct_topports[0]
Receive: @>>>>> @>>>>>>> @>>>>>>>>> @###.#% @<<<<<<<<<<< @<<<%
$receive,$peakreceive,$totalreceive,$pct_receive,$wks{$topports_sorted[1]},$pct_topports[1]
Throughput:@>>>>>> @>>>>>>> @>>>>>>>>> @<<<<<<<<<<< @<<<%
$both,$peakboth,$totalboth,$wks{$topports_sorted[2]},$pct_topports[2]
Busiest: --------------------------------------------------------------------
@<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<
$topnames_sorted[0],$topnames_sorted[1],$topnames_sorted[2]
@<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<
$topnames_sorted[3],$topnames_sorted[4],$topnames_sorted[5]
Queue: ----------------------------------------------------------------------
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$queue[0]
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$queue[1]
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$queue[2]
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$queue[3]
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$queue[4]
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$queue[5]
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$queue[6]
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$queue[7]
Debug: -----------------------------------------------------------------------
Cache: @<<< Count: @<<<<< Chklines: @<<< Queue: @<<< 80: @<<<< tports: @<<<
$number_of_names,$count,$number_of_entries,$number_of_queueitems,$topports{80},$total_ports
iface: @<<<< local: @<<<<<<<<<<<<<<< remote: @<<<<<<<<<<<<<<<
$interface,$local_interface,$remote_interface
.
