PROGRAM WATCH_DOG IMPLICIT NONE C C Program: WATCHDOG C C Original: unknown (program came from Decus Tape) C C Modifier's Address: C George H. Walrod III C Comprehenive Technologies International C 4260-B Chain Bridge Road C Fairfax, VA 22030 (703)352-4191 C C Purpose: This Program Monitors Interactive Processes and Logs Off C Processes Set There Idle. C C Compilation: C C Other Modules: C WATCHSYM.MAR - System Symbols for Watch Dog C C Corrected Modification: C V3.6-0 Watchdog rushed to Veterninarian Hospital, after being C found on Decus Tape Suffering from Owner's Neglect (not C functioning properly). After One Hundred Hours of C Restructive Surgery, and Plenty of Testing Watchdog is C being Discharged. Insect(Bug) Removed Surgery Include C Poor Documention of Source Code. Eye Sight Correction C Was Done Because of Processes Decneting Over to Another C System. The Process on the Host System Looks Idle but C Still Should NOT be Logged Off the Remote Process May be C Busy Working. C 04/06/85 George H. Walrod III C C V3.6-1 Correct Bug if User Spawns a Subprocess the Subprocess C Does not Have a Terminal when you do a GETJPI, so we C Search for the Parent Process to Get the Terminal. If C Parent has No Terminal They are probably a Detach Process C and We Do Not Touch those Processes. C 04/22/85 George H. Walrod III C C V3.6-2 Security/Bug, If user Spawn a Subprocess and then C Suspends his Parent Process, Then we can't find his C Terminal. The User seems to be trying to avoid Watchdog C So we warning him but send no Messages, and eventually C log him off, Knowing That it will probley hang him in C Suspended Process. But we try to resume the Parent C Process first knowing that this will probably no work. C 04/22/85 George H. Walrod III C C V3.7-0 Watch Dog get hits by Car! When Watchdog tells the user C that they are being logged off and the User logs out on C their own, When Watch goes to bite(Delete) the user C process for the final Kill, and user is gone. Watchdog C dies when a car(Error) come from no where. The license C plate of the car is "SS$_NONEXPR" (nonexistent process). C 04/26/85 George H. Walrod III C C V4.0-0 Dec Goes Against Own Standard, Version 4.X changes the C Indexed PID to Extented Pid. Added Routine to Change C Pid (GETPID). THIS CALL MUST BE COMMENTED FOR VMS C VERSION LESS THAN 4.X. C 12/06/85 George H. Walrod III C Alan Cutler C C V4.0-1 VAX/DBMS Tries to Jump Fence, While Watchdog is looking and C mulls Detached Process. By VAX/DBMS Creating a Detached C Process with a Terminal Name of a Mailbox, Watchdog Thinks C It a Interactive Process. Watchdog Ignores Terminal Types C 'MB' C 12/17/85 George H. Walrod III C C V4.0-2 Watchdog Jumps out of Car, and Wanders up to Tewesberry, C Massachusetts and is Found by VAX/VMS Software Engineer. C Software Engineer returns Watchdog back to Owner, with bad C news that Watchdog has encountered a deadly but curable C disease the ALL-IN-ONE Spotted Fever Tick. Watchdog has C Problem Living in the Same Environment as ALL-IN-ONE, Due C to the Way Watchdog Looks at Subprocesses in Relation to C Parent Process this Problem is Correct When Watchdog is C Release from Veterninarian Hospital(next major release), but C it ok to use if All-In-One is not on System. C 01/17/86 George H. Walrod III C C V4.0-3 Food and Drug Adminstation (FDA) Starts Major Investation of C ALL-IN-ONE Spotted Fever Tick, that Watchdog has acquired C while up in Tewesberry, Massachusetts. After Four Weeks of C Investation (THATS FAST FOR THE U.S. GOVERMENT), FDA has C Determined the Spread of the ALL-IN-ONE Spotted Fever Tick, C Has Become of Epidemic proporation, has Infected all programs C of this Type. Police have charged all DECUS Program Authors C and Owners of Not Maintaining There Programs. In Watchdog's C Case is not Charged, The Charged is an Over Caring Owner C (Perfectionist), Thus Over Working the Owner. The Sentence C is to No Longer Support Version of Watchdogs running in C VMS environments of 3.X for less and all Programs must C Be Recompiled. C 02/18/86 George H. Walrod III C C V4.1-0 WELCOME HOME WATCHDOG!!! Watchdog is Released from C Veterninarian Hospital with a Clean Bill of Heath. The C Disease of the ALL-IN-ONE Spotted Fever Tick is Curried and C Previous Restriction of Processes not being able to be C Resumed after Being Suspended. The Cure Required Major C Reconstructive Surgery on the Way Watchdog Looks at C Subprocesses. Watchdog starts by Looking at Master PID C Process, then if There are Any Subprocesses Have They Are C Looked at After That. A Process is Stop After the Stop C Process limit is Reached and All Processes Connect with the C Process are Inactive. Also the Recontructive Surgery Makes C Provision for Watchdog Next Veterninarian Checkup, which C Gives Watchdog's Master the Power of Exceptions. C 02/24/86 George H. Walrod III C Notes: C C Read File AAAREADME and ABSTRAST C C Debugging Tools Build-in : C D-Lines are used for Debug, C C INCLUDE 'WATCHITMLST.INC' ! Item List Description INCLUDE 'WATCHARRAY.INC' ! Array Common File INCLUDE 'WATCHACCT.INC' ! Account Include File INCLUDE 'WATCHTERM.INC' ! Terminal Include File INCLUDE 'WATCHUSER.INC' ! Username Include File INCLUDE 'WATCHPROC.INC' ! Process Name Include File C PARAMETER + JPI_WILDCARD = -1, ! Get Job Process Info Wildcard + DEBUGGING_GRPNUM= 7, ! Group Number for Debugging + CPU_50MS = 5, ! 50 MS Resolution + MAX_STRING = 100, ! Maximum String Length + UNKNOWN_TERM = 'UNKN', ! Unknown Terminal Name + PROCESS_NAME = 'WATCHDOG', ! Process Name + BINARY_ONE_MIN = -600000000, ! Binary Time + BELL = char(07), ! Ascii Bell + CR = char(10), ! Ascii Carriage Return + LR = char(13), ! Ascii Line Feed + FAO_IN_STR = + '!AS !AS on !AS has been inactive for !SL min.!AS', + HEADER_MSG = ! Header Message + BELL//'MESSAGE FROM WATCH_DOG'//BELL, + STAMP_MSG = ! Time Stamp Message + 'WATCH DOG TIME STAMP', + LOGOFF_DEF = ! DEFAULT LOGOFF + CR//LR//' and is being Logged Off', + INIT_MSG = ! Initial Message + 'WATCH DOG HAS BEEN INITIALIZED AND IS RUNNING' LOGICAL*1 + MS_TYPE, ! Operator Request Type + OPER_MSG_BUF(8), ! Operator Message Buffer + OPERATOR_NOTIFY, ! Operator Notify + CHECK_SUBPROCESSES ! Function to Check Subprocesses CHARACTER + ACCNAM*(MAX_ACCOUNT_LEN), ! Account Name + TTYNUM*(MAX_TERMINAL_LEN), ! Terminal Name + USRNAM*(MAX_USERNAME_LEN), ! User Name + PRCNAM*(MAX_PROCESS_LEN), ! Process Name + STRING*(MAX_STRING), ! String For Translation + TIMBF*8, ! Current Time Buffer + LOGOFF_MSG*26, ! Logoff Message + MESSAGE*85, ! Message Buffer + OPER_MESS*95 ! Operator Message INTEGER*2 + STRING_LENGTH, ! String Length + LIB$MATCHC, ! RTL Match Character + LOGOFF_L, ! Log Off Message Length + USRNAM_L, ! User Name Length + ACCNAM_L, ! Account Name Length + TTYNUM_L, ! Terminal Name Length + PRCNAM_L, ! Process Name Length + SEQ_NUMBER(2) ! Sequence Number PID INTEGER*4 + SEND_STAMP, ! Time Stamp(send_stamp*asctim) + START_MESSAGE, ! Start Sending Warning Msg + STOP_PROCESS, ! Stop Process Msg + MS_TARGET, ! Operator Terminal Type + TIME_STAMP, ! Time Stamp Counter + SEEDPID, ! Seed Pid for GETJPI + CUR_PID, ! Current Pid + BINTIM(2), ! Binary Time + RANGE(2) /0,'7FFFFFFF'X/,! Working Set Purge + SS_STATUS, ! Sys Service Status + CHKNETDEV, ! Check for Network Device + GETPRCCNT, ! Get Process Count from JIB + OTS$CVT_TI_L, ! RTL Convert Decimal->Binary + REMAINDER, ! Extented Divid Remainder + LIB$EDIV, ! RTL Extented Divid + SYS$SETPRN, ! SS Set Process Name + SYS$FAO, ! SS Format Ascii Output + SYS$SCHDWK, ! SS Schedule Wake + SYS$PURGWS, ! SS Purge Working set + SYS$BINTIM, ! SS Binary Time + SYS$DELPRC, ! SS Delete Process + SYS$BRDCST, ! SS Broadcast + SYS$SNDOPR, ! SS Send Operator + SYS$GETJPIW, ! SS Get Job Process Info + SYS$HIBER, ! SS Hiberate + SYS$TRNLNM, ! SS Translate Log + START_IDX, ! Index Pointer of TIME + TIME_MINUTES, ! Time in Minutes + MESSAGE_LEN, ! Message Length + EPID, ! Process Identifacation No. + PID, ! Process Identifacation No. + MASTER_PID, ! Process Master Pid + NEWCPU, ! New Cpu Time + NEWIOC, ! New Buffer I/O Count + STATE, ! Process State + GRPNUM, ! Group Number + MEMNUM, ! Member Number + SUBCOUNT ! Sub-Process Count RECORD /ITEM_LIST/ + JPI_ITMLST(13), ! Job Process Information + TRN_ITMLST(2) ! Translate Logical Name Info EXTERNAL + SS$_IVTIME, ! Invalid Time Spec. + SS$_DEVOFFLINE, ! Device Offline Line + SS$_NOMOREPROC, ! No More Processes + SS$_NONEXPR, ! Non Existent Process + SS$_NORMAL, ! Normal Completion + SS$_NOLOGNAM, ! No Logical Name Found + SS$_SUSPENDED, ! Process Suspended + JPI$_PID, ! Pid + JPI$_CPUTIM, ! Cpu Time + JPI$_BUFIO, ! Buffer I/O + JPI$_STATE, ! Process State + JPI$_USERNAME, ! User Name + JPI$_ACCOUNT, ! Account Name + JPI$_TERMINAL, ! Terminal Name + JPI$_GRP, ! Group Number + JPI$_MEM, ! Member Number + JPI$_PRCNAM, ! Process Name + JPI$_PRCCNT, ! Process Count + JPI$_MASTER_PID, ! Process Master PID + JPI$C_LISTEND, ! End List + SCH$C_HIB, ! Schedule Hiberation + SCH$C_HIBO, ! Schedule Hiberation Out Swap + LNM$_STRING, ! Logical Name Item Ret String + OPC$M_NM_CENTRL, ! Operator Central + OPC$_RQ_RQST ! Operator Request C C Define Equivalence Fields for Data Buffers C EQUIVALENCE + (MS_TYPE, OPER_MSG_BUF(1)), + (MS_TARGET, OPER_MSG_BUF(2)), + (OPER_MSG_BUF, OPER_MESS), + (MESSAGE, OPER_MESS(11:)), + (SEQ_NUMBER(1), PID) C C C Job Process Information Layout C JPI_ITMLST(1).BUFFER_LENGTH = 4 JPI_ITMLST(1).ITEM_CODE = %loc(jpi$_pid) JPI_ITMLST(1).BUFFER_ADDR = %loc(pid) JPI_ITMLST(1).RETURN_LENGTH_ADDR = 0 JPI_ITMLST(2).BUFFER_LENGTH = 4 JPI_ITMLST(2).ITEM_CODE = %loc(jpi$_cputim) JPI_ITMLST(2).BUFFER_ADDR = %loc(newcpu) JPI_ITMLST(2).RETURN_LENGTH_ADDR = 0 JPI_ITMLST(3).BUFFER_LENGTH = 4 JPI_ITMLST(3).ITEM_CODE = %loc(jpi$_bufio) JPI_ITMLST(3).BUFFER_ADDR = %loc(newioc) JPI_ITMLST(3).RETURN_LENGTH_ADDR = 0 JPI_ITMLST(4).BUFFER_LENGTH = 4 JPI_ITMLST(4).ITEM_CODE = %loc(jpi$_state) JPI_ITMLST(4).BUFFER_ADDR = %loc(state) JPI_ITMLST(4).RETURN_LENGTH_ADDR = 0 JPI_ITMLST(5).BUFFER_LENGTH = max_username_len JPI_ITMLST(5).ITEM_CODE = %loc(jpi$_username) JPI_ITMLST(5).BUFFER_ADDR = %loc(usrnam) JPI_ITMLST(5).RETURN_LENGTH_ADDR = %loc(usrnam_l) JPI_ITMLST(6).BUFFER_LENGTH = max_account_len JPI_ITMLST(6).ITEM_CODE = %loc(jpi$_account) JPI_ITMLST(6).BUFFER_ADDR = %loc(accnam) JPI_ITMLST(6).RETURN_LENGTH_ADDR = %loc(accnam_l) JPI_ITMLST(7).BUFFER_LENGTH = max_terminal_len JPI_ITMLST(7).ITEM_CODE = %loc(jpi$_terminal) JPI_ITMLST(7).BUFFER_ADDR = %loc(ttynum) JPI_ITMLST(7).RETURN_LENGTH_ADDR = %loc(ttynum_l) JPI_ITMLST(8).BUFFER_LENGTH = max_process_len JPI_ITMLST(8).ITEM_CODE = %loc(jpi$_prcnam) JPI_ITMLST(8).BUFFER_ADDR = %loc(prcnam) JPI_ITMLST(8).RETURN_LENGTH_ADDR = %loc(prcnam_l) JPI_ITMLST(9).BUFFER_LENGTH = 4 JPI_ITMLST(9).ITEM_CODE = %loc(jpi$_grp) JPI_ITMLST(9).BUFFER_ADDR = %loc(grpnum) JPI_ITMLST(9).RETURN_LENGTH_ADDR = 0 JPI_ITMLST(10).BUFFER_LENGTH = 4 JPI_ITMLST(10).ITEM_CODE = %loc(jpi$_mem) JPI_ITMLST(10).BUFFER_ADDR = %loc(memnum) JPI_ITMLST(10).RETURN_LENGTH_ADDR = 0 JPI_ITMLST(11).BUFFER_LENGTH = 4 JPI_ITMLST(11).ITEM_CODE = %loc(jpi$_prccnt) JPI_ITMLST(11).BUFFER_ADDR = %loc(subcount) JPI_ITMLST(11).RETURN_LENGTH_ADDR = 0 JPI_ITMLST(12).BUFFER_LENGTH = 4 JPI_ITMLST(12).ITEM_CODE = %loc(jpi$_master_pid) JPI_ITMLST(12).BUFFER_ADDR = %loc(master_pid) JPI_ITMLST(12).RETURN_LENGTH_ADDR = 0 JPI_ITMLST(13).END_LIST = %loc(jpi$c_listend) C C End of Job Process Information List C C C Initial Translate Logical Item List C TRN_ITMLST(1).BUFFER_LENGTH = MAX_STRING TRN_ITMLST(1).ITEM_CODE = %loc(LNM$_STRING) TRN_ITMLST(1).BUFFER_ADDR = %loc(STRING) TRN_ITMLST(1).RETURN_LENGTH_ADDR = %loc(STRING_LENGTH) TRN_ITMLST(2).END_LIST = 0 C C Translate Logical Name to Get Stamp String, If There is No Logical C Then Fatal Error C SS_STATUS = SYS$TRNLNM(,LOGICAL_TABLE, DEFAULT_TIME_STAMP,, + TRN_ITMLST) IF (SS_STATUS .ne. %loc(SS$_NORMAL)) ! Unexpected Error + CALL LIB$STOP(%val(SS_STATUS)) SS_STATUS = OTS$CVT_TI_L(STRING(1:STRING_LENGTH), + SEND_STAMP) IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) D TYPE *,'SEND STAMP VALUE IS ', SEND_STAMP C C Translate Logical Name to Get Default Stop Process Logical, C If There is No Logical Then Fatal Error C SS_STATUS = SYS$TRNLNM(,LOGICAL_TABLE, DEFAULT_STOP_PROC,, + TRN_ITMLST) IF (SS_STATUS .ne. %loc(SS$_NORMAL)) ! Unexpected Error + CALL LIB$STOP(%val(SS_STATUS)) SS_STATUS = OTS$CVT_TI_L(STRING(1:STRING_LENGTH), + STOP_PROCESS) IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) D TYPE *,'STOP PROCESS VALUE IS ', STOP_PROCESS C C Translate Logical Name to Get Default Start Message Logical, C If There is No Logical Then Fatal Error C SS_STATUS = SYS$TRNLNM(,LOGICAL_TABLE, DEFAULT_START_MSG,, + TRN_ITMLST) IF (SS_STATUS .ne. %loc(SS$_NORMAL)) ! Unexpected Error + CALL LIB$STOP(%val(SS_STATUS)) SS_STATUS = OTS$CVT_TI_L(STRING(1:STRING_LENGTH), + START_MESSAGE) IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) D TYPE *,'START MESSAGE PROCESS VALUE IS ', START_MESSAGE C C Translate Logical Name to for Interval Logical, C If There is No Logical Then Fatal Error C SS_STATUS = SYS$TRNLNM(,LOGICAL_TABLE, INTERVAL,, TRN_ITMLST) IF (SS_STATUS .ne. %loc(SS$_NORMAL)) ! Unexpected Error + CALL LIB$STOP(%val(SS_STATUS)) C C Convert Ascii Time to Binary Time C Convert in to Minutes for Warning Messages C D TYPE *,'ASCII Time Intervals is ', STRING(1:STRING_LENGTH) SS_STATUS = SYS$BINTIM(STRING(1:STRING_LENGTH), BINTIM) IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) SS_STATUS = LIB$EDIV(BINARY_ONE_MIN, BINTIM, TIME_MINUTES, + REMAINDER) IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) D TYPE *,'Number of Minutes Binary ', TIME_MINUTES IF (REMAINDER .ne. 0) CALL LIB$STOP(SS$_IVTIME) C C Set-Up Data Buffer for Operator Message C MS_TYPE = %loc(OPC$_RQ_RQST) MS_TARGET = %loc(OPC$M_NM_CENTRL) OPER_MESS(9:10) = BELL // BELL C C Set Process Name to "WATCH_DOG" C SS_STATUS = SYS$SETPRN(PROCESS_NAME) IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) C C C Send Operator Console Message Tell Them That I am Running C MESSAGE = INIT_MSG SS_STATUS = SYS$SNDOPR(OPER_MESS,) D TYPE *,'Type Return Status from SYS$SNDOPR is ', SS_STATUS IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) C C Initialize Time Stamp Time So That I Send Time Stamp Message C Too When I Start Running C TIME_STAMP = SEND_STAMP - 1 C C Main Section of Program, Get Data on Users C 1 CONTINUE TIME_STAMP = TIME_STAMP + 1 C C Send Time Stamp Message If It is Time C IF (TIME_STAMP .eq. SEND_STAMP ) then MESSAGE = STAMP_MSG SS_STATUS = SYS$SNDOPR(OPER_MESS,) D TYPE *,'Type Return Status from SYS$SNDOPR is ', SS_STATUS IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) TIME_STAMP=0 END IF C C Loop Until We Have Looked At All Processes using C Get Job Process Information with a Wild Card C D900 FORMAT(' Working With PID ',Z8) SEEDPID = JPI_WILDCARD SS_STATUS = 0 DO WHILE (SS_STATUS .ne. %loc(SS$_NOMOREPROC)) SS_STATUS = SYS$GETJPIW(,%ref(SEEDPID),, + %ref(JPI_ITMLST),,,) D TYPE *,'Type Return Status from SYS$GETJPI is ', SS_STATUS D TYPE 900,PID IF ((SS_STATUS .ne. %loc(SS$_NOMOREPROC)) .and. + SS_STATUS .ne. %loc(SS$_SUSPENDED) .and. + SS_STATUS .ne. %loc(SS$_NORMAL)) then CALL LIB$STOP(%val(SS_STATUS)) ELSE IF (SS_STATUS .eq. %loc(SS$_NOMOREPROC)) + GOTO 20 END IF C C We Have A User, Get The Low 16 Bits Of His Pid (the index) C the High Order Bits Are the Sequence number C EPID = PID ! Change for Version 4.X CALL GETPID (PID) ! Change for Version 4.X CUR_PID = SEQ_NUMBER(1) D TYPE 900, PID C C If The Process is Suspended, Check The Process Count From C JIB. If There Are Not Other Processes Than Ignore That Process. C If There is assume there is a Terminal attached, and Has not C Active. C IF (SS_STATUS .eq. %loc(SS$_SUSPENDED)) THEN D TYPE *,'Process is Suspended' SS_STATUS = GETPRCCNT(CUR_PID, SUBCOUNT) IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) IF (SUBCOUNT .eq. 0) GOTO 20 ! Ignore Process D TYPE *,'Process has Some Subprocess' GOTO 50 ! Check in On the Kids END IF C C If The Sequence Number Has Changed Since We Last Logged In, C We Have A New Sucker. Reset All The Use Counts, And Dont Bother Him C IF (SEQ(CUR_PID) .ne. SEQ_NUMBER(2)) THEN D TYPE *,'Never Seen This Person Before' SEQ(CUR_PID) = SEQ_NUMBER(2) WARNING(CUR_PID) = 0 STOPABLE(CUR_PID) = .TRUE. C C Debugging Tool Just to Look at Specific UIC Groups C CD IF (GRPNUM .ne. DEBUGGING_GRPNUM) THEN CD TYPE *, CD + 'Not in Debugging Group Process is Being Marked Unstopable' CD STOPABLE(CUR_PID) = .false. CD GOTO 20 CD END IF D IF (PRCNAM_L .ne. 0) D + TYPE *, 'Process Name is ', PRCNAM(1:PRCNAM_L) C C 4.X Attached Some Process to Mailbox (i.e. DBMS-32) C D IF (TTYNUM_L .ne. 0) D + TYPE *, 'Terminal Name is ', TTYNUM(1:TTYNUM_L) IF ((TTYNUM_L .ne. 0) .and. (ttynum(1:2) .eq. 'MB')) then D TYPE *, 'Process has Mailbox Name for Terminal' D TYPE *, D + 'Process is Being Marked Unstopable for Above Reason' STOPABLE(CUR_PID) = .false. GOTO 20 END IF GOTO 10 END IF C C Is The Process Subject to Watchdog Monitoring C (am I wasteing my time) C IF (.not. STOPABLE(CUR_PID)) THEN D TYPE *, 'This Process is Not Stopable' GOTO 20 END IF C C Watchdog at this point only looks at Parent Processes C and Then Searches Other Later Out Later Necessary. C D901 FORMAT(' This Process is Not a the MASTER PID ',Z8) IF (EPID .ne. MASTER_PID) THEN D TYPE 901, MASTER_PID GOTO 20 END IF D TYPE *, 'This Process is the MASTER' C C Since the Process is a MASTER Process They Must be a C Associated with a Terminal so Ignore the Process there is C Not A Terminal. C IF (TTYNUM_L .eq. 0) THEN D TYPE *, 'This MASTER Process Does Not Have A Terminal' STOPABLE(CUR_PID) = .false. GOTO 20 END IF C C Leave The Processes Alone, IF There Hiberating and C There Using a Network Device C IF (((STATE .eq. %loc(SCH$C_HIB)) .or. + (STATE .eq. %loc(SCH$C_HIBO))) .and. + (CHKNETDEV(PID))) THEN D TYPE *, 'This Process is Hiberating and Has A Network Device' GOTO 20 END IF C C Normal User, Check Buffer I/O, or If 50ms Of Cpu was Used C IF ((BUFIOC(CUR_PID) .lt. NEWIOC) .or. + (CPUTIM(CUR_PID)+CPU_50MS .lt. NEWCPU)) then D TYPE *, 'MASTER Has Done Some Work Since I Saw Them Last' D TYPE *, 'Old BufIOC ', BUFIOC(CUR_PID), ' NEWIOC ', NEWIOC D TYPE *, 'Old CPUTIM ', CPUTIM(CUR_PID), ' NEWCPU ', NEWCPU WARNING(CUR_PID) = 0 GOTO 10 END IF C C Does the Parent Have Any Subprocess Out Standing, C If They Do We Must Look At Them Too. C 50 CONTINUE D TYPE *, 'MASTER Has Been Idle' IF (SUBCOUNT .GT. 0) then SS_STATUS = GETPRCCNT(CUR_PID, SUBCOUNT) IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) D TYPE *, 'MASTER Has Some Children ', SUBCOUNT IF (CHECK_SUBPROCESSES(MASTER_PID, SUBCOUNT)) GOTO 10 D TYPE *, 'Good For Nothing Children Have not Done Any Work' END IF C C Locate Space at End of Username IF ANY C USRNAM_L = LIB$MATCHC(' ', USRNAM(1:USRNAM_L)) -1 C C We Have Them Now, Check To See if We Can Start Sending Messages Yet C to User and/or Central Operator C WARNING(CUR_PID) = WARNING(CUR_PID) + 1 D TYPE *,'Number of Warning ', WARNING(CUR_PID) IF (WARNING(CUR_PID) .ge. START_MESSAGE) then D TYPE *,'Warn User ', USRNAM(1:USRNAM_L) C C Determine If We Are Going to Make Them History for the Message C Get Time of Day and Assemble The Message C LOGOFF_MSG = ' ' LOGOFF_L = 1 IF (WARNING(CUR_PID) .eq. STOP_PROCESS) THEN LOGOFF_MSG = LOGOFF_DEF LOGOFF_L = len(LOGOFF_DEF) END IF CALL TIME(TIMBF) C C Format User's Warning Message or Termination Message C SS_STATUS = SYS$FAO(FAO_IN_STR, MESSAGE_LEN, MESSAGE, + TIMBF, + USRNAM(1:USRNAM_L), + TTYNUM(1:TTYNUM_L), + %val(TIME_MINUTES*WARNING(CUR_PID)), + LOGOFF_MSG(1:LOGOFF_L)) IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) D TYPE *,'IDLE TIME ', TIME_MINUTES*WARNING(CUR_PID) C C Tell the Operator that the User is Being Logged Off or Warned C IF (OPERATOR_NOTIFY) THEN SS_STATUS = SYS$SNDOPR(OPER_MESS(1:Message_len+10),) IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) END IF C C Tell the User that there Being Warned or Logged Off C SS_STATUS = SYS$BRDCST(HEADER_MSG, + TTYNUM(1:TTYNUM_L)) IF ((.not. SS_STATUS) .and. + (SS_STATUS .ne. %loc(SS$_DEVOFFLINE))) + CALL LIB$STOP(%val(SS_STATUS)) SS_STATUS = SYS$BRDCST(OPER_MESS(9:Message_len+10), + TTYNUM(1:TTYNUM_L)) IF ((.not. SS_STATUS) .and. + (SS_STATUS .ne. %loc(SS$_DEVOFFLINE))) + CALL LIB$STOP(%val(SS_STATUS)) END IF C C Can We Delete Process, Check C IF (WARNING(CUR_PID) .eq. STOP_PROCESS) then D TYPE *,'Deleting User ', USRNAM(1:USRNAM_L) C C Delete Process Time C SS_STATUS = SYS$DELPRC(%ref(EPID),) IF ((SS_STATUS .ne. %loc(SS$_NORMAL)) .and. + SS_STATUS .ne. %loc(SS$_NONEXPR)) + CALL LIB$STOP(%val(SS_STATUS)) END IF C C Go Get Another Process, Also Assign the CPUTIM and BUFIOC C 10 CONTINUE CPUTIM(CUR_PID)=NEWCPU BUFIOC(CUR_PID)=NEWIOC 20 CONTINUE END DO C C Set Up a Scheduled Wake Up to Occur C SS_STATUS = SYS$SCHDWK(,,BINTIM,) IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) C C Dont Waste Memory While Waiting C SS_STATUS = SYS$PURGWS(%ref(RANGE)) IF (.not. SS_STATUS) CALL LIB$STOP(%val(SS_STATUS)) C C Hibernate Till the Scheduled Wake-up C D TYPE *,'Going To Hiberate' SS_STATUS = SYS$HIBER() D TYPE *,'WATCH DOG Awake And Feeling Refreshed' GOTO 1 END ! Call It a Day