%TITLE	'JNET_LINKWATCH'
MODULE JNET_LINKWATCH (MAIN = main, IDENT = '01-003') = 
BEGIN
!
!  Copyright 1991 by Hunter Goatley.  This code may be freely distributed
!  and modified for non-commercial purposes as long as this copyright notice
!  is retained.
!
!++
!
!  Facility:	JNET_LINKWATCH
!
!  Author:	Hunter Goatley
!		Academic Computing, STH 226
!		Western Kentucky University
!		Bowling Green, KY 42101
!		E-mail: goathunter@WKUVX1.BITNET
!		Voice:  (502) 745-5251
!
!  Date:	July 15, 1991
!
!  Functional Description:
!
!	This program uses the Jnet API to establish that the link to a
!	remote node is connected and not hung.  It does this by sending
!	a message to the remote system and waiting for a response back
!	from the system.  The command to be sent should cause the remote
!	node to return only one response.
!
!	Requires HG_SEND_MAIL.B32.
!
!	To build:
!
!		$ BLISS JNET_LINKWATCH,HG_SEND_MAIL
!		$ LINK/NOTRACE JNET_LINKWATCH,HG_SEND_MAIL,SYS$INPUT/OPTIONS
!		JANSHR/SHARE
!		^Z
!		$ RUN/DETACH JNET_LINKWATCH
!
!  Modified by:
!
!	01-003		Hunter Goatley		 5-AUG-1991 08:23
!		Modified query_remote_node so that Jnet error messages
!		from JAN_SEND_MSG are included in the alarm.  Previously,
!		Jnet errors were ignored (pretty stupid of me....).
!
!	01-002		Hunter Goatley		21-JUL-1991 13:27
!		After releasing 01-001 to the world, discovered that it
!		wouldn't send mail because SYS$SCRATCH wasn't defined.
!		Updated HG_SEND_MAIL and its call here.  JAN_TMPSYS: is
!		used as SYS$SCRATCH.  Also modified so that INIT is called
!		during each cycle so that the logicals can be changed
!		without having to restart JNET_LINKWATCH.
!
!	01-001		Hunter Goatley		18-JUL-1991 17:20
!		After releasing to the world:
!		1.  Added ability to send mail message in addition
!		    to OPCOM alarm.
!		2.  Fixed bug in QUERY_REMOTE_NODE that was keeping
!		    a response from another system from being included
!		    in the alarm message.
!		3.  Removed bells from message texts.
!		4.  Removed unneeded JAN_RECEIVE_MSG loop in QUERY_REMOTE_NODE.
!
!	01-000		Hunter Goatley		15-JUL-1991 14:15
!		Original version.
!
!--
!
!  LIBRARIES
!
LIBRARY 'SYS$LIBRARY:STARLET';			!Pull stuff from STARLET
SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE);

LINKAGE
	local_jsb	= JSB (REGISTER=0),
	str_copy_dx_link= JSB (REGISTER=0, REGISTER=1) :
				NOPRESERVE (2,3,4,5,6,7,8),
	str_copy_r_link	= JSB (REGISTER=0,REGISTER=1,REGISTER=2) :
                                NOPRESERVE (3,4,5,6,7,8);

!
!  TABLE OF CONTENTS
!
FORWARD ROUTINE
	main,					!Main entry point
	init,					!Initialize via logicals
	query_remote_node,			!Send query to remote node
	send_alarm : local_jsb			!Send an OPCOM alarm
	;
!
!  EXTERNAL ROUTINES CALLED
!
EXTERNAL ROUTINE
	hg_send_mail,				!Send mail message to users
	JAN_HOOK_INIT,				!Initialize Jnet hook
	JAN_RECEIVE_MSG,			!Receive a message from node
	JAN_SEND_MSG,				!Send a message to node
	LIB$PUT_OUTPUT,				!Write to SYS$OUTPUT
	STR$COPY_DX_R8	: str_copy_dx_link,	!Copy string to string
	STR$COPY_R_R8	: str_copy_r_link	!Copy buffer to descriptor
	;
!
!  MACROS
!
MACRO
	errchk(status) =
		IF NOT(.status) THEN RETURN (.status)%;

MACRO					!Static and dynamic descriptor macros
	$DYNDESC =			!Dynamic descriptor declaration
		$BBLOCK[DSC$C_S_BLN]
		PRESET	([DSC$W_LENGTH] = 0,
			 [DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			 [DSC$B_CLASS]	= DSC$K_CLASS_D,
			 [DSC$A_POINTER]= 0)
	%,
	$STATICDESC (len, addr) =	!Static descriptor declaration
		$BBLOCK[DSC$C_S_BLN]
		PRESET	([DSC$W_LENGTH] = len,
			 [DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			 [DSC$B_CLASS]	= DSC$K_CLASS_S,
			 [DSC$A_POINTER]= addr)
	%;

MACRO
	log_msg (msg) =
	BEGIN
	BIND
	   msg_fao = %ASCID %STRING('!%D  ',msg);
	faoout[DSC$W_LENGTH] = 256;
	status = $FAO (msg_fao, faoout, faoout, 0, %REMAINING);
	errchk(status);
	LIB$PUT_OUTPUT (faoout);
	END%;

%SBTTL	'Global variables';
!
!  The logical names to use
!
BIND
	remote_nodes_logical	= %ASCID'JNET_LW_NODES',
	jnet_hook_logical	= %ASCID'JNET_LW_HOOK',
	cycle_time_logical	= %ASCID'JNET_LW_CYCLE',
	delay_time_logical	= %ASCID'JNET_LW_DELAY',
	remote_cmd_logical	= %ASCID'JNET_LW_RCMD',
	prcnam_logical		= %ASCID'JNET_LW_PRCNAM',
	mail_logical		= %ASCID'JNET_LW_MAIL_USERS',
	lnm$dcl_logical		= %ASCID'LNM$DCL_LOGICAL';
!
!  The appropriate defaults
!
BIND
	default_cycle_time	= %ASCID'0 00:30:00',
	default_delay_time	= %ASCID'0 00:00:30',
	default_remote_cmd	= %ASCID'CPQ U OPERATOR',
	default_prcnam		= %ASCID'Jnet LinkWatch';

LITERAL
	true	= 1,
	false	= 0;

OWN
	global_prcnam	: $DYNDESC,
	mail_users	: $DYNDESC,
	faoout_buff	: $BBLOCK[256],
	faoout		: $STATICDESC (256, faoout_buff),
	from_user_buff	: $BBLOCK[8],
	from_user	: $STATICDESC (8, from_user_buff),
	from_node_buff	: $BBLOCK[8],
	from_node	: $STATICDESC (8, from_node_buff),
	message_buff	: $BBLOCK[100],
	message		: $STATICDESC (99, message_buff),
	message_len	: UNSIGNED LONG,
	mode		: UNSIGNED LONG
	;


%SBTTL	'MAIN';
ROUTINE main =
BEGIN
!+
!
!  Routine:	MAIN
!
!  Functional description:
!
!	This is the main routine for JNET_LINKWATCH.  It controls the watch
!	cycle.
!
!  Formal parameters:
!
!	None.
!
!-
OWN
	cmd_wait	: VECTOR[2,LONG],
	cmd_delay	: VECTOR[2,LONG],
	remote_nodes	: $DYNDESC,
	jnet_hook_name	: $DYNDESC,
	cycle_time	: $DYNDESC,
	delay_time	: $DYNDESC,
	remote_cmd	: $DYNDESC,
	remote_node	: $STATICDESC (0, 0),
	rnode_len	: UNSIGNED LONG,
	rnode_ptr	: REF $BBLOCK,
	working_set	: UNSIGNED LONG,
	jan_receive_flag: UNSIGNED LONG
	;

REGISTER
	status	: UNSIGNED LONG;

  !
  !  Get all of the needed information.
  !
  status = init (remote_nodes, jnet_hook_name, cycle_time, delay_time,
			remote_cmd, global_prcnam, mail_users);
  errchk(status);

  status = $SETPRN (PRCNAM = global_prcnam);

  !
  !  Create the temporary Jnet hook.  Our name is whatever local hook name is.
  !
  status = JAN_HOOK_INIT(%REF(2), jnet_hook_name);
  errchk(status);

  WHILE true DO
    BEGIN
    !
    !  Get our binary times.
    !
    status = $BINTIM (TIMBUF = delay_time, TIMADR = cmd_wait);
    errchk(status);
    status = $BINTIM (TIMBUF = cycle_time, TIMADR = cmd_delay);
    errchk(status);
    !
    !  remote_nodes is a dynamic string descriptor, so play with it
    !
    rnode_ptr = .remote_nodes[DSC$A_POINTER];		!Point to list of nodes
    rnode_len = .remote_nodes[DSC$W_LENGTH];		!Get the length

    !
    !  Loop through all of the remote nodes and query each one.  If there
    !  are multiple nodes, they should be separated by commas.
    !
    WHILE (.rnode_len GTRU 0) DO			!While there are more
	BEGIN						!...  nodes to check...
	LOCAL	temp : REF $BBLOCK;
	remote_node[DSC$A_POINTER] = .rnode_ptr;
	temp = CH$FIND_CH (.rnode_len, .rnode_ptr, %C',');
	IF NOT(CH$FAIL(.temp))
	THEN
	   BEGIN
	   temp = CH$DIFF(.temp, .rnode_ptr);
	   remote_node[DSC$W_LENGTH] = .temp;
	   rnode_ptr = (.rnode_ptr) + (.temp) + 1;
	   rnode_len = (.rnode_len) - (.temp) - 1;
	   END
	ELSE
	   BEGIN
	   remote_node[DSC$W_LENGTH] = .rnode_len;
	   rnode_len = 0;
	   END;
	IF (.remote_node[DSC$W_LENGTH] GTRU 8)
	THEN
	   remote_node[DSC$W_LENGTH] = 8;
	CH$FILL (0, 100, message_buff);
	query_remote_node (remote_node, remote_cmd, cmd_wait);
    END;

    status = $SETPRN (PRCNAM = global_prcnam);
    status = $ADJWSL (PAGCNT = 0, WSETLM = working_set);!Purge working set
    status = $ADJWSL (PAGCNT = (300 - .working_set));	!Purge working set
    status = $SCHDWK (DAYTIM=cmd_delay);		!Wait 10 minutes
    DO BEGIN
      jan_receive_flag = 0;			!Spurious message flag
      log_msg ('Zzzzzzzz....');
      status = $HIBER;				!...
      !
      !  We've awakened.  See if it's in response to some Jnet message or if
      !  it's because we timed out.  If any messages are received, they're
      !  spurious messages---just ignore them and go back to sleep.
      !
      WHILE (JAN_RECEIVE_MSG (mode, from_node, from_user, message,
				message_len))
      DO jan_receive_flag = .jan_receive_flag + 1;
    END WHILE (.jan_receive_flag GTRU 0);

    !
    !  Redo the initialization in case any of the logicals were changed
    !  since the last cycle.
    !
    status = init (remote_nodes, jnet_hook_name, cycle_time, delay_time,
			remote_cmd, global_prcnam, mail_users);
    errchk(status);
    END;					!And do it again

RETURN (.status);				!Set success status
END;						!End of routine


%SBTTL	'INIT';
ROUTINE init (remote_nodes_a, jnet_hook_name_a, cycle_time_a, delay_time_a,
		remote_cmd_a, prcnam_a, mail_a) =
BEGIN
!+
!
!  Routine:	INIT
!
!  Functional description:
!
!	This routine translates the various logicals and returns either the
!	specified or default values.
!
!  Formal parameters:
!
!	remote_nodes_a	- Address of descriptor to receive list of remote nodes
!	jnet_hook_name_a- Address of descriptor to receive Jnet hook name
!	cycle_time_a	- Address of descriptor to receive cycle time
!	delay_time_a	- Address of descriptor to receive delay time
!	remote_cmd_a	- Address of descriptor to receive command to send
!	prcnam_a	- Address of descriptor to receive detached process name
!	mail_a		- Address of descriptor to receive mail users
!
!  Returns:
!
!	R0	- Status
!
!-
BIND
	remote_nodes	= .remote_nodes_a	: $BBLOCK,
	jnet_hook_name	= .jnet_hook_name_a	: $BBLOCK,
	cycle_time	= .cycle_time_a		: $BBLOCK,
	delay_time	= .delay_time_a		: $BBLOCK,
	remote_cmd	= .remote_cmd_a		: $BBLOCK,
	prcnam		= .prcnam_a		: $BBLOCK,
	mail		= .mail_a		: $BBLOCK;

OWN
	trnlnm_buffer	: $BBLOCK[LNM$C_NAMLENGTH],
	trnlnm_retlen	: UNSIGNED LONG,
	trnlnm_itmlst	: $ITMLST_DECL (ITEMS=1)
	;

REGISTER
	status		: UNSIGNED LONG;

  $ITMLST_INIT (ITMLST=trnlnm_itmlst,
	(ITMCOD = LNM$_STRING,
	 BUFSIZ = LNM$C_NAMLENGTH,
	 BUFADR = trnlnm_buffer,
	 RETLEN = trnlnm_retlen)
	);

  !
  !  Get list of remote nodes to check.  No default---return an error.
  !
  status = $TRNLNM (TABNAM = lnm$dcl_logical,
		    LOGNAM = remote_nodes_logical,
		    ITMLST = trnlnm_itmlst);
  errchk(status);					!Return any error
  status = STR$COPY_R_R8 (remote_nodes, .trnlnm_retlen, trnlnm_buffer);

  !
  !  Get the Jnet hook name (default is LNKWATCH).
  !
  status = $TRNLNM (TABNAM = lnm$dcl_logical,
		    LOGNAM = jnet_hook_logical,
		    ITMLST = trnlnm_itmlst);
  IF NOT(.status)
  THEN
	status = STR$COPY_DX_R8 (jnet_hook_name, %ASCID'LNKWATCH')
  ELSE
     BEGIN
     IF (.trnlnm_retlen GTRU 8)
     THEN
	trnlnm_retlen = 8;
     status = STR$COPY_R_R8 (jnet_hook_name, .trnlnm_retlen, trnlnm_buffer);
     END;

  !
  !  Get the cycle time between checks.
  !
  status = $TRNLNM (TABNAM = lnm$dcl_logical,
		    LOGNAM = cycle_time_logical,
		    ITMLST = trnlnm_itmlst);
  IF (.status)
  THEN
     status = STR$COPY_R_R8 (cycle_time, .trnlnm_retlen, trnlnm_buffer)
  ELSE
     status = STR$COPY_DX_R8 (cycle_time, default_cycle_time);

  !
  !  Get the delay time to wait for a response.
  !
  status = $TRNLNM (TABNAM = lnm$dcl_logical,
		    LOGNAM = delay_time_logical,
		    ITMLST = trnlnm_itmlst);
  IF (.status)
  THEN
     status = STR$COPY_R_R8 (delay_time, .trnlnm_retlen, trnlnm_buffer)
  ELSE
     status = STR$COPY_DX_R8 (delay_time, default_delay_time);

  !
  !  Get the command to send to the remote system.
  !
  status = $TRNLNM (TABNAM = lnm$dcl_logical,
		    LOGNAM = remote_cmd_logical,
		    ITMLST = trnlnm_itmlst);
  IF (.status)
  THEN
     status = STR$COPY_R_R8 (remote_cmd, .trnlnm_retlen, trnlnm_buffer)
  ELSE
     status = STR$COPY_DX_R8 (remote_cmd, default_remote_cmd);

  !
  !  Get the list of users to notify via mail if something goes down.
  !
  status = $TRNLNM (TABNAM = lnm$dcl_logical,
		    LOGNAM = mail_logical,
		    ITMLST = trnlnm_itmlst);
  IF (.status)
  THEN
     status = STR$COPY_R_R8 (mail, .trnlnm_retlen, trnlnm_buffer);

  !
  !  Get the process name to use between cycles....
  !
  status = $TRNLNM (TABNAM = lnm$dcl_logical,
		    LOGNAM = prcnam_logical,
		    ITMLST = trnlnm_itmlst);
  IF (.status)
  THEN
     status = STR$COPY_R_R8 (prcnam, .trnlnm_retlen, trnlnm_buffer)
  ELSE
     status = STR$COPY_DX_R8 (prcnam, default_prcnam);

  RETURN(.status);

END;

%SBTTL	'QUERY_REMOTE_NODE';
ROUTINE query_remote_node (rnode_a, rcmd_a, wait_a) =
BEGIN
!+
!
!  Routine:	QUERY_REMOTE_NODE
!
!  Functional description:
!
!	This routine calls Jnet to send a query to a remote node and wait
!	for a response.  If no response is received within the designated
!	timeout, a NETWORK class OPCOM alarm is generated.
!
!  Formal parameters:
!
!	rnode_a		- Address of descriptor for remote node name
!	rcmd_a		- Address of descriptor for command to send to rnode
!	wait_a		- Address of quadword containing the binary timeout
!
!  Implicit inputs:
!
!	faoout_buff, faoout, from_user_buff, from_user, from_node_buff,
!	from_node, message_buff, message, message_len, mode,
!	mail_users, global_prcnam
!
!  Returns:
!
!	R0		- Status
!
!-
BIND
	rnode	= .rnode_a	: $BBLOCK,
	rcmd	= .rcmd_a	: $BBLOCK,
	wait	= .wait_a	: VECTOR[2,LONG];

BIND
	no_remote_response = %ASCID %STRING(
	'No response detected from BITNET node !AS -- check the link ',
	'status!/!AS'),
	unknown_remote_error =
	%ASCID'Error querying BITNET node !AS!/(!AS) - !AD';

OWN
	errmsg_buff	: $BBLOCK[256],
	errmsg		: $STATICDESC (256, errmsg_buff),
	errmsg_len	: UNSIGNED LONG,
	prcnam_buff	: $BBLOCK[16],
	prcnam		: $STATICDESC (16, prcnam_buff),
	unkerr_buff	: $BBLOCK[256],
	unkerr		: $STATICDESC (256, unkerr_buff),
	remote_status	: UNSIGNED LONG
	;

REGISTER
	status	: UNSIGNED LONG;

  prcnam[DSC$W_LENGTH] = 16;				!Reset prcnam length
  status = $FAO (%ASCID'Path->!AS', prcnam, prcnam, rnode);
  IF (.status)
  THEN
      status = $SETPRN (PRCNAM = prcnam);

  log_msg ('Sending message to !AS....', rnode);
  status = JAN_SEND_MSG (%REF(0), rnode, $DESCRIPTOR(''), rcmd);

  IF (.status)						!If status is OK
  THEN
     BEGIN
     status = $SCHDWK (DAYTIM=wait);			!Wait 30 seconds
     status = $HIBER;					!Sleep....
     status = $CANWAK();				!Cancel the timeout
     status = JAN_RECEIVE_MSG (mode, from_node, from_user, message,
				message_len);
     END;

  IF (.status)
  THEN
     remote_status = (IF CH$EQL(.rnode, .(rnode+4),
				.from_node, .(from_node+4), %C' ')
		      THEN
			   true
		      ELSE
			   false)
  ELSE
     remote_status = false;

  IF NOT(.remote_status)			!Timed out
  THEN
     BEGIN
     faoout[DSC$W_LENGTH] = 256;		!Reset FAO output buffer desc.
     IF NOT(.status)				!If no response at all....
     THEN
	BEGIN
	status = $GETMSG (MSGID	 = .status,	!Get the error message text
			  MSGLEN = errmsg,
			  BUFADR = errmsg);
	status = $FAO (no_remote_response, faoout, faoout, rnode, errmsg);
	END
     ELSE					!Response from some other node
	status = $FAO (unknown_remote_error, faoout, faoout, rnode, from_node,
				.message_len, message_buff);

      status = send_alarm (faoout);
      status = hg_send_mail (mail_users, faoout, 0, %ASCID'Jnet link failure',
				global_prcnam, %ASCID'JAN_TMPSYS:', %B'10');
!     $BRKTHRUW (MSGBUF = faoout,
!		SENDTO = $DESCRIPTOR('OPA0:'),
!		SNDTYP = BRK$C_DEVICE
!		);
     LIB$PUT_OUTPUT (faoout);
     END
  ELSE
     log_msg ('Received message from !AS....', rnode);

RETURN (SS$_NORMAL);				!Set success status
END;						!End of routine


%SBTTL	'SEND_ALARM';
ROUTINE send_alarm (msg_a) : local_jsb =
BEGIN
!+
!
!  Routine:	SEND_ALARM
!
!  Functional description:
!
!	This routine formats a NETWORK alarm and sends it to OPCOM.
!
!  Formal parameters:
!
!	msg_a		- Address of descriptor for message text
!
!  Returns:
!
!	R0		- $SNDOPR Status
!
!-
BIND
	msg	= .msg_a	: $BBLOCK;

LOCAL
	alarm_msg_buff	: $BBLOCK[256+8]
		INITIAL	(BYTE(OPC$_RQ_RQST),		!Operator request
			 WORD(OPC$M_NM_NTWORK),		!NETWORK is the class
			 BYTE(0),			!Spare
			 LONG(0)			!OPC$L_MS_RQSTID is null
			),
	alarm_msg	: $STATICDESC (256+8, alarm_msg_buff)
	;

  alarm_msg[DSC$W_LENGTH] = .msg[DSC$W_LENGTH] + 8;
  CH$MOVE(.msg[DSC$W_LENGTH], .msg[DSC$A_POINTER], alarm_msg_buff+8);

  RETURN ($SNDOPR (MSGBUF = alarm_msg));

END;

END						!End of module BEGIN
ELUDOM						!End of module