#!/usr/bin/perl
#
# statmon - check for hosts going up and down, or with bad clocks
# tom christiansen <tchrist@convex.com> on 3/8/90
#

RESTART:  			# shouldn't really need this...

($program = $0) =~ s%.*/%%;
$version = 0.3;

$| = 1;

&bad_usage unless $#ARGV >= 0;

printf "%s v%3.1g; ", $program, $version;

if ($compiled) {
    print "quick start.... ";
} else {
    print "initializing... ";
    
    # some useful constants
    $sockaddr_t	= 'S n a4 x8';
    $inetaddr_t = 'C4';
    $sgttyb_t   = 'C4 S';            

    $SINCE_1970 = 2208988800;

    $def_timeout  = 5;      # how long we give a host to answer us
    $def_timewarp = 10;     # how far time may vary until we complain
    $def_retries  = 5;	    # he gets this many tries to answer us
    $def_sleep    = 5;      # between send loops

    $retries      = $def_retries;
    $timeout      = $def_timeout;
    $timewarp     = $def_timewarp;
    $sleep        = $def_sleep;

    $OOPS = ", can't continue";

    $dashes = ('-' x 75) . "\n";

    %cmds = (
	'q',	'quit',
	'x',	'quit',
	'h',	'help',
	'?',	'help',
	't',	'timers',
	'd',	'downers',
	'u',	'uppers' ,
	'm',	'missing',
	'U',	'usage' 
    );

    require 'sys/errno.ph';
    require 'sys/socket.ph';
    require 'sys/ioctl.ph';
    require 'ctime.pl';
    require 'getopts.pl';
} 


&Getopts('udmt:r:c:s:') || &bad_usage;

$debug = $opt_d;


$retries  = $opt_r if defined $opt_r;
$timeout  = $opt_t if defined $opt_t;
$timewarp = $opt_c if defined $opt_c;
$sleep    = $opt_s if defined $opt_s;

DUMP: {
    if ($opt_u) {  # dump this puppy
	if ($compiled++) {
	    warn "already dumped, ignoring -u\n";
	    last DUMP;
	} 
	print "dumping\n";
	reset 'o';		# so the opt_* vars (especially $opt_u!) go away
	dump RESTART;
	# not reached
    } 
}

$SIG{'INT'}  = $SIG{'HUP'} = $SIG{'TERM'} = $SIG{'QUIT'} = 'quit';
$SIG{'CONT'} = 'continue';

# if they say -m, then they want to take stuff from /usr/adm/MACHINES
#
# which is of the general form:
#
#	NAME	features
#
#	spool   vax bsd
#	coyote	sunos4 diskserver
#	pokey	sunos4 diskless slow
#	gort 	convex bsd 
#
if ($opt_m) {
    # try very hard to find a machines file
    $MACHINES = $ENV{'GHOSTS'};
    $MACHINES = $ENV{'MACHINES'} 	    unless $MACHINES;		
    $MACHINES = $ENV{'HOME'} . '/.ghosts'   unless $MACHINES;
    $MACHINES = $ENV{'HOME'} . '/.machines' unless -f $MACHINES;
    $MACHINES = '/usr/adm/MACHINES'         unless -f $MACHINES;

    die "Can't find any MACHINES file"      unless -f $MACHINES;

    open(MACHINES) ||                        die "can't open $MACHINES: $!";

    print "opened $MACHINES\n"		    if $debug;
    @hosts = <MACHINES>;
    close MACHINES;

    @hosts = grep(/^\w+\s/, @hosts);

    while ($criterion = shift) {
	@hosts = grep(/\b$criterion\b/, @hosts);
    } 

    for (@hosts) {
	chop;
	s/^(\w+).*/$1/;
    } 
} else {
    @hosts = @ARGV;
} 

if ($#hosts < 0) {
    print "No hosts\n";
    &bad_usage;
} 

print "hosts are @hosts\n" if $debug;

#
# ok, now create our socket we want everyone to talk to us at
#

chop ($localhost = `hostname`);

(($name, $aliases, $type, $len, $thisaddr) = gethostbyname($localhost))
    || die "no localhost \"$localhost\"$OOPS";

(($name, $aliases, $port, $proto) = getservbyname('time', 'udp'))
    || die "no udp service for \"time\"$OOPS";

print "service is $name, port is $port\n" 
    if $debug;


(($name, $aliases, $proto) = getprotobyname('udp'))
    || die "can't get udp proto$OOPS" ;


socket(SOCKET, &AF_INET, &SOCK_DGRAM, $proto) 
    || die "can't get socket$OOPS";

$this = &sockaddr(&AF_INET, 0, $thisaddr);

bind(SOCKET, $this) 
    || die "can't bind socket: $!$OOPS";

#
# now go find all of our hosts' addresses, storing
# these in %hosts keyed on $name
#


print "fetching addrs... ";

for $host (@hosts) {
    (($name, $aliases, $type, $len, @addrs) = gethostbyname($host))
	|| die "no remote \"$host\"\n";

    $name =~ s/\.convex\.com$//;

    $hosts{$name} = $addrs[0];
}

print "done.\nType 'h' for help.\n";

$rin = $win = $ein = '';
vec($rin,fileno(SOCKET),1) = 1;
vec($ttyin,fileno(STDIN),1) = 1;
$rin |= $ttyin;



# now keep interrogating forever
for (;;) {
    %sent = ();  # haven't sent anybody anything yet
    $sent = 0;

    &cbreak;

    print $dashes, "entering send loop\n" if $debug;

    while (($name, $addr) = each %hosts) {
	$that = &sockaddr(&AF_INET, $port, $addr);

	if (!send(SOCKET,0,0,$that)) {
	    printf STDERR "couldn't send to %-12s %-16s\n", $name, &fmtaddr($addr);
	    next;
	}

	$sent{$name}++;
	$sent++;

	#printf "sent to %-12s %s\n", $name, &fmtaddr($addr) if $debug;
    }

    print $dashes, "entering recv loop\n" if $debug;

    $ntimeout = $timeout;

    while ($sent > 0) {
	    $then = time;
	    last unless $nfound = select($rout=$rin, $wout=$win, $eout=$ein, $ntimeout);
	    if ($nfound < 0) {
		warn "select failed: $!\n" unless $! == &EINTR;
		redo;
	    } 
	    $took = (time - $then);
	    $ntimeout -= $took; 

	    &readsock if vec($rout,fileno(SOCKET),1); 
	    &readtty if vec($rout,fileno(STDIN),1); 
    }

    for $name (sort keys %sent) {
	$missed{$name}++;
	printf "%-12s missed %d times\n", $name, $missed{$name} if $debug;
	if (! $down{$name}) {
	    next unless $missed{$name} > $retries;
	    next if $down{$name};
	    $down{$name} = time;
	    printf "%-12s %-16s down at %s", 
		$name, &fmtaddr($hosts{$name}), &ctime($down{$name});
	}
    } 

    print "sleeping $sleep -- hit any key to interrupt\n" if $debug;
    select($ttyout = $ttyin, $wout=$win, $eout = $ein, $sleep);
    &readtty if vec($ttyout,fileno(STDIN),1); 
}

sub sockaddr {
    if (wantarray) {
	    unpack($sockaddr_t, $_[0]);
    } else {
	    pack($sockaddr_t, $_[0], $_[1], $_[2]);
    } 
} 

sub inetaddr {
    if (wantarray) {
	    unpack($inetaddr_t, $_[0]);
    } else {
	    pack($inetaddr_t, $_[0], $_[1], $_[2]);
    }
} 

sub source {
    local($file) = @_;
    local($return) = 0;

    $return = do $file;
    die "couldn't do \"$file\": $!" unless defined $return;
    die "couldn't parse \"$file\": $@" if $@;
    die "couldn't run \"$file\"" unless $return;
}

sub usage {
    print STDERR <<EOM;
usage: $program [switches] host ...
   or: $program [switches] -m [criterion ...]

switches are:
    -m  look in MACHINES file for hosts matching criteria

    -t	timeout for responses (default $def_timeout)
    -r	retries until timed-out host considered down (default $def_retries)
    -c  clock drift tolerance (default $def_timewarp)
    -s  sleep interval between send loops (default $def_sleep)

    -d  print out debugging information
    -u  dump state to disk for faster init
EOM
} 

sub bad_usage {
    &usage;
    exit(1);
} 

sub fmtaddr {
    sprintf("[%d.%d.%d.%d]", &inetaddr(@_[0]));
} 


sub readsock {
    ($hisaddr = recv(SOCKET,$histime='',4,0))
	|| (warn "couldn't recv: $!$OOPS", return);

    $sent--;

    ($addrtype, $port, $iaddr) = &sockaddr($hisaddr);

    $histime = unpack('L',$histime);
    $histime -= $SINCE_1970;

    unless (($name,$aliases,$addrtype,$length,@addrs) =
		gethostbyaddr($iaddr,$addrtype)) 
    {
	printf STDERR "received reply from unknown address %sn",
				&fmtaddr($iaddr);
	next;
    } 
    $name =~ s/\.convex\.com$//;

    printf "%-12s %-16s thinks it's %s", 
		$name, &fmtaddr($iaddr), &ctime($histime) if $debug;

    $delta = ($histime - time);
    $delta = -$delta if $delta < 0;
    $delta{$name} = $delta;

    delete $missed{$name};

    if ($down{$name}) {
	printf "%-12s %-16s back at %s",
		$name, &fmtaddr($iaddr), &ctime(time);
	delete $down{$name};
    } 

    printf "funny, i didn't send $name anything\n" unless $hosts{$name};
    delete $sent{$name};
}

sub readtty {
    local($cmd) = getc;
    local($routine) = '';

    $cmd = sprintf ("%c", ord($cmd) & 0x7f);

    if (defined $cmds{$cmd}) {
	$routine = $cmds{$cmd};
	print "\n",$dashes unless $routine eq 'quit';
	&$routine;
	print $dashes;
    } else {
	printf " -- unknown command: `%s' (0x%02x)\n", $cmd, ord($cmd);
    } 
} 

sub quit {
    $SIG{'TTOU'} = "IGNORE";
    &cooked;
    exit 0;
} 

sub help {
    local($cmd);
    print "Key\tCommand\n";
    for $cmd (sort keys %cmds) {
	printf "%s\t%s\n", $cmd, $cmds{$cmd};
    } 
} 

sub timers {
    local($name);
    print "Bad Clocks exceeding $timewarp seconds\n";
    for $name (sort keys %delta) {
	next unless $delta{$name} > $timewarp;
	printf "%-12s %-16s has a clock that's %4d seconds off\n", 
	    $name, &fmtaddr($hosts{$name}), $delta{$name};
    }
}


sub missing {
    local($name);
    print "Missing Hosts\n";
    for $name (sort keys %missed) {
	printf "%-12s %-16s has missed %d timeout%s of %d seconds\n",
	    $name, &fmtaddr($hosts{$name}), $missed{$name},
	    ($missed{$name} == 1) ? " " : "s", $timeout;
    }
} 

sub downers {
    local($name);
    print "Down Hosts\n";
    for $name (sort keys %down) {
	printf "%-12s %-16s down since %s", 
	    $name, &fmtaddr($hosts{$name}), &ctime($down{$name});
    } 
} 

sub uppers {
    local ($name);

    print "Up Hosts\n";

    for $name (sort keys %hosts) {
	next if $down{$name};
	printf "%-12s up\n", $name;
    } 
} 

sub continue { 
    print "continuing...\n";
    &cbreak; 
}

sub cbreak {
    &set_cbreak(1);
} 

sub cooked {
    &set_cbreak(0);
} 

sub set_cbreak {
    local($on) = @_;

    ioctl(STDIN,&TIOCGETP,$sgttyb) 
	|| die "Can't ioctl TIOCGETP: $!";

    @ary = unpack($sgttyb_t,$sgttyb);
    if ($on) {
	$ary[4] |= &CBREAK;
	$ary[4] &= ~&ECHO;
    } else {
	$ary[4] &= ~&CBREAK;
	$ary[4] |= &ECHO;
    }
    $sgttyb = pack($sgttyb_t,@ary);
    ioctl(STDIN,&TIOCSETP,$sgttyb)
	    || die "Can't ioctl TIOCSETP: $!";

}