#!/afs/athena/contrib/perl/perl
#
######################################################################
#
# vpoll: Poll the version server
# Written by Ken Duda <kkkken@mit.edu>
#
# Should be run out of crontab.
# 
# With no arguments, polls the version server once, 
# complains if there's an error, and logs the result
# (in $dir/vpoll.daily).
#
# With the -d argument, it mails (and clears) its daily log
# (or, if it's Sunday, its weekly log) instead.
#
######################################################################
				# 
				# Configuration variables
				# 
				# 
$logdir = "/site/versions";	# Directory in which to put log files
$daily = "vs-daily";		# List to mail each day
$weekly = "vs-weekly";		# List to mail each week
$error = "vs-error";		# List to mail in event of an error
				# 
				# Less frequently changed...
				# 
$logger = "/usr/ucb/logger";	# Location of the logger program
$facility = "local4";		# Syslog facility
$nomail = 0;			# If 1, won't actually do any mailing (for debugging)
				# 
$daily = "mlc";		# Hack the mailing lists...
$weekly = $daily;		# (for now)
$error = "$daily, kim";		# 
				# 
######################################################################
				# 
				# Variables you probably won't
				# want to change
				# 
$myname = "vpoll";		# Who am I anyway?
$vserver = "VERSIONS.MIT.EDU";	# Hostname of version server
$vport = 8500;			# Version service port (/etc/services?  hesiod?  huh?)
$rport = 8501;			# Port to receive version server responses
$dlog = "$logdir/vpoll.daily";	# Daily log file
$wlog = "$logdir/vpoll.weekly";	# Weekly log file
				# 
				# 
######################################################################




sub SYSLOG {			# Arg 0: level (error, etc)
				# Arg 1: message
    system ("$logger", "-p", "${facility}.$_[0]", "-t", "$myname", "$_[1]");
}


sub MAIL {			# Arg 0: Who to mail to
				# Arg 1: Message
    if ($nomail) {
	print "Would send...\nTo: $_[0]\n$_[1]\n";
    } else {
	open (MAILP, "| /bin/mail $_[0]") || &ERROR("Can't send mail: $!");
	print MAILP "To: $_[0]\n$_[1]\n";
	close(MAILP);
    }
}



require 'ctime.pl'; 

	      
sub ADDLOG {			# Arg 0: string to log
    if (open (LOGF, ">>$dlog")) {
	chop(local($time) = &ctime(time));
	print LOGF "$time $_[0]\n";
	close LOGF;
    } else {
	print ("open failed in ADDLOG: $!\n");
    }
}


sub ERROR {			# Arg 0: Interal error message
    &ADDLOG ("$_[0]");
    &SYSLOG ("error", "$_[0]");
    &MAIL ("$error", "Subject: $myname losing\n
Internal error in version server poll program ($myname):\n$_[0]");
    exit 1;
}


sub DAILY {			# No args
    local(@time) = localtime;
    system ("cat $dlog >> $wlog");
    &MAIL ($daily, "Subject: Daily vpoll report\n\n" . `cat $dlog`);
    unlink ($dlog);
    if ($time[6] == 0) {	# Sunday?
	&MAIL ($weekly, "Subject: Weekly vpoll report\n\n" . `cat $wlog`);
	unlink ($wlog);		# start over.
    }
}




if ($ARGV[0] eq '-d') {
    &DAILY;
    exit (0);
}


require 'sys/socket.ph';
require 'errno.ph';
$sockaddr = 'S n a4 x8';

($u, $u, $u, $u, $vaddr) = gethostbyname($vserver);
$sendaddr = pack($sockaddr, &AF_INET, $vport, $vaddr);
$recvaddr = pack($sockaddr, &AF_INET, $rport, $myaddr);

socket (SOCK, &PF_INET, &SOCK_DGRAM, 0) || &ERROR ("socket: $!");
bind (SOCK, $recvaddr) || &ERROR ("bind: $!");


sub V_CHECK {0;}
sub V_CHECK_AND_LOG {1;}
sub V_LOG {2;}
sub V_LOG_PANIC {3;}
sub V_OK {4;}
sub V_ERROR {5;}
sub V_BAD_OP_CODE {6;}

$v_pkt = 'n n n n N a* x a* x a* x a* x a* x';
	#
	# struct v_pkt 
	# 	{
	# 	unsigned short protocol_version;
	# 	unsigned short packet_number;
	# 	unsigned short number_of_packets;
	# 	unsigned short op_code;
	# 	unsigned long  seq;
	# 	char data[V_MAXDATA];   /* buffer of null delimited strings */
	# 	};
	#
	# struct v_info 
	# 	{
	# 	char *appl_name; /* Typically, these are pointers into */
	# 	char *appl_vers; /* a struct v_pkt's */
	# 	char *platform;  /* data field (and are null-terminated strings) */
	# 	char *status;    /* status of this version */
	# 			 /* this string should be length 1, eg, V_OPTIONAL */
	# 	char *message;
	# 	};
$packet = pack($v_pkt, 1, 1, 1, &V_CHECK, time,
	       "Version Server Poller",
	       "1.0a1",
	       "Unix",
	       "?",
	       "This is a test of the version service");


sub TIMEOUT {
    if ($toutcount < 4) {
	send (SOCK, $packet, 0, $sendaddr) || &ERROR ("send: $!");
	if ($toutcount) {
	    print "(timeout)\n";
	}				
	$toutcount++;
	alarm(5);
    } else {
	&MAIL ($error, "Subject: Version server timeout\n\nThe version server isn't talking to me.");
	&ADDLOG ("The version server is not responding.");
	exit 1;
    }
}

$SIG{'ALRM'} = 'TIMEOUT';
$toutcount = 0;
$ok = 0;
&TIMEOUT;

do {
    if (recv (SOCK, $reply, 1000, 0)) {
	$ok = 1;
    }
} until ($! != &EINTR || $ok);

if ($ok) {
    &ADDLOG ("Version server is up and running.");
    close SOCK;
} else {
    &ERROR ("recv: $!");
}