#!/usr/bin/perl -Tw

# Copyright 1999, 2000, 2001 (c) Thomas Erskine <thomas.erskine@sourceworks.com>
# See the COPYRIGHT file with the distribution.

# unix-status-server - show interesting info about the machine it's running on
# $Id: unix-status-server.pl,v 1.26 2001/08/28 15:22:24 remstats Exp $

# - - -   Configuration   - - -

use strict;

# What is this program called, for error-messages and file-names
$main::prog = 'unix-status-server';
# How to invoke df (use gnu df; Solaris needs xpg4-df, if you don't have it)
$main::df = &oneof('/usr/local/bin/df', '/usr/xpg4/bin/df', '/sbin/df', 
	'/bin/df');
$main::dfspace_opts = '-Pk';
$main::dfinodes_opts = '-Pi';
# How to invoke vmstat
$main::vmstat_interval = 1;
$main::vmstat = &oneof("/usr/bin/vmstat", "/usr/ucb/vmstat");
#$main::vmstat_opts = "-S $main::vmstat_interval 2";
$main::vmstat_opts = "$main::vmstat_interval 2";
# How to run uptime (prefer gnu uptime)
$main::uptime = &oneof('/usr/local/bin/uptime', '/usr/bin/uptime',
	'/usr/ucb/uptime');
# where is netstat
$main::netstat = &oneof('/usr/bin/netstat',
	'/usr/ucb/netstat', '/usr/sbin/netstat', '/bin/netstat');
# Where is ifconfig.  Only need it on Solaris for now.
$main::ifconfig = &oneof('/usr/sbin/ifconfig', '/sbin/ifconfig');
# Where is uname (prefer the gnu version)
$main::uname = &oneof('/usr/local/bin/uname','/usr/bin/uname','/bin/uname');
# Need this to avoid segfault when using perlcc
$main::sleep = &oneof('/usr/local/bin/sleep','/usr/bin/sleep','/bin/sleep');
# Where is qmail
$main::qmaildir = '/var/qmail';
# a pattern that only matches our site
$main::sitemailpat = '';
# Where is ps
$main::ps = &oneof('/usr/bin/ps', '/bin/ps');
# Which flags we need for ps.  do_ps will choose one of the above, depending
# on the operating system.
$main::sysv_ps_opts = '-eo pid,ppid,user,vsz,rss,pcpu,time,args';
$main::bsd_ps_opts = 'axl';
# Where is ftpcount?
$main::ftpcount = &oneof('/usr/local/sbin/ftpcount','/usr/sbin/ftpcount');
# A timeout to avoid hanging if an external program hangs.
$main::timeout = 60; # seconds

# To stop taint complaints even though I don't use the path
$main::ENV{'PATH'} = '/usr/lib/remstats/bin:/usr/bin';
delete $main::ENV{'ENV'};
delete $main::ENV{'BASH_ENV'};

# - - -   Version History   - - -

(undef, $main::version) = split(' ', '$Revision: 1.26 $');

# - - -   Setup   - - -

use Getopt::Std;

$| = 1; # no output buffering please

# Parse the command-line
my %opt = ();
getopts('d:hrv', \%opt);

if (defined $opt{'h'}) { &usage; } # no return
if (defined $opt{'d'}) { $main::debug = $opt{'d'}; } else { $main::debug = 0; }
if (defined $opt{'r'}) { $main::ignore_remote = 0; } else { $main::ignore_remote = 1; }

# What does the collector want?
$main::do_vmstat = $main::do_df = $main::do_uptime = $main::do_netstat = 
	$main::do_uname = $main::do_qmailq = $main::do_ps = $main::do_ftpcount = 
	$main::do_fileage = $main::do_proc = $main::do_netstat_tcpstates = 0;
$main::complete = 0;
%main::pattern = %main::filename = ();

while ($_ = &prompt) {
	tr/\015\012//d;
	next if (/^#/ or /^\s*$/);

	if (/^GO$/) {
		$main::complete = 1;
		last;
	}
	elsif (/^DEBUG(\s*(\d+)\s*)?$/) { $main::debug = (defined $2) ? $2 : 1; }
	elsif (/^VER(SION)?$/) { print "$main::prog version $main::version\n"; }
	elsif (/^HELP$/) { &do_help; }
	elsif (/^QUIT$/) { exit 0; }
	elsif (/^UNAME$/) { $main::do_uname = 1; }
	elsif (/^VMSTAT$/) { $main::do_vmstat = 1; }
	elsif (/^DF$/) { $main::do_df = 1; }
	elsif (/^UPTIME$/) { $main::do_uptime = 1; }
	elsif (/^NETSTAT$/) { $main::do_netstat = 1; }
	elsif (/^NETSTAT-TCPSTATES$/) { $main::do_netstat_tcpstates = 1; }
	elsif (/^QMAILQ$/) { $main::do_qmailq = 1; }
	elsif (/^PS$/) { $main::do_ps = 1; }
	elsif (/^FTPCOUNT$/) { $main::do_ftpcount = 1; }
	elsif (/^FILEAGE$/) { $main::do_fileage = 1; }
	elsif (/^TIME\s+(\d+)$/) { &do_time($1); next; }
	elsif (/^PROC$/) { $main::do_proc = 1; }
	elsif (/^[A-Z]/) { &error("unknown directive: $_"); }

# Variables, at the moment, only for ps
	else {
		($main::variable, $main::section, $main::rest) = split(' ',$_,3);
		$main::section = uc $main::section;

		if ($main::section eq 'PS') {
			($main::function, $main::pattern) = split(' ', $main::rest, 2);
			$main::function = lc $main::function;
			$main::pattern{$main::section}{$main::variable}{PATTERN} = $main::pattern;
			$main::pattern{$main::section}{$main::variable}{FUNCTION} = $main::function;
		}
		elsif ($main::section eq 'FILEAGE') {
			$main::filename{$main::variable} = $main::rest;
		}
		elsif ($main::section eq 'PROC') {
			($main::filename, $main::pattern) = split(' ', $main::rest, 2);
			$main::pattern{$main::section}{$main::variable}{PATTERN} = $main::pattern;
			$main::pattern{$main::section}{$main::variable}{FILENAME} = $main::filename;
		}
	}
}
&abort("incomplete directives; no GO") unless ($main::complete);

# - - -   Mainline   - - -

# do uname first, so we know where we are
&do_uname; # need uname stuff for others
&do_vmstat if ($main::do_vmstat);
&do_df if ($main::do_df);
&do_uptime if ($main::do_uptime);
&do_netstat if ($main::do_netstat);
&do_netstat_tcpstates if ($main::do_netstat_tcpstates);
&do_qmailq if ($main::do_qmailq);
&do_ps(%main::pattern) if ($main::do_ps);
&do_ftpcount if ($main::do_ftpcount);
&do_fileage(%main::filename) if ($main::do_fileage);
&do_proc if ($main::do_proc);

# This grossness allows it to not segfault when compiled by perlcc
close(STDOUT);
close(STDERR);
exec "$main::sleep 0" or do {
	&debug("can't exec $main::sleep: $!\n") 
		if ($main::debug);
	exit 0;
};

#----------------------------------------------------------- prompt ---
sub prompt {
	if (-t STDIN) { print $main::prog .'> '; }
	scalar(<STDIN>);
}

#----------------------------------------------------------- do_help ---
sub do_help {
	print <<"EOD_HELP";
$main::prog version $main::version
Valid commands are:
	DEBUG VERSION HELP UNAME VMSTAT DF UPTIME 
	NETSTAT QMAILQ PS FTPCOUNT FILEAGE TIME PROC QUIT
	NETSTAT-TCPSTATES
and
	variable PS function pattern
	variable FILEAGE filename
	variable PROC /proc/file/name pattern
ending with GO
EOD_HELP
}

#----------------------------------------------------------------- usage ---
sub usage {
	print STDERR <<"EOD_USAGE";
$main::prog version $main::version
usage: $0 [options]
where options are:
	-d nnn	enable debugging output at level 'nnn'
	-h	show this help
	-r	include remotely-mounted file-systems
	-t tst	do tests 'tst, a comma-separated list of:
		vmstat, df, uptime, netstat, uname, ps, proc, 
		ftpcount, netstat-tcpstates, fileage and qmailq
EOD_USAGE
	exit 0;
}

#----------------------------------------------------------------- debug ---
sub debug {
	my ($msg) = @_;

	if ($main::debug) { print "DEBUG: $msg\n"; }
0;
}

#----------------------------------------------------------------- error ---
sub error {
	my ($msg) = @_;
	print "ERROR: $msg\n";
}

#------------------------------------------------------------------ abort ---
sub abort {
	my ($msg) = @_;

	print "ABORT: $msg\n";
	exit 1;
}

#---------------------------------------------------------------- oneof ---
# Find a program in a list of possibilities and return the first match
sub oneof {
	my @progs = @_;
	my $result;
	foreach (@progs) {
		if (-f $_) { $result = $_; last; }
	}
$result;
}

#------------------------------------------------------------------ do_df ---
sub do_df {
	my ($size, $free, $used, $percent, $mount, $line, $now);

	unless ($main::df) {
		&debug("can't find df") if ($main::debug);
		return;
	}

# First the disk space
	if ($main::ignore_remote) { $main::dfspace_opts .= 'l'; }
	&debug("using '$main::df $main::dfspace_opts' for df") if ($main::debug);
	open (PIPE, "$main::df $main::dfspace_opts|") or do {
		&error("do_df space $!");
		return undef;
	};
	$SIG{ALRM} = \&catch_alarm;
	$main::alarms = 0;
	alarm($main::timeout);
	while (eval {$line = <PIPE>}, ((defined $line) and (!$main::alarms))) {
		if (($@ and $@ =~ /^alarm/) or $main::alarms) {
			alarm(0);
			&error("do_df: timeout reading df from $main::host; skipped");
			last;
		}
		elsif ($@) {
			alarm(0);
			&error("do_df: error reading df from $main::host; skipped");
			last;
		}
		last unless (defined $line);
		chomp $line;
		&debug("DF raw: $line") if ($main::debug>1);
		next if ($line =~ /^Filesystem/); # header-line

# Deal with df that doesn't know -P, and wraps the lines
		if ($line =~ /^\S+\s*$/) {
			$line .= eval {<PIPE>};
			if (($@ and $@ =~ /^alarm/) or $main::alarms) {
				alarm(0);
				&error("do_df: timeout reading df from $main::host; skipped");
				last;
			}
			elsif ($@) {
				alarm(0);
				&error("do_df: error reading df from $main::host; skipped: $@");
				last;
			}
			chomp;
		}
		next if ($main::ignore_remote and $line =~ m#^\S+:/\S+#); # remote fs

		(undef, $size, $used, undef, $percent, $mount) = split(' ', $line);
		if ($percent =~ /(.*)%$/) { $percent = $1; }
		else { $percent = -1; }
		$size = $size * 1024;
		$used = $used * 1024;
		$now = time;
		print <<"EOD_DF";
$now dfsize:$mount $size
$now dfused:$mount $used
$now dfpercent:$mount $percent
EOD_DF
	}
	alarm(0);
	close (PIPE);
	&debug("DF done blocks") if ($main::debug>1);

# Now get the inodes
	&debug("using '$main::df $main::dfinodes_opts' for df inodes") if ($main::debug);
	open (PIPE, "$main::df $main::dfinodes_opts|") or &abort("do_df inodes $!");
	alarm($main::timeout);
	while ($line = eval{<PIPE>}, ((defined $line) and !$main::alarms)) {
		if (($@ and $@ =~ /^alarm/) or $main::alarms) {
			alarm(0);
			&error("do_df_inode: timeout reading df from $main::host; skipped");
			last;
		}
		elsif ($@) {
			alarm(0);
			&error("do_df_inode: error reading df from $main::host; skipped: $@");
			last;
		}
		last unless (defined $line);
		chomp $line;
		&debug("DF raw: $line") if ($main::debug>1);
		next if ($line =~ /^Filesystem/); # header-line
		next if ($line =~ m#^\S+:/\S+#); # remote fs
		if (defined $main::osname and $main::osname =~ /^OSF1$/i) {
			(undef, undef, undef, undef, undef, $used, $free, $percent, $mount)
				= split(' ', $line);
			$size = $free + $used;
		}
		else {
			(undef, $size, $used, undef, $percent, $mount) = split(' ', $line);
		}
		if ($percent =~ /(.*)%$/) { $percent = $1; }
		else { $percent = -1; }
		$now = time;
		print <<"EOD_INODES";
$now inodessize:$mount $size
$now inodesused:$mount $used
$now inodespercent:$mount $percent
EOD_INODES
	}
	alarm(0);
	close (PIPE);
	&debug("DF done inodes") if ($main::debug>1);
}

#-------------------------------------------------- do_vmstat ---
sub do_vmstat {
	my ($freemem, $swapmem, $scanrate, $syscalls, $contextswitches, 
		$cpusystem, $cpuuser, $cpuidle, $now);

	my ($junk, @temp);
	&debug("using '$main::vmstat $main::vmstat_opts' for vmstat") if ($main::debug);
	open (PIPE, "$main::vmstat $main::vmstat_opts|") or 
		(&error("do_vmstat: Can't exec $main::vmstat: $!") and
		return);
	while (<PIPE>) {
		chomp;
		last if (/^\s*\d+/);
	}
	$_ = <PIPE>; # here's the data, the second line beginning with a number
	chomp;
	&debug("using data: '$_'") if ($main::debug);
	@temp = split(' ', $_);

# Old SunOS
	if (defined $main::osname and defined $main::osrelease and
			("$main::osname-$main::osrelease" =~ /^SunOS-4/)) {
			# just too mixed up to be worth attempting to parse
	}

# Digital Unix
	elsif (defined $main::osname and $main::osname =~ /^OSF1$/i) {
		($freemem, $syscalls, $contextswitches, $cpuuser, $cpusystem, 
				$cpuidle) = @temp[4,13,14,15,16,17];
		if ($freemem =~ /^(\d+)K$/) { $freemem = $1 * 8; }
		elsif ($freemem =~ /^(\d+)M$/) { $freemem = $1 * 8 * 1024; }
		$now = time;
		print <<"EOD_VMSTAT2";
$now syscalls $syscalls
$now freemem $freemem
$now contextswitches $contextswitches
$now cpuuser $cpuuser
$now cpusystem $cpusystem
$now cpuidle $cpuidle
EOD_VMSTAT2
	}

	elsif (defined $main::osname and $main::osname =~ /^Linux$/i) {
		($freemem, $contextswitches, $cpuuser, $cpusystem, $cpuidle) =
			@temp[4,12,13,14,15];
		$now = time;
		print <<"EOD_VMSTAT3";
$now freemem $freemem
$now contextswitches $contextswitches
$now cpuuser $cpuuser
$now cpusystem $cpusystem
$now cpuidle $cpuidle
EOD_VMSTAT3
	}

# FreeBSD

	elsif (defined $main::osname and $main::osname =~ /^FreeBSD$/i) {
		($freemem, $contextswitches, $cpuuser, $cpusystem, $cpuidle) =
			@temp[4,15,16,17,18];
		$now = time;
		print <<"EOD_VMSTAT4";
$now freemem $freemem
$now contextswitches $contextswitches
$now cpuuser $cpuuser
$now cpusystem $cpusystem
$now cpuidle $cpuidle
EOD_VMSTAT4
	}

# NetBSD

	elsif (defined $main::osname and $main::osname =~ /^NetBSD$/i) {
		if ($main::osrelease eq "1.4.3"){
			($freemem, $contextswitches, $cpuuser, $cpusystem, $cpuidle) =  
				@temp[4,17,18,19,20];                                         
		}
		else {
			($freemem, $contextswitches, $cpuuser, $cpusystem, $cpuidle) =
				@temp[4,14,15,16,17];
		}
		$now = time;
		print <<"EOD_VMSTAT5";
$now freemem $freemem
$now contextswitches $contextswitches
$now cpuuser $cpuuser
$now cpusystem $cpusystem
$now cpuidle $cpuidle
EOD_VMSTAT5
        }

# Assume they're like Solaris 2.x
	else {
		($swapmem, $freemem, $scanrate, $syscalls, $contextswitches, 
			$cpuuser, $cpusystem, $cpuidle) =
			@temp[3,4,11,17,18,19,20,21];
		$now = time;
		print <<"EOD_VMSTAT1";
$now swapmem $swapmem
$now freemem $freemem
$now scanrate $scanrate
$now contextswitches $contextswitches
$now cpuuser $cpuuser
$now cpusystem $cpusystem
$now cpuidle $cpuidle
EOD_VMSTAT1

	}
	close(PIPE);
}

#-------------------------------------------------- do_uptime ---
sub do_uptime {
	my ($upseconds, $users, $load1, $load5, $load15, $now);

# Make sure we found uptime
	unless (defined $main::uptime) {
		&debug("no uptime program found") if ($main::debug);
		return;
	}

	&debug("using '$main::uptime' for uptime") if ($main::debug);
	open (PIPE, "$main::uptime|") or &abort("do_uptime $!");
	$_ = <PIPE>;
	chomp;
	close (PIPE);

	my $matched = 0;

# Uptime
	if (/\s+up\s+(\d+)\s+day\(?s?\)?,?\s+(\d+)\s*hr\(?s?\)?(,?\s+(\d+))?/) {
		$upseconds = $1*60*60*24 + $2*60*60 + ((defined $4) ? $4*60 : 0);
		$matched = 1;
	}
	elsif (/\s+up\s+(\d+)\s+day\(?s?\)?,?\s+(\d+)\s*min/) {
		$upseconds = $1*60*60*24 + $2*60;
		$matched = 2;
	}
	elsif (/\s+up\s+(\d+)\s+day\(?s?\)?,?\s+(\d+):(\d+)/) {
		$upseconds = $1*60*60*24 + $2*60*60 + $3*60;
		$matched = 3;
	}
	elsif (/\s+up\s+(\d+)\s+day\(?s?\)?,?/) { # stupid solaris
		$upseconds = $1*60*60*24;
		$matched = 4;
	}
	elsif (/\s+up\s+(\d\d?):(\d\d)/) {
		$upseconds = $1*60*60 + $2*60;
		$matched = 5;
	}
	elsif (/\sup\s+(\d\d?)\s+hr\(?s?\)?(,?\s+(\d+))?/) { # *&^*&@# solaris
		$upseconds = $1*60*60 + ((defined $2) ? $2*60 : 0);
		$matched = 6;
	}
	elsif (/\s(\d\d?)\s+min/) {
		$upseconds = $1*60;
		$matched = 7;
	}
	else {
		&error("do_uptime: unknown uptime: $_");
		&errorlog("unknown uptime: $_");
		return;
	}

	$now = time;
	if (defined $upseconds) {
		print "$now uptime $upseconds\n";
	}

# users
	if (/\s+(\d+)\s+user/) { $users = $1; }
	elsif (/\s+no\s+users/) { $users = 0; }
	if (defined $users) { print "$now users $users\n"; }

# load averages
	if (/load averages?:\s+(\d+\.\d+),\s+(\d+\.\d+),\s+(\d+\.\d+)/) {
		($load1, $load5, $load15) = ($1, $2, $3);
		print "$now load1 $load1\n$now load5 $load5\n$now load15 $load15\n";
	}
	else {
		($load1, $load5, $load15) = (-1, -1, -1);
		&errorlog("unknown load-average: $_");
	}

}

#-------------------------------------------- do_netstat_tcpstates ---
sub do_netstat_tcpstates {

# Make sure we found netstat
	unless (defined $main::netstat) {
		&debug("no netstat program found") if ($main::debug);
		return;
	}

	my %count = ( 
		LISTEN		=> 0, 
		SYN_RCVD	=> 0,
		SYN_RECV	=> 0, # clever people "improving" names
		ESTABLISHED	=> 0,
		CLOSE_WAIT	=> 0,
		LAST_ACK	=> 0,
		FIN_WAIT_1	=> 0,
		FIN_WAIT1	=> 0, # clever people "improving" names
		FIN_WAIT_2	=> 0,
		FIN_WAIT2	=> 0, # clever people "improving" names
		CLOSING		=> 0,
		CLOSE		=> 0, # clever people "improving" names
		TIME_WAIT	=> 0,
		CLOSED		=> 0, # shouldn't happen, but just in case
		SYN_SENT	=> 0,
	);
	my %clever = (	# map the clever names to the correct ones
		'SYN_RECV'	=> 'SYN_RCVD',
		'FIN_WAIT1'	=> 'FIN_WAIT_1',
		'FIN_WAIT2'	=> 'FIN_WAIT_2',
		'CLOSE'		=> 'CLOSING',
	);
	my ($state, %unknown);

# Collect the state counts
	&debug("using '$main::netstat -na' for netstat") if ($main::debug);
	open (PIPE, "$main::netstat -na|") or &abort("do_netstat_tcpstates $!");
	while (<PIPE>) {
		chomp;
		next if (/^Proto/);
		next unless (/^tcp\s/);
		$state = (split(' ', $_))[5];
		unless (defined $state) {
			&errorlog("netstat_tcpstates: unknown: $_");
			&debug("unknown: $_") if ($main::debug);
			next;
		}
		if (defined $count{$state}) { $count{$state} += 1; }
		else {
			&errorlog("netstat_tcpstates: unknown state: $_");
			&error("unknown state: $_");
			$count{$state} = 1;
		}
	}
	close( PIPE);

# Deal with some "clever" people inventing new state names
#	$count{CLOSING} += $count{CLOSE};
#	delete $count{CLOSE};
#	$count{FIN_WAIT_1} += $count{FIN_WAIT1};
#	delete $count{FIN_WAIT1};
#	$count{FIN_WAIT_2} += $count{FIN_WAIT2};
#	delete $count{FIN_WAIT2};
#	$count{SYN_RECV} += $count{SYN_RCVD};
#	delete $count{SYN_RECV};

	foreach my $bad (keys %clever) {
		$count{$clever{$bad}} += $count{$bad};
		delete $count{$bad};
	}

# Print them
	my $now = time();
	foreach (sort keys %count) {
		print $now, ' tcpstate:', $_, ' ', $count{$_}, "\n";
	}
}

#---------------------------------------------------- do_netstat ---
sub do_netstat {

# First, get the interfaces
	my ($interface, $net, $inpkt, $inerr, $outpkt, $outerr, $coll, $now, $flags, $status,
		%interfaces, $new_linux_netstat);
	%interfaces = ();
	$new_linux_netstat = 1;
	$status = 2;
	$now = time();

# make sure we found netstat
	unless (defined $main::netstat) {
		&debug("no netstat program found") if ($main::debug);
		return;
	}

	&debug("using '$main::netstat -i' for netstat") if ($main::debug);
	open (PIPE, "$main::netstat -i|") or &abort("do_netstat interfaces $!");
	while (<PIPE>) {
		chomp;
		next if (/^Name/ or /^Kernel Interface table/ or /- no statistics available - /);
		if (/^Iface/) { $new_linux_netstat = 0; next; }
		next if (/^\s*$/); # for Solaris 8 with IPV6
		if ($main::osname eq 'Linux') {
			if ($new_linux_netstat) {
				if (/^(\S+)/) { $interface = $1; }
				elsif (/^\s+UP/) { $status = 1; }
				elsif (/RX packets:(\d+)\s+errors:(\d+)/) {
					($inpkt, $inerr) = ($1, $2);
				}
				elsif (/TX packets:(\d+)\s+errors:(\d+)/) {
					($outpkt, $outerr) = ($1, $2);
					print <<"EOD_NETSTAT3";
$now interface_packets_in:$interface $inpkt
$now interface_errors_in:$interface $inerr
$now interface_packets_out:$interface $outpkt
$now interface_errors_out:$interface $outerr
$now interface_status:$interface $status
EOD_NETSTAT3
				}
			}
			else {
				($interface, undef, undef, $inpkt, $inerr, undef, undef, $outpkt, 
					$outerr, undef, undef, $flags) = split(' ',$_);
				next if (defined $interfaces{$interface}); # for IPV6
				$interfaces{$interface} = 1;
				if (defined $flags and $flags =~ /U/i) { $status = 1; }
				else { $status = 2; }
				$now = time;
				print <<"EOD_NETSTAT2";
$now interface_packets_in:$interface $inpkt
$now interface_errors_in:$interface $inerr
$now interface_packets_out:$interface $outpkt
$now interface_errors_out:$interface $outerr
$now interface_status:$interface $status
EOD_NETSTAT2
			}
		}
		else {
			last if(/^\s*$/); # to ignore IPV6 stuff under Solaris 8
			($interface, undef, $net, undef, $inpkt, $inerr, $outpkt, 
				$outerr, $coll) = split(' ',$_);
                        if ($interface =~ m#^([a-zA-Z0-9/:]+)$#) { $interface = $1; }          
                        else {
                                &debug("invalid interface in: $_") if ($main::debug);
                                next;
                        }
			next if ($net =~ /^<Link>$/i); # for Digital Unix
			next if (defined $interfaces{$interface}); # for IPV6
			$interfaces{$interface} = 1;
			$now = time;
			if (defined $main::ifconfig) {
				my $text = `$main::ifconfig $interface`;
				if (defined $text and $text =~ /flags=\d+<([^>]+)>/) {
					$text = $1;
					if ($text =~ /UP/) { $status = 1; }
					else { $status = 2; }
					print "$now interface_status:$interface $status\n";
				}
				else {
					&debug("unknown response from $main::ifconfig: $text")
						if ($main::debug);
					&errorlog("unknown ifconfig response: $text");
				}
			}
			print <<"EOD_NETSTAT2";
$now interface_packets_in:$interface $inpkt
$now interface_errors_in:$interface $inerr
$now interface_packets_out:$interface $outpkt
$now interface_errors_out:$interface $outerr
$now interface_collisions:$interface $coll
EOD_NETSTAT2
		}
	}
	close (PIPE);

}

#------------------------------------------ do_uname ---
sub do_uname {
	my ($now);

	unless (defined $main::uname) {
		&debug("no uname program found") if ($main::debug);
		return;
	}
	&debug("using '$main::uname' for uname") if ($main::debug);

# Invoke each part separately, in case some-one forgot one of them
	my $hw = `$main::uname -m`; chomp $hw;
	unless (defined $hw) { $hw = 'unknown'; }
	my $os = `$main::uname -s`; chomp $os;
	unless (defined $os) { $os = 'unknown'; }
	my $rel = `$main::uname -r`; chomp $rel;
	unless (defined $rel) { $rel = 'unknown'; }
	my $ver = `$main::uname -v`; chomp $ver;
	unless (defined $ver) { $ver = 'unknown'; }

	$now = time;
	print <<"EOD_UNAME";
$now machine $hw
$now os_name $os
$now os_release $rel
$now os_version $ver
EOD_UNAME
	$main::osname = $os;
	$main::osrelease = $rel;
}

#------------------------------------------ do_qmailq ---
sub do_qmailq {
	my ($now);

	unless (defined $main::qmaildir) {
		&debug("qmaildir isn't defined; ; skipping qmailq") if ($main::debug);
		return;
	}
	unless (-d $main::qmaildir) {
		&debug("qmaildir $main::qmaildir doesn't exist; skipping qmailq") if ($main::debug);
		return;
	}

	my $qstat = $main::qmaildir . '/bin/qmail-qstat';
	unless (-f $qstat) {
		&debug("$qstat doesn't exist; skipping qmailq") if ($main::debug);
		return;
	}
	&debug("using '$qstat' for qmail-qstat") if ($main::debug);

# Overall qmail queue status
	my $status = `$qstat`;
	my ($qlen, $qbacklog);
	if ($status =~ /messages in queue:\s+(\d+)/) {
		$qlen = $1;
	}
	else { $qlen = -1; }
	if ($status =~ /messages in queue but not yet preprocessed:\s+(\d+)/){
		$qbacklog = $1;
	}
	else { $qbacklog = -1; }
	print <<"EOD_QMAIL1";
$now qmail_qsize $qlen
$now qmail_qbacklog $qbacklog
EOD_QMAIL1

# Now a breakdown of the destinations into local, site and remote
	my $qread = $main::qmaildir . '/bin/qmail-qread';
	&debug("using '$qread' for qmail-qread") if ($main::debug);
	open (PIPE, "$qread|") or die "can't open pipe to $qread: $!\n";
	my ($nlocal, $nsite, $nremote) = (0,0,0);
	my $dest;
	while (<PIPE>) {
		chomp;
		next if (/^  done/ or /^\s*\d/);
		if (/^\s+remote\s+(\S+)/) {
			$dest = $1;
			if ($dest =~ m/$main::sitemailpat/i) { ++$nsite; }
			else { ++$nremote; }
		}
		elsif (/^\s+local\s/) { ++$nlocal; }
		elsif (/^warning:/) { next; }
		else {
			&errorlog( "$qread output has changed: $_");
			next;
		}
	}
	close (PIPE);
	$now = time;
	print <<"EOD_QMAIL2";
$now qmail_qlocal $nlocal
$now qmail_qsite $nsite
$now qmail_qremote $nremote
EOD_QMAIL2
	
}

#-------------------------------------------------------------- do_fileage ---
sub do_fileage {
	my (%filename) = @_;
	my ($filename, $variable, $modtime, $now);

	foreach $variable (keys %filename) {
		$filename = $filename{$variable};
		&debug("fileage for $filename:") if ($main::debug);
		if (-f $filename) {
			$modtime = int((-M _)*24*60*60); # seconds
			$now = time;
			print "$now fileage:$variable $modtime\n";
		}
		else {
			&error("fileage: no such file as $filename");
		}
	}
}

#------------------------------------------------------------------- do_ps ---
sub do_ps {
	my (%pattern) = @_;
	my $cmd = $main::ps;
	my (%count, %sum, %last,%average, %min, %max, $variable, $now);

# Make sure there is something for do_ps to look for
	unless (defined $pattern{PS}) {
		&debug("no patterns for ps; skipped") if ($main::debug);
		return;
	}

# Make sure that variables have a zero value, if not found, so we cann't tell
# the difference between missing and zero
	%pattern = %{$pattern{PS}};
	foreach $variable  (keys %pattern) {
		$count{$variable} = 0;
		$sum{$variable} = 0;
		$last{$variable} = 0;
		$average{$variable} = 0;
		$min{$variable} = 0;
		$max{$variable} = 0;
	}

# Specify the BSD variants
	if (defined $main::osname and defined $main::osrelease and (
			($main::osname eq 'SunOS' and $main::osrelease lt 5) or
			($main::osname eq 'Linux')
			)) {
		$cmd .= ' ' . $main::bsd_ps_opts;
	}

# Assume it's SysV otherwise
	else {
		$cmd .= ' ' . $main::sysv_ps_opts;
	}
	&debug("using ps command: $cmd") if ($main::debug);

# Look at the output of ps
	open (PIPE, "$cmd|") or &abort("do_ps open $!");
	my $junk = <PIPE>; # the header isn't interesting to us

	while (<PIPE>) {
		chomp;
		next if (/^\s*$/);
		&debug("line=$_\n") if ($main::debug>1);

		foreach $variable (keys %pattern) {
			my ($pattern, $function) = ($pattern{$variable}{PATTERN}, 
				$pattern{$variable}{FUNCTION});
			if (/$pattern/i) {
				if ($function eq 'count') {
					$count{$variable}++;
				}
				elsif ($function eq 'sum') {
					$sum{$variable} += $1;
				}
				elsif ($function eq 'last') {
					$last{$variable} = $1;
				}
				elsif ($function eq 'min') {
					$min{$variable} = $1 if ($1 < $count{$variable});
				}
				elsif ($function eq 'max') {
					$max{$variable} = $1 if ($1 > $count{$variable});
				}
				else {
					&error( "unknown function '$function' for $variable");
				}
			}
		}

		# Fix up averages
		foreach $variable (keys %pattern) {
			my ($pattern, $function) = ($pattern{$variable}{PATTERN}, 
				$pattern{$variable}{FUNCTION});
			if ($function eq 'average') {
				$average{$variable} = $sum{$variable} / $count{$variable};
			}
		}
	}
	close (PIPE);

# tell what we found
	$now = time;
	foreach $variable (keys %pattern) {
		my $function = $pattern{$variable}{FUNCTION};
		print "$now ps:$variable ";
		if ($function eq 'count') { print $count{$variable} ."\n"; }
		elsif ($function eq 'sum') { print $sum{$variable} ."\n"; }
		elsif ($function eq 'last') { print $last{$variable} ."\n"; }
		elsif ($function eq 'average') { print $average{$variable} ."\n"; }
		elsif ($function eq 'min') { print $min{$variable} ."\n"; }
		elsif ($function eq 'max') { print $max{$variable} ."\n"; }
		else { &error("unknown function for $variable ($function)"); }
	}
}

#-------------------------------------- do_ftpcount ---
sub do_ftpcount {
	my ($class, $count, $max, $now);
	
	unless (defined $main::ftpcount){
		&error( "do_ftpcount: can't find ftpcount; skipped");
		return;
	}
	open (FTPCOUNT, "$main::ftpcount|") or
		(&error("do_ftpcount: can't run $main::ftpcount: $!") and return);

# Service class real-local           -   0 users ( 20 maximum)
	while (<FTPCOUNT>) {
		if (/^Service class\s+(\S+)\s+-\s*(\d+)\s+users?\s+\(\s*(\d+)/i) {
			$class = $1;
			$count = $2;
			$max = $3;
			$now = time;
			print <<"EOD_FTPCOUNT";
$now ftpcount:$class $count
$now ftpmax:$class $max
EOD_FTPCOUNT
		}
		else {
			&debug("unknown ftpcount line: $_") if ($main::debug>1);
			&errorlog("unknown ftpcount line: $_");
		}
	}
	close (FTPCOUNT);
}

#------------------------------------------------------- catch_alarm ---
sub catch_alarm {
	$main::alarms++;
	if ($main::alarms > 1) {
		&abort("second timeout unhandled");
	}
}

#------------------------------------------------------- do_time ---
sub do_time {
	my ($remote_time) = @_;
	my $local_time = time();
	my $diff = $local_time - $remote_time;
	print <<"EOD_TIME";
$local_time time $local_time
$local_time timediff $diff
EOD_TIME
}

#---------------------------------------------------------- do_proc ---
sub do_proc {
	unless( defined $main::pattern{PROC}) {
		&debug("no PROC patterns; skipped") if ($main::debug);
		return;
	}

	my ($var, $filename, $pattern, $data, $now);

	foreach $var (keys %{$main::pattern{PROC}}) {
		$filename = $main::pattern{PROC}{$var}{FILENAME};
		$pattern = $main::pattern{PROC}{$var}{PATTERN};
		&debug("doing proc: $var $filename $pattern") if ($main::debug);

# Get the data; they're all small, so slurp the whole file
		open (PROC, "<$filename") or do {
			&error("can't open $filename: $!");
			next;
		};
		$data = join('', <PROC>) or do {
			close (PROC);
			&error("can't read $filename: $!");
			next;
		};
		close(PROC);

# Now look for the pattern
		if ($data =~ /$pattern/m) {
			if (defined $1) {
				$now = time;
				print $now, ' proc:', $var, ' ', $1, "\n";
			}
			else {
				&debug("proc: no data for $var $filename $pattern")
					if ($main::debug);
			}
		}

	}
}

#----------------------------------------------- errorlog ---
sub errorlog {
	my $msg = shift @_;
	my $file = "/var/log/remstats/${main::prog}.errorlog";

	open (ERRORS, ">>$file") or do {
		&error("can't open $file: $!");
		return;
	};
	print ERRORS $msg, "\n";
	close ERRORS;
}
