PROGRAM		WATCH_DOG
	IMPLICIT NONE
C
C   Program:	WATCHDOG
C
C   Original:	unknown (program came from Decus Tape)
C
C   Purpose:	This Program Monitors Interactive Processes and Logs Off
C		Processes Set There Idle.
C
C   Compilation:
C		FORTRAN /CONTINUATION=99/LIST/CROSS WATCHDOG
C		MACRO WATCHSYM
C		LINK WATCHDOG,WATCHSYM/SELECT/NOTRACEBACK
C
C   Other Modules:
C		WATCHSYM.MAR	- System Symbols for Watch Dog
C
C   Modification:
C		Restructured Program adding comments and Fixing a Bug
C		if you login into another System using Decnet
C		you idle on Host but still working on other system.
C					04/06/85	George H. Walrod III
C
C   Notes:
C
C	Variables of Some Importants :
C		Maxuser		: Maximum Number of Users Program can Support
C		Send_Stamp	: What Interval Time Stamp Should be Send
C		Start_Message	: What Interval Cycle Should Warning Message
C				  Starts.
C		Stop_Message	: What Interval Cycle Should Process be Deleted
C		ASCTIM		: Single Interval Cycle
C
C	Debugging Tools Build-in :
C		D-Lines are used for Debug, note when you compile Watchdog
C		with D_LINES only Processes with Group Number matching the
C		System Group(variable name SYSGRP) will be monitored.
C

	PARAMETER
	1	MAXUSER		= 256,		! Maximum Number Users
	2	SEND_STAMP	= 6,		! Time Stamp(send_stamp*asctim)
	4	START_MESSAGE	= 1,		! Start Sending Warning Msg
	5	STOP_MESSAGE	= 2,		! Stop Process Msg
	2	JPI_WILDCARD	= -1,		! Get Job Process Info Wildcard
	4	EFN		= 1,		! Event Flag
	6	CPU_50MS	= 5,		! 50 MS Resolution
	2	SYSGRP		= 7,		! System Group Number
	5	PROCESS_NAME	= 'gATCHDOG',	! Process Name
	8	BELL		= char(7),	! Ascii Bell
	1	FAO_IN_STR	= 
	2		'!AS !AS on !AS has been inactive for !SL min.!AS',
	9	HEADER_MSG	= 		! Header Message
	1		BELL//'MESSAGE FROM WATCH_DOG'//BELL,
	2	STAMP_MSG	=		! Time Stamp Message
	3		'WATCH DOG TIME STAMP',
	4	LOGOFF_DEF	=		! DEFAULT LOGOFF
	5		' and is being logged off',
	4	INIT_MSG	=		! Initial Message
	5		'WATCH DOG HAS BEEN INITIALIZED AND IS RUNNING'

	BYTE
	1	MS_TYPE,			! Operator Request Type
	2	OPER_MSG_BUF(8),		! Operator Message Buffer
	3	STOPABLE(MAXUSER)		! Process Stopable

	CHARACTER
	1	ACCNAM*8,			! Account Name
	3	TIMBF*8,			! Current Time Buffer
	2	TTYNUM*7,			! Terminal Name
	3	USRNAM*12,			! User Name
	4	LOGOFF_MSG*24,			! Logoff Message
	5	MESSAGE*85,			! Message Buffer
	3	ASCTIM*13 /'0 00:01:00.00'/,	! Time Delay
	6	OPER_MESS*80			! Operator Message

	INTEGER*2
	1	JPIBUF(60),			! Job Process Info Buffer
	2	SEQ_NUMBER(2),			! Sequence Number PID
	3	SEQ(MAXUSER)			! Sequence Part Of Pid

	INTEGER*4
	3	MS_TARGET,			! Operator Terminal Type
	3	TIME_STAMP,			! Time Stamp Counter
	1	SEEDPID,			! Seed Pid for GETJPI
	6	CUR_PID,			! Current Pid
	6	BINTIM(2),			! Binary Time
	7	RANGE(2)	/0,'7FFFFFFF'X/,! Working Set Purge
	9	CPUTIM(MAXUSER),		! Cpu Time Used
	1	BUFIOC(MAXUSER),		! Number Of Buffer I/O
	5	WARNING(MAXUSER),		! Number Of Warning So Far
	1	SS_STATUS,			! Sys Service Status
	2	LIB$MATCHC,			! RTL Index for Colon
	2	OTS$CVT_TI_L,			! RTL Convert Decimal->Binary
	2	SYS$SETPRN,			! SS Set Process Name
	2	SYS$FAO,			! SS Format Ascii Output
	3	SYS$SCHDWK,			! SS Schedule Wake
	8	SYS$PURGWS,			! SS Purge Working set
	9	SYS$BINTIM,			! SS Binary Time
	8	SYS$DELPRC,			! SS Delete Process
	9	SYS$BRDCST,			! SS Broadcast
	1	SYS$SNDOPR,			! SS Send Operator
	4	SYS$GETJPI,			! SS Get Job Process Info
	5	SYS$WAITFR,			! SS Wait For Efn
	6	SYS$HIBER,			! SS Hiberate
	7	START_IDX,			! Index Pointer of TIME
	7	TIME_MINUTES,			! Time in Minutes
	8	MESSAGE_LEN,			! Message Length
	1	PID,				! Process Identifacation No.
	2	OWNER,				! Process Owner Pid
	2	NEWCPU,				! New Cpu Time
	3	NEWIOC,				! New Buffer I/O Count
	6	STATE,				! Process State
	4	GRPNUM,				! Group Number
	5	SUBCOUNT,			! Sub-Process Count
	6	PIDADDR,			! Addr of Pid
	7	PIDLEN,				! Length of Pid
	8	CPUTADDR,			! Addr of Cpu Time
	9	CPULEN,				! Length of Cpu Time
	1	BIOADDR,			! Addr Buffer I/O
	2	BIOLEN,				! Length Buffer I/O
	3	STATEADDR,			! Addr of Process State
	4	STATELEN,			! Length of Process State
	4	USRNAM_L,			! User Name Length
	5	USERADDR,			! Addr of User Name
	6	USERLEN,			! Length of User Name
	1	ACCNAM_L,			! Account Name Length
	7	ACCADDR,			! Addr of Account Name
	8	ACCLEN,				! Length of Account Name
	3	TTYNUM_L,			! Terminal Name Length
	9	TERMADDR,			! Addr of Terminal Name
	1	TERMLEN,			! Length of Terminal Name
	2	GRPADDR,			! Addr of Group Number
	3	GRPLEN,				! Length Group Number
	4	PRCCADDR,			! Addr of Process Count
	5	PRCCLEN,			! Length of Process Count
	4	OWNERADDR,			! Addr of Owner Pid
	5	OWNERLEN			! Length of Owner Pid

	EXTERNAL
	1	SS$_DEVOFFLINE,			! Device Offline Line
	1	SS$_NOMOREPROC,			! No More Processes
	2	SS$_NORMAL,			! Normal Completion
	3	SS$_SUSPENDED,			! Process Suspended
	5	JPI$_PID,			! Pid
	6	JPI$_CPUTIM,			! Cpu Time
	7	JPI$_BUFIO,			! Buffer I/O
	8	JPI$_STATE,			! Process State
	9	JPI$_USERNAME,			! User Name
	1	JPI$_ACCOUNT,			! Account Name
	2	JPI$_TERMINAL,			! Terminal Name
	3	JPI$_GRP,			! Group Number
	4	JPI$_PRCCNT,			! Process Count
	5	JPI$_OWNER,			! Process Owner
	5	JPI$C_LISTEND,			! End List
	6	SCH$C_HIB,			! Schedule Hiberation
	6	SCH$C_HIBO,			! Schedule Hiberation Out Swap
	6	OPC$M_NM_CENTRL,		! Operator Central
	7	OPC$_RQ_RQST			! Operator Request

C
C   Define Equivalence Fields for Data Buffers
C
	EQUIVALENCE
	1	(PIDADDR,	JPIBUF(03)),
	2	(PIDLEN,	JPIBUF(05)),
	3	(CPUTADDR,	JPIBUF(09)),
	4	(CPULEN,	JPIBUF(11)),
	5	(BIOADDR,	JPIBUF(15)),
	6	(BIOLEN,	JPIBUF(17)),
	7	(STATEADDR,	JPIBUF(21)),
	8	(STATELEN,	JPIBUF(23)),
	9	(USERADDR,	JPIBUF(27)),
	1	(USERLEN,	JPIBUF(29)),
	2	(ACCADDR,	JPIBUF(33)),
	3	(ACCLEN,	JPIBUF(35)),
	4	(TERMADDR,	JPIBUF(39)),
	5	(TERMLEN,	JPIBUF(41)),
	6	(GRPADDR,	JPIBUF(45)),
	7	(GRPLEN,	JPIBUF(47)),
	8	(PRCCADDR,	JPIBUF(51)),
	9	(PRCCLEN,	JPIBUF(53)),
	1	(OWNERADDR,	JPIBUF(57)),
	2	(OWNERLEN,	JPIBUF(59)),
	1	(MS_TYPE,	OPER_MSG_BUF(1)),
	2	(MS_TARGET,	OPER_MSG_BUF(2)),
	3	(OPER_MSG_BUF,	OPER_MESS),
	4	(MESSAGE,	OPER_MESS(11:)),
	5	(SEQ_NUMBER(1),	PID)

C
C   Job Process Information Layout
C						! +---------------+
	JPIBUF(01) = 4				! |  Pid Buf Size |
	JPIBUF(02) = %loc(jpi$_pid)		! |      PID      |
	PIDADDR    = %loc(pid)			! |   Pid Addr    |
	PIDLEN     = 0				! |  Pid Ret Len  |
	JPIBUF(7)  = 4				! |  Cpu Time Len |
	JPIBUF(8)  = %loc(jpi$_cputim)		! |    CPUTIM     |
	CPUTADDR   = %loc(newcpu)		! | Cpu Time Addr |
	CPULEN     = 0				! |  Cpu Ret Len  |
	JPIBUF(13) = 4				! |  Buf I/O Size |
	JPIBUF(14) = %loc(jpi$_bufio)		! |   Buffer I/O  |
	BIOADDR    = %loc(newioc)		! | Buf I/O Addr  |
	BIOLEN     = 0				! | BufIO Ret Len |
	JPIBUF(19) = 4				! |Proc State Size|
	JPIBUF(20) = %loc(jpi$_state)		! | Process State !
	STATEADDR  = %loc(state)		! |Proc State Addr|
	STATELEN   = 0				! | State Ret Len |
	JPIBUF(25) = 12				! | User Name Len |
	JPIBUF(26) = %loc(jpi$_username)	! |   User Name   |
	USERADDR   = %loc(usrnam)		! | User Name Addr|
	USERLEN    = %loc(usrnam_l)		! | User Ret Len  |
	JPIBUF(31) = 8				! | Account Sizen |
	JPIBUF(32) = %loc(jpi$_account)		! |    Account    |
	ACCADDR    = %loc(accnam)		! | Account Addr  |
	ACCLEN     = %loc(accnam_l)		! | Account Retlen|
	JPIBUF(37) = 7				! | Terminal Size |
	JPIBUF(38) = %loc(jpi$_terminal)	! |   Terminal    |
	TERMADDR   = %loc(ttynum)		! | Terminal Addr |
	TERMLEN    = %loc(ttynum_l)		! | Terminal Len  |
	JPIBUF(43) = 4				! |  Grpno Size   |
	JPIBUF(44) = %loc(jpi$_grp)		! | Group Number  |
	GRPADDR    = %loc(grpnum)		! |  Grpno Addr   |
	GRPLEN     = 0				! | Grpno Ret Len |
	JPIBUF(49) = 4				! | Process Size  |
	JPIBUF(50) = %loc(jpi$_prccnt)		! | Process Count |
	PRCCADDR   = %loc(subcount)		! |   Proc Addr   |
	PRCCLEN    = 0				! | Proc Ret Len  |
	JPIBUF(55) = 4				! | Owner Size    |
	JPIBUF(56) = %loc(jpi$_owner)		! |  Owner Pid    |
	OWNERADDR  = %loc(owner)		! |  Owner Addr   |
	OWNERLEN   = 0				! | Owner Ret Len |
	JPIBUF(61) = %loc(jpi$c_listend)	! |  END OF LIST  |
	JPIBUF(62) = %loc(jpi$c_listend)	! |  END OF LIST  |
C						  +---------------+
C   End of Job Process Information List
C

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   Convert Ascii Time to Binary Time
C

	SS_STATUS = SYS$BINTIM(ASCTIM,BINTIM)
	IF (.not. SS_STATUS) CALL LIB$STOP(%VAL(SS_STATUS))

C
C   Extract Minutes From Asctim for Warning Messages
C

	START_IDX = LIB$MATCHC(':',ASCTIM) + 1
D	TYPE *,'ASCII Time Intervals is ',ASCTIM
D	TYPE *,'Number of Minutes ASCII ',ASCTIM(START_IDX:START_IDX+1)
	SS_STATUS = OTS$CVT_TI_L(ASCTIM(START_IDX:START_IDX+1),
	1						TIME_MINUTES)
D	TYPE *,'Type Return Status from OTS$CVT_TI_L is ',SS_STATUS
	IF (.not. SS_STATUS) CALL LIB$STOP(%VAL(SS_STATUS))

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   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
	ENDIF
C
C   Loop Until We Have Looked At All Processes using 
C   Get Job Process Information with a Wild Card
C

	SEEDPID   = JPI_WILDCARD
	SS_STATUS = 0
	DO WHILE (SS_STATUS .ne. %loc(SS$_NOMOREPROC))
	  SS_STATUS   = SYS$GETJPI(%val(EFN),%ref(SEEDPID),,%ref(JPIBUF),,,)
D	  TYPE *,'Type Return Status from SYS$GETJPI is ',SS_STATUS
D900	  FORMAT(' Working With PID ',Z8)
D	  TYPE 900,PID
	  IF (SS_STATUS) then
	    SS_STATUS = SYS$WAITFR(%val(EFN))
	   ELSE
	    IF ((SS_STATUS .ne. %loc(SS$_NOMOREPROC)) .and.
	1        SS_STATUS .ne. %loc(SS$_SUSPENDED)) then
	      CALL LIB$STOP(%VAL(SS_STATUS))
	     ELSE
	      GOTO 20
	     endif
	   endif

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

	  CUR_PID = SEQ_NUMBER(1)

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.
	    GOTO 10
	   endif

C
C   Is The Process Subject to Watchdog Monitoring
C	(am I wasteing my time)
C

	  IF (.not. STOPABLE(CUR_PID)) GOTO 10

C
C   Leave The Processes Alone, Which are Hiberating
C

	  IF ((STATE .eq. %loc(SCH$C_HIB)) .or.
	1     (STATE .eq. %loc(SCH$C_HIBO))) GOTO 10

C
C   Leave The System Processes Alone, Things Break If I Don't
C

C	  IF (ACCNAM(1:ACCNAM_L) .eq. 'SYSTEM') then
C	    STOPABLE(CUR_PID) = .false.
C	    GOTO 20
C	   end if

C
C   I leave The Systems Staff Alone, Otherwise I Would Be Considered
C   Anti-Social.
C

C	  IF (GRPNUM .le. SYSGRP) then
C	    STOPABLE(CUR_PID) = .false.
C	    GOTO 20
C	   end if

C
C   Debuging to only look at SYSGRP Uic's
C

D	  IF (GRPNUM .ne. SYSGRP) then
D	    STOPABLE(CUR_PID) = .false.
D	    GOTO 20
D	   end if

C
C   If He Has No Tty Associated, He Is A Batch Job, Or An Acp
C   Or Something Like That. If He Is A Batch Job During Primetime
C   It Is Likely That He Is Not Running Enough To Notice
C

	  IF (TTYNUM_L .eq. 0) GOTO 20

C
C   Normal User, He Can Be Saved By Doing An I/O, Or Using 50ms Of Cpu
C   If He Has Some Subprocess' Running Then He May Be Waiting
C   So Don't Blow Him Away
C

	  IF ((BUFIOC(CUR_PID) .lt. NEWIOC) .or.
	1     (CPUTIM(CUR_PID)+CPU_50MS .le. NEWCPU) .or.
	2     (SUBCOUNT .GT. 0)) then
	    WARNING(CUR_PID) = 0
	    GOTO 10
	   endif

C
C   We Have Them Now, Check To See if We Can Start Sending Messages Yet
C   to User and/or Central Operator
C

D	  TYPE *,'Number of Warning ',WARNING(CUR_PID)
	  WARNING(CUR_PID) = WARNING(CUR_PID) + 1

	  IF (WARNING(CUR_PID) .ge. START_MESSAGE) then
	    MESSAGE = ' '
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_DEF
	    IF (WARNING(CUR_PID) .ne. STOP_MESSAGE) LOGOFF_MSG = ' '
	    CALL TIME(TIMBF)
	    Usrnam_l = LIB$MATCHC(' ',usrnam) - 1
	    SS_STATUS = SYS$FAO(FAO_IN_STR, MESSAGE_LEN, MESSAGE,
	1			TIMBF,
	1                       USRNAM(1:usrnam_l),
	2			TTYNUM(1:ttynum_l),
	2			%val(TIME_MINUTES*WARNING(CUR_PID)),
	3			LOGOFF_MSG)
	    IF (.not. SS_STATUS) CALL LIB$STOP(%VAL(SS_STATUS))
D	    TYPE *,'STATUS RETURN FROM FAO IS ',SS_STATUS
D	    TYPE *,'IDLE TIME ',TIME_MINUTES*WARNING(CUR_PID)
C	    SS_STATUS = SYS$SNDOPR(OPER_MESS,)
C	    IF (.not. SS_STATUS) CALL LIB$STOP(%VAL(SS_STATUS))
	    SS_STATUS = SYS$BRDCST(HEADER_MSG,TTYNUM)
	    IF ((.not. SS_STATUS) .and. 
	1       (SS_STATUS .ne. %loc(SS$_DEVOFFLINE))) 
	2		CALL LIB$STOP(%VAL(SS_STATUS))
	    SS_STATUS = SYS$BRDCST(OPER_MESS(9:),TTYNUM)
	    IF ((.not. SS_STATUS) .and. 
	1       (SS_STATUS .ne. %loc(SS$_DEVOFFLINE)))
	2		CALL LIB$STOP(%VAL(SS_STATUS))
	   endif

C
C   Can We Delete Process, Check
C

	  IF (WARNING(CUR_PID) .eq. STOP_MESSAGE) then
D	    TYPE *,'Deleting User ',USRNAM(1:USRNAM_L)
	    SS_STATUS = SYS$SNDOPR(OPER_MESS,)
	    IF (.not. SS_STATUS) CALL LIB$STOP(%VAL(SS_STATUS))
	    SS_STATUS=sys$delprc(%ref(pid),)
	    IF (.not. SS_STATUS) CALL LIB$STOP(%VAL(SS_STATUS))
	   endif

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