%TITLE 'WATCHER' MODULE WATCHER (IDENT='V2.9-1', MAIN=WATCHER) = BEGIN !++ ! FACILITY: WATCHER ! ! ABSTRACT: WATCHER main program. ! ! MODULE DESCRIPTION: ! ! WATCHER main module. ! ! AUTHOR: M. Madison ! COPYRIGHT © 1993, 1994 MADGOAT SOFTWARE. ALL RIGHTS RESERVED. ! ! CREATION DATE: 28-NOV-1989 ! ! MODIFICATION HISTORY: ! ! 28-NOV-1989 V1.0 Madison Initial coding. ! 15-MAR-1990 V2.0 Madison Complete initial coding, rename version. ! 21-MAR-1990 V2.0-1 Madison Start adding DECW support. ! 11-APR-1990 V2.1-2 Madison Add thresholds on measurements. ! 12-APR-1990 V2.1-3 Madison Fix identifier-checking bug. ! 16-APR-1990 V2.1-4 Madison (change in WCP) ! 20-APR-1990 V2.1-5 Madison (change to WATCHER_STARTUP) ! 27-APR-1990 V2.1-6 Madison Fix bug in device names w/no SCSNODE. ! 04-MAY-1990 V2.1-7 Madison Fix WCP bug. ! 05-JUL-1990 V2.1-8 Madison Fix underscore problem with WS devices. ! 10-JUL-1990 V2.1-9 Madison Fix stupid WCP bug. ! 17-OCT-1990 V2.2 Madison Fix count group check code. ! 31-OCT-1990 V2.2-1 Madison Fix bug in DECW_DISPLAY. ! 02-NOV-1990 V2.2-2 Madison Add TOD to logout messages (Ward@Harris) ! 12-NOV-1990 V2.2-3 Madison Add trace support to COLLECT. ! 13-NOV-1990 V2.3 Madison Don't barf on suspended processes. ! 03-JAN-1991 V2.4 Madison Can use JPI$_RIGHTSLIST w/VMS V5.4. ! 04-MAR-1991 V2.5 Madison Eliminate username compares in ct grp chks. ! 21-MAR-1991 V2.5-1 Madison Fix warning bug (mnk@hac.com) ! 25-MAR-1991 V2.6 Madison Multiwarn support; force chk precedes warn. ! 26-MAR-1991 V2.6-1 Madison Flush log & trace files (mnk@hac) ! 07-APR-1992 V2.7 Madison Add IMGNAM, NOACTION, MULTIWARN interval. ! 03-FEB-1993 V2.8 Madison Add /FORCE_EXIT support. ! 20-MAR-1993 V2.8-1 Madison Fixed support for forced image exits. ! 24-JUN-1994 V2.9 Madison Better handling of override transitions. ! 01-SEP-1994 V2.9-1 Madison Better handling of VMS version dependencies ! in the disconnect code. !-- LIBRARY 'SYS$LIBRARY:STARLET'; LIBRARY 'WATCHER'; LIBRARY 'WATCHER_PRIVATE'; PSECT NODEFAULT = $$$COPYRIGHT (READ,NOWRITE,NOEXECUTE,SHARE); OWN COPYRIGHT : INITIAL (UPLIT PSECT ($$$COPYRIGHT) BYTE ('Copyright © 1993, 1994 MadGoat Software. All rights reserved.')); FORWARD ROUTINE WATCHER, INIT : NOVALUE, EXCLOVER, ON_COUNT_LIST, WATCHING, CHANGED, UPDATE_COUNTER_FOR_OVERRIDE : NOVALUE, CHECK_MBOX : NOVALUE, MBX_AST, EXIT_HANDLER; EXTERNAL ROUTINE COLLECT_PROCESS_INFO, LOAD_CONFIG, WARN, FORCE, FLUSH_LOG, LOCK_DISCONNECT_CODE, G_HAT (LIB$GET_VM, LIB$FREE_VM, LIB$SUB_TIMES, LIB$DAY_OF_WEEK, STR$MATCH_WILD, LIB$GET_EF); EXTERNAL LITERAL STR$_MATCH, LIB$_NORMAL, WATCHER__NOCFG; GLOBAL GLOBALS : GBLDEF, PGLOBALS : PGBLDEF, TRMQUE : QUEDEF, EXCQUE : QUEDEF, OVRQUE : QUEDEF; OWN COUNTQ : QUEDEF, NOWTIME : BLOCK [8,BYTE], MBXCHN : WORD INITIAL (0), MBXEFN, SETAST : INITIAL (0), FINAL_STATUS, EXHBLK : VECTOR [4,LONG] PRESET ( [1] = EXIT_HANDLER, [2] = 1, [3] = FINAL_STATUS); %SBTTL 'WATCHER' GLOBAL ROUTINE WATCHER = BEGIN !++ ! FUNCTIONAL DESCRIPTION: ! ! WATCHER main program. ! ! RETURNS: cond_value, longword (unsigned), write only, by value ! ! PROTOTYPE: ! ! WATCHER ! ! IMPLICIT INPUTS: None. ! ! IMPLICIT OUTPUTS: None. ! ! COMPLETION CODES: ! ! SS$_NORMAL: normal successful completion. ! ! SIDE EFFECTS: ! ! None. !-- LOCAL PINFOQ : QUEDEF, CHKQUE : QUEDEF, CHK : REF CHKDEF, P : REF PRCDEF, C : REF CTRDEF, IP : REF IDDEF, DELTA : BLOCK [8,BYTE], DIFF : BLOCK [8,BYTE], STATUS; INIT_QUEUE (PINFOQ, CHKQUE); !+ ! Make sure the virtual-terminal disconnect code ! is locked down (it executes at high IPL !- STATUS = LOCK_DISCONNECT_CODE (); IF NOT .STATUS THEN SIGNAL_STOP (.STATUS); INIT (); WHILE 1 DO BEGIN TRACE (DBG_M_MAIN, '*** Checking mailbox ***'); CHECK_MBOX (); C = .COUNTQ [QUE_L_HEAD]; WHILE .C NEQA COUNTQ [QUE_L_HEAD] DO BEGIN C [CTR_V_VALID] = 0; C = .C [CTR_L_FLINK]; END; $GETTIM (TIMADR=NOWTIME); TRACE (DBG_M_MAIN, '*** Collecting process information at !%D ***', NOWTIME); COLLECT_PROCESS_INFO (PINFOQ); WHILE NOT REMQUE (.PINFOQ [QUE_L_HEAD], P) DO BEGIN TRACE (DBG_M_MAIN, 'Process: PID=!XL, user=!AD, term=!AD, accpor=!AD', .P [PRC_L_PID], .P [PRC_W_USRLEN], P [PRC_T_USRNAM], .P [PRC_W_DEVLEN], P [PRC_T_DEVNAM], .P [PRC_W_ACCLEN], P [PRC_T_ACCNAM]); IF NOT EXCLOVER (.P, EXCQUE) THEN BEGIN STATUS = ON_COUNT_LIST (.P, C); IF .STATUS THEN BEGIN LOCAL OVR : REF EXCDEF; TRACE (DBG_M_MAIN, ' -- Process found on count list'); IF EXCLOVER (.P, OVRQUE, OVR) THEN BEGIN IF .C [CTR_A_OVERRIDE] NEQA .OVR THEN UPDATE_COUNTER_FOR_OVERRIDE (.C, .OVR); END ELSE IF .C [CTR_A_OVERRIDE] NEQA 0 THEN UPDATE_COUNTER_FOR_OVERRIDE (.C, 0); END ELSE BEGIN STATUS = WATCHING (.P, C); IF .STATUS THEN TRACE (DBG_M_MAIN, ' -- Terminal found on watch list'); END; IF .STATUS THEN IF NOT CHANGED (.P, .C) THEN BEGIN TRACE (DBG_M_MAIN, ' -- Queueing count record for checking'); LIB$GET_VM (%REF (CHK_S_CHKDEF), CHK); CHK [CHK_L_CREC] = .C; INSQUE (.CHK, .CHKQUE [QUE_L_TAIL]); END ELSE IF .C [CTR_V_FAKE] THEN TRACE (DBG_M_MAIN, ' -- This was a "fake" process'); END ELSE BEGIN !+ ! If this process has transitioned from the count list to the ! exclusion list, let's remove it from the count list now. !- TRACE (DBG_M_MAIN, ' -- Process found on exclude list'); IF ON_COUNT_LIST (.P, C) THEN BEGIN REMQUE (.C, C); LIB$FREE_VM (%REF (CTR_S_CTRDEF), C); END; END; IP = .P [PRC_A_IDLIST]; WHILE .IP NEQA 0 DO BEGIN LOCAL TMP; TMP = .IP [ID_L_FLINK]; LIB$FREE_VM (%REF (ID_S_IDDEF), IP); IP = .TMP; END; LIB$FREE_VM (%REF (PRC_S_PRCDEF), P); END; TRACE (DBG_M_MAIN, '*** End of process loop ***'); WHILE NOT REMQUE (.CHKQUE [QUE_L_HEAD], CHK) DO BEGIN BIND CTR = .CHK [CHK_L_CREC] : CTRDEF; LOCAL DOCHK; TRACE (DBG_M_MAIN, 'Check for warn/force: PID=!XL, user=!AD', .CTR [CTR_L_PID], .CTR [CTR_W_USRLEN], CTR [CTR_T_USRNAM]); DOCHK = NOT .CTR [CTR_V_FAKE]; IF .CTR [CTR_W_GRPLEN] GTR 0 AND NOT .CTR [CTR_V_FAKE] THEN BEGIN LOCAL C : REF CTRDEF; TRACE (DBG_M_MAIN, ' -- Terminal is part of count group !AD', .CTR [CTR_W_GRPLEN], CTR [CTR_T_GRPNAM]); C = .COUNTQ [QUE_L_HEAD]; WHILE .C NEQA COUNTQ DO BEGIN IF CH$EQL (.C [CTR_W_GRPLEN], C [CTR_T_GRPNAM], .CTR [CTR_W_GRPLEN], CTR [CTR_T_GRPNAM], %C' ') THEN IF .C [CTR_V_VALID] AND NOT .C [CTR_V_FAKE] AND .C [CTR_V_CHANGED] THEN EXITLOOP; C = .C [CTR_L_FLINK]; END; DOCHK = .C EQLA COUNTQ; IF NOT .DOCHK THEN TRACE (DBG_M_MAIN, ' -- Warn/force aborted, !AD in group !AD changed.', .C [CTR_W_DEVLEN], C [CTR_T_DEVNAM], .C [CTR_W_GRPLEN], C [CTR_T_GRPNAM]); END; IF .DOCHK THEN BEGIN LIB$SUB_TIMES (NOWTIME, CTR [CTR_Q_LASTCHG], DELTA); IF .CTR [CTR_V_FORCE] OR .CTR [CTR_V_DISCON] OR .CTR [CTR_V_EXIT] THEN BEGIN TRACE (DBG_M_MAIN, ' -- Force check: Is !%T GTR !%T?', DELTA, CTR [CTR_Q_FORCETIME]); IF LIB$SUB_TIMES (DELTA, CTR [CTR_Q_FORCETIME], DIFF) EQL LIB$_NORMAL THEN BEGIN LOCAL C : REF CTRDEF, D : BLOCK [8,BYTE]; IF .CTR [CTR_W_GRPLEN] GTR 0 THEN BEGIN TRACE (DBG_M_MAIN, ' -- also check count group members...'); C = .COUNTQ [QUE_L_HEAD]; WHILE .C NEQA COUNTQ DO BEGIN IF CH$EQL (.C [CTR_W_GRPLEN], C [CTR_T_GRPNAM], .CTR [CTR_W_GRPLEN], CTR [CTR_T_GRPNAM], %C' ') AND (.C [CTR_V_FORCE] OR .C [CTR_V_DISCON] OR .C [CTR_V_EXIT]) AND NOT .C [CTR_V_FAKE] THEN BEGIN LIB$SUB_TIMES (NOWTIME, C [CTR_Q_LASTCHG], D); IF LIB$SUB_TIMES (D, C [CTR_Q_FORCETIME], DIFF) NEQ LIB$_NORMAL THEN EXITLOOP; END; C = .C [CTR_L_FLINK]; END; IF .C EQLA COUNTQ THEN BEGIN FORCE (CTR, CHKQUE, COUNTQ); TRACE (DBG_M_MAIN, ' -- Terminal forced.'); END ELSE TRACE (DBG_M_MAIN, ' -- Don''t force: pid !XL changed at !%D', .C [CTR_L_PID], C [CTR_Q_LASTCHG]); END ELSE BEGIN FORCE (CTR, CHKQUE, COUNTQ); TRACE (DBG_M_MAIN, ' -- Terminal forced.'); END; END; END; IF NOT .CTR [CTR_V_WARNED] AND .CTR [CTR_V_WARN] THEN BEGIN TRACE (DBG_M_MAIN, ' -- Warn check: Is !%T GTR !%T?', DELTA, CTR [CTR_Q_WARNTIME]); IF LIB$SUB_TIMES (DELTA, CTR [CTR_Q_WARNTIME], DIFF) EQL LIB$_NORMAL THEN BEGIN LOCAL C : REF CTRDEF, D : BLOCK [8,BYTE]; IF .CTR [CTR_W_GRPLEN] GTR 0 THEN BEGIN TRACE (DBG_M_MAIN, ' -- also check count group members...'); C = .COUNTQ [QUE_L_HEAD]; WHILE .C NEQA COUNTQ DO BEGIN IF CH$EQL (.C [CTR_W_GRPLEN], C [CTR_T_GRPNAM], .CTR [CTR_W_GRPLEN], CTR [CTR_T_GRPNAM], %C' ') AND .C [CTR_V_WARN] THEN BEGIN LIB$SUB_TIMES (NOWTIME, C [CTR_Q_LASTCHG], D); IF LIB$SUB_TIMES (D, C [CTR_Q_WARNTIME], DIFF) NEQ LIB$_NORMAL THEN EXITLOOP; END; C = .C [CTR_L_FLINK]; END; IF .C EQLA COUNTQ THEN BEGIN WARN (CTR); TRACE (DBG_M_MAIN, ' -- Terminal warned.'); END ELSE TRACE (DBG_M_MAIN, ' -- Don''t warn: pid !XL changed at !%D', .C [CTR_L_PID], C [CTR_Q_LASTCHG]); END ELSE BEGIN WARN (CTR); TRACE (DBG_M_MAIN, ' -- Terminal warned.'); END; END; END; END; LIB$FREE_VM (%REF (CHK_S_CHKDEF), CHK); END; TRACE (DBG_M_MAIN, '*** End of warn/force checks ***'); C = .COUNTQ [QUE_L_HEAD]; WHILE .C NEQA COUNTQ [QUE_L_HEAD] DO BEGIN LOCAL TMP; TMP = .C [CTR_L_FLINK]; IF NOT .C [CTR_V_VALID] THEN BEGIN REMQUE (.C, C); LIB$FREE_VM (%REF (CTR_S_CTRDEF), C); END; C = .TMP; END; TRACE (DBG_M_MAIN, '*** About to sleep, interval=!%T ***', GLOBALS [GBL_Q_INTERVAL]); FLUSH_LOG (); $SCHDWK (DAYTIM=GLOBALS [GBL_Q_INTERVAL]); $HIBER; $CANWAK (); TRACE (DBG_M_MAIN, '*** Wake up!! ***'); END; SS$_NORMAL END; ! WATCHER %SBTTL 'INIT' ROUTINE INIT : NOVALUE = BEGIN !++ ! FUNCTIONAL DESCRIPTION: ! ! Initializes everything. ! ! RETURNS: no value ! ! PROTOTYPE: ! ! INIT ! ! IMPLICIT INPUTS: None. ! ! IMPLICIT OUTPUTS: None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. !-- EXTERNAL ROUTINE INIT_LOG; LOCAL IOSB : MIOSBDEF, SYILST : $ITMLST_DECL (ITEMS=2), VMSVER : ALIAS VECTOR [8,BYTE], VVLEN : ALIAS WORD, TEMP : ALIAS WORD, STATUS; CH$FILL (%CHAR (0), GBL_S_GBLDEF, GLOBALS); INIT_QUEUE (TRMQUE, OVRQUE, EXCQUE, COUNTQ); STATUS = LOAD_CONFIG (); IF NOT .STATUS THEN SIGNAL_STOP (WATCHER__NOCFG, 0, .STATUS); $ITMLST_INIT (ITMLST=SYILST, (ITMCOD=SYI$_VERSION, BUFSIZ=%ALLOCATION (VMSVER), BUFADR=VMSVER, RETLEN=VVLEN), (ITMCOD=SYI$_SCSNODE, BUFSIZ=PGBL_S_SCSNAM, BUFADR=PGLOBALS [PGBL_T_SCSNAM], RETLEN=TEMP)); $GETSYIW (ITMLST=SYILST); IF .TEMP GTR 0 THEN BEGIN LOCAL CP; CP = CH$FIND_CH (.TEMP, PGLOBALS [PGBL_T_SCSNAM], %C' '); IF NOT CH$FAIL (.CP) THEN TEMP = CH$DIFF (.CP, PGLOBALS [PGBL_T_SCSNAM]); END; PGLOBALS [PGBL_W_SCSLEN] = .TEMP; %IF %BLISS(BLISS32E) %THEN PGLOBALS [PGBL_V_VMSV52] = PGLOBALS [PGBL_V_VMSV54] = 1; %ELSE PGLOBALS [PGBL_V_VMSV52] = (IF .VVLEN GTR 0 THEN (.VMSVER [1] GTR %C'5' OR (.VMSVER [1] EQL %C'5' AND .VMSVER [3] GEQ %C'2')) ELSE 0); PGLOBALS [PGBL_V_VMSV54] = (IF .VVLEN GTR 0 THEN (.VMSVER [1] GTR %C'5' OR (.VMSVER [1] EQL %C'5' AND .VMSVER [3] GEQ %C'4')) ELSE 0); %FI INIT_LOG (); LOG ('WATCHER starting'); STATUS = $CREMBX (PRMFLG=1, CHAN=MBXCHN, PROMSK=%X'FF00', LOGNAM=%ASCID'WATCHER_MBOX'); IF NOT .STATUS THEN SIGNAL_STOP (.STATUS); LIB$GET_EF (MBXEFN); STATUS = $QIOW (EFN=.MBXEFN, CHAN=.MBXCHN, IOSB=IOSB, FUNC=IO$_SETMODE OR IO$M_WRTATTN, P1=MBX_AST); $DCLEXH (DESBLK=EXHBLK); END; ! INIT %SBTTL 'EXCLOVER' ROUTINE EXCLOVER (PRC_A, QUE_A, REC_A_A) = BEGIN !++ ! FUNCTIONAL DESCRIPTION: ! ! Searches either the exclusion queue or the override queue for a match. ! ! RETURNS: cond_value, longword (unsigned), write only, by value ! ! PROTOTYPE: ! ! EXCLOVER ! ! IMPLICIT INPUTS: None. ! ! IMPLICIT OUTPUTS: None. ! ! COMPLETION CODES: ! ! SS$_NORMAL: normal successful completion. ! ! SIDE EFFECTS: ! ! None. !-- BUILTIN ACTUALCOUNT; BIND P = .PRC_A : PRCDEF, QUE = .QUE_A : QUEDEF; LOCAL E : REF EXCDEF, S1 : BLOCK [DSC$K_S_BLN,BYTE], S2 : BLOCK [DSC$K_S_BLN,BYTE], NTIME : VECTOR [7,WORD], MATCH, TRCMSK, DOW; TRCMSK = (IF QUE EQLA OVRQUE THEN DBG_M_OVERRIDE ELSE DBG_M_EXCLUDE); TRACE (.TRCMSK, ' -- Searching !AS list...', (IF QUE EQLA OVRQUE THEN %ASCID'override' ELSE %ASCID'exclude')); $NUMTIM (TIMBUF=NTIME, TIMADR=NOWTIME); LIB$DAY_OF_WEEK (NOWTIME, DOW); S1 [DSC$B_DTYPE] = S2 [DSC$B_DTYPE] = DSC$K_DTYPE_T; S1 [DSC$B_CLASS] = S2 [DSC$B_CLASS] = DSC$K_CLASS_S; E = .QUE [QUE_L_HEAD]; WHILE .E NEQA QUE [QUE_L_HEAD] DO BEGIN S2 [DSC$A_POINTER] = E [EXC_T_UNAME]; S2 [DSC$W_LENGTH] = .E [EXC_W_UNAMELEN]; S1 [DSC$A_POINTER] = P [PRC_T_USRNAM]; S1 [DSC$W_LENGTH] = .P [PRC_W_USRLEN]; TRACE (.TRCMSK, ' -- Username: exclude=!AS, process=!AS', S2, S1); MATCH = STR$MATCH_WILD (S1, S2) EQL STR$_MATCH; IF .MATCH THEN BEGIN BIND U2 = E [EXC_L_UIC] : BLOCK [,BYTE], U1 = P [PRC_L_UIC] : BLOCK [,BYTE]; OWN WILDUIC : BLOCK [4,BYTE] PRESET ([0,0,32,0]=-1) PSECT ($PLIT$); TRACE (.TRCMSK, ' -- UIC: exclude=!%U, process=!%U', .E [EXC_L_UIC], .P [PRC_L_UIC]); MATCH = (.U2 [UIC$V_GROUP] EQL .WILDUIC [UIC$V_GROUP] OR .U2 [UIC$V_GROUP] EQL .U1 [UIC$V_GROUP]) AND (.U2 [UIC$V_MEMBER] EQL .WILDUIC [UIC$V_MEMBER] OR .U2 [UIC$V_MEMBER] EQL .U1 [UIC$V_MEMBER]); END; IF .MATCH THEN BEGIN BIND P1 = P [PRC_Q_PRIVS] : VECTOR [2,LONG], P2 = E [EXC_Q_PRIVMASK] : VECTOR [2,LONG]; TRACE (.TRCMSK, ' -- Privs: exclude=!XL !XL, process=!XL !XL', .P2 [1], .P2 [0], .P1 [1], .P1 [0]); MATCH = ((.P1 [0] AND .P2 [0]) EQLU .P2 [0]) AND ((.P1 [1] AND .P2 [1]) EQLU .P2 [1]); END; IF .MATCH THEN BEGIN S2 [DSC$A_POINTER] = E [EXC_T_TRMNAM]; S2 [DSC$W_LENGTH] = .E [EXC_W_TRMNAMLEN]; S1 [DSC$A_POINTER] = P [PRC_T_DEVNAM]; S1 [DSC$W_LENGTH] = .P [PRC_W_DEVLEN]; TRACE (.TRCMSK, ' -- Terminal: exclude=!AS, process=!AS', S2, S1); MATCH = STR$MATCH_WILD (S1, S2) EQL STR$_MATCH; END; IF .MATCH THEN BEGIN S2 [DSC$A_POINTER] = E [EXC_T_ACCNAM]; S2 [DSC$W_LENGTH] = .E [EXC_W_ACCNAMLEN]; S1 [DSC$A_POINTER] = P [PRC_T_ACCNAM]; S1 [DSC$W_LENGTH] = .P [PRC_W_ACCLEN]; TRACE (.TRCMSK, ' -- AccPor: exclude=!AS, process=!AS', S2, S1); MATCH = STR$MATCH_WILD (S1, S2) EQL STR$_MATCH; END; IF .MATCH THEN BEGIN S2 [DSC$A_POINTER] = E [EXC_T_IMGNAM]; S2 [DSC$W_LENGTH] = .E [EXC_W_IMGNAMLEN]; S1 [DSC$A_POINTER] = P [PRC_T_IMGNAM]; S1 [DSC$W_LENGTH] = .P [PRC_W_IMGLEN]; TRACE (.TRCMSK, ' -- Image: exclude=!AS, process=!AS', S2, S1); MATCH = STR$MATCH_WILD (S1, S2) EQL STR$_MATCH; END; IF .MATCH AND .GLOBALS [GBL_V_IDENTS] AND .E [EXC_L_IDENT] NEQA 0 THEN BEGIN LOCAL ID : REF IDDEF, M; TRACE (.TRCMSK, ' -- Comparing identifier lists...'); M = 0; ID = .P [PRC_A_IDLIST]; WHILE .ID NEQA 0 DO BEGIN BIND V = ID [ID_X_IDLIST] : VECTOR [,LONG]; INCR I FROM 0 TO .ID [ID_L_COUNT]-1 DO BEGIN IF .V [.I] EQL .E [EXC_L_IDENT] THEN BEGIN M = 1; TRACE (.TRCMSK, ' -- Found a match: !%I', .V [.I]); EXITLOOP; END; END; IF .M THEN EXITLOOP; ID = .ID [ID_L_FLINK]; END; MATCH = .M; IF NOT .M THEN TRACE (.TRCMSK, ' -- Did not find a match.'); END; IF .MATCH THEN BEGIN BIND EXCTIME = E [EXC_AL_TIMES] : BLOCK [7,LONG]; TRACE (.TRCMSK, ' -- Day/time matrix: DOW=!UL, Hour=!UL, match=!UL', .DOW, .NTIME[3], .EXCTIME [.DOW-1,.NTIME[3],1,0]); IF .EXCTIME [.DOW-1,.NTIME[3],1,0] THEN BEGIN IF ACTUALCOUNT () GTR 2 THEN .REC_A_A = .E; RETURN 1; END; END; E = .E [EXC_L_FLINK]; END; ! WHILE E TRACE (.TRCMSK, ' -- Exhausted list: no match.'); 0 END; ! EXCLOVER %SBTTL 'ON_COUNT_LIST' ROUTINE ON_COUNT_LIST (PRC_A, CTR_A_A) = BEGIN !++ ! FUNCTIONAL DESCRIPTION: ! ! Locates a terminal on the count list. ! ! RETURNS: cond_value, longword (unsigned), write only, by value ! ! PROTOTYPE: ! ! ON_COUNT_LIST prc, ctr ! ! IMPLICIT INPUTS: None. ! ! IMPLICIT OUTPUTS: None. ! ! COMPLETION CODES: ! ! SS$_NORMAL: normal successful completion. ! ! SIDE EFFECTS: ! ! None. !-- BIND PRC = .PRC_A : PRCDEF, CTR = .CTR_A_A : REF CTRDEF; LOCAL C : REF CTRDEF; C = .COUNTQ [QUE_L_HEAD]; WHILE .C NEQA COUNTQ [QUE_L_HEAD] DO BEGIN IF .PRC [PRC_L_PID] EQLU .C [CTR_L_PID] THEN IF CH$EQL (.PRC [PRC_W_DEVLEN], PRC [PRC_T_DEVNAM], .C [CTR_W_DEVLEN], C [CTR_T_DEVNAM], %C' ') AND CH$EQL (.PRC [PRC_W_ACCLEN], PRC [PRC_T_ACCNAM], .C [CTR_W_ACCLEN], C [CTR_T_ACCNAM], %C' ') AND CH$EQL (.PRC [PRC_W_USRLEN], PRC [PRC_T_USRNAM], .C [CTR_W_USRLEN], C [CTR_T_USRNAM]) THEN BEGIN CTR = .C; RETURN SS$_NORMAL; END; C = .C [CTR_L_FLINK]; END; 0 END; ! ON_COUNT_LIST %SBTTL 'WATCHING' ROUTINE WATCHING (PRC_A, CTR_A_A) = BEGIN !++ ! FUNCTIONAL DESCRIPTION: ! ! Checks to see if the terminal being used by a process is supposed ! to be watched. If so, a new CTR record is created and placed on ! the count list. ! ! RETURNS: cond_value, longword (unsigned), write only, by value ! ! PROTOTYPE: ! ! WATCHING prc, ctr ! ! IMPLICIT INPUTS: None. ! ! IMPLICIT OUTPUTS: None. ! ! COMPLETION CODES: ! ! SS$_NORMAL: normal successful completion. ! ! SIDE EFFECTS: ! ! None. !-- BIND PRC = .PRC_A : PRCDEF, CTR = .CTR_A_A : REF CTRDEF; LOCAL TRM : REF TRMDEF, OVR : REF EXCDEF, S1 : BLOCK [DSC$K_S_BLN,BYTE], S2 : BLOCK [DSC$K_S_BLN,BYTE]; S1 [DSC$B_DTYPE] = S2 [DSC$B_DTYPE] = DSC$K_DTYPE_T; S1 [DSC$B_CLASS] = S2 [DSC$B_CLASS] = DSC$K_CLASS_S; TRM = .TRMQUE [QUE_L_HEAD]; WHILE .TRM NEQA TRMQUE [QUE_L_HEAD] DO BEGIN S2 [DSC$A_POINTER] = TRM [TRM_T_DEVNAM]; S2 [DSC$W_LENGTH] = .TRM [TRM_W_DEVLEN]; S1 [DSC$A_POINTER] = PRC [PRC_T_DEVNAM]; S1 [DSC$W_LENGTH] = .PRC [PRC_W_DEVLEN]; IF STR$MATCH_WILD (S1, S2) EQL STR$_MATCH THEN BEGIN S2 [DSC$A_POINTER] = TRM [TRM_T_ACCNAM]; S2 [DSC$W_LENGTH] = .TRM [TRM_W_ACCLEN]; S1 [DSC$A_POINTER] = PRC [PRC_T_ACCNAM]; S1 [DSC$W_LENGTH] = .PRC [PRC_W_ACCLEN]; IF STR$MATCH_WILD (S1, S2) EQL STR$_MATCH THEN BEGIN LIB$GET_VM (%REF (CTR_S_CTRDEF), CTR); CH$FILL (%CHAR (0), CTR_S_CTRDEF, .CTR); CTR [CTR_L_PID] = .PRC [PRC_L_PID]; CTR [CTR_V_FAKE] = .PRC [PRC_V_FAKE]; CTR [CTR_V_DECW] = .PRC [PRC_V_DECW]; CTR [CTR_W_USRLEN] = .PRC [PRC_W_USRLEN]; CH$MOVE (.CTR [CTR_W_USRLEN], PRC [PRC_T_USRNAM], CTR [CTR_T_USRNAM]); CTR [CTR_W_DEVLEN] = .PRC [PRC_W_DEVLEN]; CH$MOVE (.CTR [CTR_W_DEVLEN], PRC [PRC_T_DEVNAM], CTR [CTR_T_DEVNAM]); CTR [CTR_W_ACCLEN] = .PRC [PRC_W_ACCLEN]; CH$MOVE (.CTR [CTR_W_ACCLEN], PRC [PRC_T_ACCNAM], CTR [CTR_T_ACCNAM]); CTR [CTR_W_IMGLEN] = .PRC [PRC_W_IMGLEN]; CH$MOVE (.CTR [CTR_W_IMGLEN], PRC [PRC_T_IMGNAM], CTR [CTR_T_IMGNAM]); IF .CTR [CTR_V_DECW] THEN BEGIN CTR [CTR_W_GRPLEN] = MIN (CTR_S_GRPNAM, .PRC [PRC_W_DEVLEN]); CH$MOVE (.CTR [CTR_W_GRPLEN], PRC [PRC_T_DEVNAM], CTR [CTR_T_GRPNAM]); END ELSE BEGIN CTR [CTR_W_GRPLEN] = .TRM [TRM_W_GRPLEN]; CH$MOVE (.CTR [CTR_W_GRPLEN], TRM [TRM_T_GRPNAM], CTR [CTR_T_GRPNAM]); END; CTR [CTR_A_TRMREC] = .TRM; CTR [CTR_V_CPU] = .TRM [TRM_V_CPU]; CTR [CTR_V_PIO] = .TRM [TRM_V_PIO]; CTR [CTR_V_TIO] = .TRM [TRM_V_TIO]; CTR [CTR_V_DISCON] = .TRM [TRM_V_DISCON]; CTR [CTR_V_WARN] = .TRM [TRM_V_WARN]; CTR [CTR_V_FORCE] = .TRM [TRM_V_FORCE]; CTR [CTR_V_EXIT] = .TRM [TRM_V_EXIT]; CTR [CTR_L_DCPU] = .TRM [TRM_L_DCPU]; CTR [CTR_L_DPIOCT] = .TRM [TRM_L_DPIO]; CTR [CTR_L_DTIOCT] = .TRM [TRM_L_DTIO]; CH$MOVE (8, TRM [TRM_Q_WARNTIME], CTR [CTR_Q_WARNTIME]); CH$MOVE (8, TRM [TRM_Q_FORCETIME], CTR [CTR_Q_FORCETIME]); IF EXCLOVER (PRC, OVRQUE, OVR) THEN BEGIN CTR [CTR_A_OVERRIDE] = .OVR; IF .OVR [EXC_V_METRICS] THEN BEGIN CTR [CTR_V_CPU] = .OVR [EXC_V_CPU]; CTR [CTR_V_PIO] = .OVR [EXC_V_PIO]; CTR [CTR_V_TIO] = .OVR [EXC_V_TIO]; CTR [CTR_L_DCPU] = .OVR [EXC_L_DCPU]; CTR [CTR_L_DPIOCT] = .OVR [EXC_L_DPIO]; CTR [CTR_L_DTIOCT] = .OVR [EXC_L_DTIO]; END; IF .OVR [EXC_V_OVRWARN] THEN BEGIN CTR [CTR_V_WARN] = .OVR [EXC_V_WARN]; CH$MOVE (8, OVR [EXC_Q_WARNTIME], CTR [CTR_Q_WARNTIME]); END; IF .OVR [EXC_V_OVRFORCE] THEN BEGIN CTR [CTR_V_FORCE] = .OVR [EXC_V_FORCE]; CTR [CTR_V_DISCON] = .OVR [EXC_V_DISCON]; CTR [CTR_V_EXIT] = .OVR [EXC_V_EXIT]; CH$MOVE (8, OVR [EXC_Q_FORCETIME], CTR [CTR_Q_FORCETIME]); END; END; IF .CTR [CTR_V_EXIT] AND .CTR [CTR_W_IMGLEN] EQL 0 THEN RETURN 0; INSQUE (.CTR, .COUNTQ [QUE_L_TAIL]); RETURN SS$_NORMAL; END; END; TRM = .TRM [TRM_L_FLINK]; END; 0 END; ! WATCHING %SBTTL 'CHANGED' ROUTINE CHANGED (PRC_A, CTR_A) = BEGIN !++ ! FUNCTIONAL DESCRIPTION: ! ! Updates a counter record and determines whether there have ! been any changes since the last update. ! ! RETURNS: cond_value, longword (unsigned), write only, by value ! ! PROTOTYPE: ! ! CHANGED ! ! IMPLICIT INPUTS: None. ! ! IMPLICIT OUTPUTS: None. ! ! COMPLETION CODES: ! ! SS$_NORMAL: normal successful completion. ! ! SIDE EFFECTS: ! ! None. !-- BIND PRC = .PRC_A : PRCDEF, CTR = .CTR_A : CTRDEF; CTR [CTR_V_VALID] = 1; IF .CTR [CTR_V_FAKE] THEN BEGIN TRACE (DBG_M_CHANGE, ' -- "Fake" process: skip warn/logout check.'); RETURN CTR [CTR_V_CHANGED] = 1; END; CTR [CTR_V_CHANGED] = .CTR [CTR_V_CPU] AND ABS (.PRC [PRC_L_CPU]-.CTR [CTR_L_CPU]) GTR .CTR [CTR_L_DCPU]; IF .CTR [CTR_V_CHANGED] THEN TRACE (DBG_M_CHANGE, ' -- CPU time changed: was !UL, now !UL', .CTR [CTR_L_CPU], .PRC [PRC_L_CPU]) ELSE BEGIN CTR [CTR_V_CHANGED] = .CTR [CTR_V_TIO] AND ABS (.PRC [PRC_L_TIOCT]-.CTR [CTR_L_TIOCT]) GTR .CTR [CTR_L_DTIOCT]; IF .CTR [CTR_V_CHANGED] THEN TRACE (DBG_M_CHANGE, ' -- TIO count changed: was !UL, now !UL', .CTR [CTR_L_TIOCT], .PRC [PRC_L_TIOCT]) ELSE BEGIN CTR [CTR_V_CHANGED] = .CTR [CTR_V_PIO] AND ABS (.PRC [PRC_L_PIOCT]-.CTR [CTR_L_PIOCT]) GTR .CTR [CTR_L_DPIOCT]; IF .CTR [CTR_V_CHANGED] THEN TRACE (DBG_M_CHANGE, ' -- PIO count changed: was !UL, now !UL', .CTR [CTR_L_PIOCT], .PRC [PRC_L_PIOCT]) ELSE BEGIN CTR [CTR_V_CHANGED] = NOT (.CTR [CTR_V_CPU] OR .CTR [CTR_V_PIO] OR .CTR [CTR_V_TIO]); IF .CTR [CTR_V_CHANGED] THEN TRACE (DBG_M_CHANGE, ' -- No change measurements; treat as changed.'); END; END; END; IF .CTR [CTR_V_CHANGED] THEN $GETTIM (TIMADR=CTR [CTR_Q_LASTCHG]); CTR [CTR_V_WARNED] = .CTR [CTR_V_WARNED] AND NOT .CTR [CTR_V_CHANGED]; CTR [CTR_L_CPU] = .PRC [PRC_L_CPU]; CTR [CTR_L_PIOCT] = .PRC [PRC_L_PIOCT]; CTR [CTR_L_TIOCT] = .PRC [PRC_L_TIOCT]; CTR [CTR_W_IMGLEN] = .PRC [PRC_W_IMGLEN]; CH$MOVE (.CTR [CTR_W_IMGLEN], PRC [PRC_T_IMGNAM], CTR [CTR_T_IMGNAM]); .CTR [CTR_V_CHANGED] END; ! CHANGED %SBTTL 'UPDATE_COUNTER_FOR_OVERRIDE' ROUTINE UPDATE_COUNTER_FOR_OVERRIDE (CTR_A, OVR_A) : NOVALUE = BEGIN !++ ! FUNCTIONAL DESCRIPTION: ! ! Updates a counter record with override information, due to ! an transition either to or from an override qualification. ! ! RETURNS: cond_value, longword (unsigned), write only, by value ! ! PROTOTYPE: ! ! UPDATE_COUNTER_FOR_OVERRIDE ctr, ovr ! ! IMPLICIT INPUTS: None. ! ! IMPLICIT OUTPUTS: None. ! ! COMPLETION CODES: ! ! SS$_NORMAL: normal successful completion. ! ! SIDE EFFECTS: ! ! None. !-- BIND CTR = .CTR_A : CTRDEF, OVR = .OVR_A : EXCDEF, TRM = .CTR [CTR_A_TRMREC] : TRMDEF; !+ ! Begin by resetting the counter back to the WATCH record settings. !- CTR [CTR_V_CPU] = .TRM [TRM_V_CPU]; CTR [CTR_V_PIO] = .TRM [TRM_V_PIO]; CTR [CTR_V_TIO] = .TRM [TRM_V_TIO]; CTR [CTR_V_DISCON] = .TRM [TRM_V_DISCON]; CTR [CTR_V_WARN] = .TRM [TRM_V_WARN]; CTR [CTR_V_FORCE] = .TRM [TRM_V_FORCE]; CTR [CTR_V_EXIT] = .TRM [TRM_V_EXIT]; CTR [CTR_L_DCPU] = .TRM [TRM_L_DCPU]; CTR [CTR_L_DPIOCT] = .TRM [TRM_L_DPIO]; CTR [CTR_L_DTIOCT] = .TRM [TRM_L_DTIO]; CH$MOVE (8, TRM [TRM_Q_WARNTIME], CTR [CTR_Q_WARNTIME]); CH$MOVE (8, TRM [TRM_Q_FORCETIME], CTR [CTR_Q_FORCETIME]); CTR [CTR_A_OVERRIDE] = 0; !+ ! And now fill in the override information, if there is any !- IF .OVR_A NEQA 0 THEN BEGIN CTR [CTR_A_OVERRIDE] = .OVR_A; IF .OVR [EXC_V_METRICS] THEN BEGIN CTR [CTR_V_CPU] = .OVR [EXC_V_CPU]; CTR [CTR_V_PIO] = .OVR [EXC_V_PIO]; CTR [CTR_V_TIO] = .OVR [EXC_V_TIO]; CTR [CTR_L_DCPU] = .OVR [EXC_L_DCPU]; CTR [CTR_L_DPIOCT] = .OVR [EXC_L_DPIO]; CTR [CTR_L_DTIOCT] = .OVR [EXC_L_DTIO]; END; IF .OVR [EXC_V_OVRWARN] THEN BEGIN CTR [CTR_V_WARN] = .OVR [EXC_V_WARN]; CH$MOVE (8, OVR [EXC_Q_WARNTIME], CTR [CTR_Q_WARNTIME]); END; IF .OVR [EXC_V_OVRFORCE] THEN BEGIN CTR [CTR_V_FORCE] = .OVR [EXC_V_FORCE]; CTR [CTR_V_DISCON] = .OVR [EXC_V_DISCON]; CTR [CTR_V_EXIT] = .OVR [EXC_V_EXIT]; CH$MOVE (8, OVR [EXC_Q_FORCETIME], CTR [CTR_Q_FORCETIME]); END; END; !+ ! We'll also reset the metrics back to 0 to give the user as much ! leniency as possible. Wouldn't want them to get logged out for ! inactivity just for leaving a program or something! !- CTR [CTR_L_CPU] = 0; CTR [CTR_L_PIOCT] = 0; CTR [CTR_L_TIOCT] = 0; CTR [CTR_W_IMGLEN] = 0; CTR [CTR_V_WARNED] = 0; END; ! UPDATE_COUNTER_FOR_OVERRIDE %SBTTL 'CHECK_MBOX' GLOBAL ROUTINE CHECK_MBOX : NOVALUE = BEGIN !++ ! FUNCTIONAL DESCRIPTION: ! ! Checks the command mailbox for messages and does something with ! the ones it can identify. ! ! RETURNS: cond_value, longword (unsigned), write only, by value ! ! PROTOTYPE: ! ! CHECK_MBOX ! ! IMPLICIT INPUTS: None. ! ! IMPLICIT OUTPUTS: None. ! ! COMPLETION CODES: ! ! SS$_NORMAL: normal successful completion. ! ! SIDE EFFECTS: ! ! None. !-- EXTERNAL ROUTINE INIT_LOG, CLOSE_LOG, LOAD_CONFIG; LOCAL IOSB : MIOSBDEF, MBXMSG : VECTOR [2,WORD], STATUS; WHILE 1 DO BEGIN STATUS = $QIOW (EFN=.MBXEFN, FUNC=IO$_READVBLK OR IO$M_NOW, CHAN=.MBXCHN, IOSB=IOSB, P1=MBXMSG, P2=%ALLOCATION (MBXMSG)); IF NOT .STATUS OR NOT .IOSB [MIOSB_W_STATUS] OR .IOSB [MIOSB_W_COUNT] EQL 0 THEN EXITLOOP; SELECTONE .MBXMSG [0] OF SET [WATCHER_K_MSGTYPE_RESET] : BEGIN LOCAL TRM : REF TRMDEF, EXC : REF EXCDEF, CTR : REF CTRDEF; LOG ('WATCHER resetting'); CLOSE_LOG (); WHILE NOT REMQUE (.TRMQUE, TRM) DO LIB$FREE_VM (%REF (TRM_S_TRMDEF), TRM); WHILE NOT REMQUE (.EXCQUE, EXC) DO LIB$FREE_VM (%REF (EXC_S_EXCDEF), EXC); WHILE NOT REMQUE (.OVRQUE, EXC) DO LIB$FREE_VM (%REF (EXC_S_EXCDEF), EXC); WHILE NOT REMQUE (.COUNTQ, CTR) DO LIB$FREE_VM (%REF (CTR_S_CTRDEF), CTR); STATUS = LOAD_CONFIG (); IF NOT .STATUS THEN SIGNAL_STOP (WATCHER__NOCFG, 0, .STATUS); INIT_LOG (); END; [WATCHER_K_MSGTYPE_SHUTDOWN] : BEGIN LOG ('WATCHER shutting down'); CLOSE_LOG (); $EXIT (CODE=SS$_NORMAL); END; [WATCHER_K_MSGTYPE_DECW] : ; [OTHERWISE] :; TES; END; $SETAST (ENBFLG=0); IF .SETAST THEN $QIOW (EFN=.MBXEFN, CHAN=.MBXCHN, IOSB=IOSB, FUNC=IO$_SETMODE OR IO$M_WRTATTN, P1=MBX_AST); SETAST = 0; $SETAST (ENBFLG=1); END; ! CHECK_MBOX %SBTTL 'MBX_AST' ROUTINE MBX_AST = BEGIN !++ ! FUNCTIONAL DESCRIPTION: ! ! AST routine executed when someone writes something to the mailbox. ! Right now, this just wakes the mainline thread so that CHECK_MBOX ! can be executed. ! ! RETURNS: cond_value, longword (unsigned), write only, by value ! ! PROTOTYPE: ! ! MBX_AST ! ! IMPLICIT INPUTS: None. ! ! IMPLICIT OUTPUTS: None. ! ! COMPLETION CODES: ! ! SS$_NORMAL: normal successful completion. ! ! SIDE EFFECTS: ! ! None. !-- SETAST = 1; $WAKE () END; ! MBX_AST %SBTTL 'EXIT_HANDLER' ROUTINE EXIT_HANDLER = BEGIN !++ ! FUNCTIONAL DESCRIPTION: ! ! This exit handler just does a DELMBX on the command mailbox. ! ! RETURNS: cond_value, longword (unsigned), write only, by value ! ! PROTOTYPE: ! ! EXIT_HANDLER (invoked at image rundown) ! ! IMPLICIT INPUTS: None. ! ! IMPLICIT OUTPUTS: None. ! ! COMPLETION CODES: ! ! SS$_NORMAL: normal successful completion. ! ! SIDE EFFECTS: ! ! None. !-- IF .MBXCHN NEQ 0 THEN $DELMBX (CHAN=.MBXCHN); SS$_NORMAL END; ! EXIT_HANDLER END ELUDOM