PROGRAM	Argus
C
C This program was modified from one on the Fall '80 DECUS VAX SIG tape.
C It monitors processes logged on from the Port Selector terminal lines
C (TTC4: through TTC7: on the Fermilab Accelerator ACNET Development VAX).
C If one of these processes is idle for a set period  of time, then a
C message is sent to the terminal warning that the process is a candidate
C for deletion if it remains inactive.  After a small number of warnings,
C the process is deleted.  Messages to this effect are sent to the terminal
C and to the system console (operator log file).  An idle process is defined
C to be one that has used less than 50 msec. of CPU time since the
C previous monitoring pass.  In addition an idle process will not have
C done any buffered or direct I/O.  The port selector lines are monitored
C to prevent the process hanging around after the Micom port selector times
C out and disconnects the line (15-20 minutes).
C
C An idle process will be warned after N, 2*N  and 3*N minutes have elapsed.
C It will be deleted after 4*N minutes.  If the user is a privileged user
C (he has SETPRV, SYSPRV, DETACH, or CMKRNL as authorizable privileges), 
C then the process is deleted after two warnings have been issued.  N is set
C to 3 minutes during prime time (8 AM to 6 PM) and to 9 minutes during the
C offhours.
C
C The hard terminal lines (direct connection to the VAX) are monitored in
C a similar fashion for processes left idle.  However, the warning times
C are longer: 30, 60 and 90 minutes with deletion occuring after the process
C has been idle for 2 hours.
C
C The selection of port selector lines can be overridden by defining the
C logical name ARGUS_PORTS as the list of port selector terminal devices:
C
C   $ DEFINE/GROUP  ARGUS_PORTS  TTC4:TTC5:TTC6:TTC7:TTG4:TTG5:TTG6:TTG7:
C
C Note that the terminal names are squished together and include a ":" to
C terminate each terminal name.
C
C Rewritten:	Frank J. Nagy	8-Aug-1981
C		Fermilab Accelerator Controls Group
C
C Modifications:
C
C V1.0 21-Sep-81  FJN	Fix terminal name check in PORT_SELECTOR
C V2.0 23-Jul-82  FJN	Add "bugcheck" condition handler to send error
C			messages to operator.  Add beeps to warning
C			messages and use repetitive SCHDWK.  Prepare
C			for sending pseudo-break to port selector
C V2.1	16-Aug-82  FJN	Added code to send pseudo-breaks, add D line
C			for short time-out for testing
C V2.2	09-Nov-82  FJN	Added subprocess check and decrement warning
C			count of owner processes if found
C V3.0	29-Dec-83  FJN	Added checks and limits on hard lines and network
C			jobs -- but continue to ignore batch jobs!
C	31-Dec-83  FJN	Make V3 work correctly
C V3.1	05-Jan-84  FJN	Correct port selector warning logic: only if warning
C			count is >0!
C V3.2	13-Jan-84  FJN	Fix bug in warning privileged users on port selector
C			lines; make warning/kill calculation more general
C V4.0	13-Jan-84  FJN	Extend warning and kill interval on port selector lines
C			as the Port Selector timeout (20 min.) is reset by
C			the warning messages (but only during off hours)!
C V4.1	17-Jan-84  FJN	Correct idle time reported in first warning message
C
	INCLUDE	'FERMI$LIB:LCLFORDEF($OPCDEF)' !Send-to-operator codes
	INCLUDE 'FERMI$LIB:LCLFORDEF($PCBSTSDEF)' !PCB$L_STS bits
C===
	INTEGER*4 maxprocess		!maximum number of processes allowed
	PARAMETER (maxprocess = 128)
C===
	INTEGER*4 item_count		!number of $GETJPI items in list
	INTEGER*4 min_cputime		!minimum cpu time use is 50 millisecs
	INTEGER*4 delete_count		!delete process on this warning count
	INTEGER*4 warning_count		!send warning message every n times
	INTEGER*4 priv_delete_count	!delete count for privileged users
	INTEGER*4 offhours_grace	!Grace multiplier used during off hours
	INTEGER*4 hold_count
	INTEGER*4 hard_warning_count	!Hardline warning count
	INTEGER*4 hard_delete_count	!Hardline process deletion count
	INTEGER*4 systems_group		!groups 1-20(octal) are systems people
	INTEGER*4 efn			!event flag number
	INTEGER*4 three_minutes		!3 minutes in system units
	INTEGER*4 fifteen_seconds	!15 seconds in system units
	INTEGER*4 one_second		!1 seconds in system units
	INTEGER*4 two_seconds		!2 seconds in system units
	INTEGER*4 seconds_per_day	!Just what it says
C
	PARAMETER (item_count = 12)
	PARAMETER (min_cputime = 5)
	PARAMETER (warning_count = 1)
	PARAMETER (delete_count = 4*warning_count)
	PARAMETER (offhours_grace = 3)
	PARAMETER (priv_delete_count = 3)
	PARAMETER (hold_count = delete_count+1)
	PARAMETER (hard_warning_count = 10)
	PARAMETER (hard_delete_count = 4*hard_warning_count)
	PARAMETER (systems_group = 16)
	PARAMETER (efn = 10)
	PARAMETER (three_minutes = 3*60*1000*1000*10)
	PARAMETER (fifteen_seconds = 15*1000*1000*10)
	PARAMETER (one_second = 1000*1000*10)
	PARAMETER (two_seconds = 2*one_second)
	PARAMETER (seconds_per_day = 24*60*60)
C
C Define prime time hours as 8 AM to 6 PM (1800).
C
	INTEGER*4 primetime_begin, primetime_end
	PARAMETER (primetime_begin = 8*60*60, primetime_end = 18*60*60)
C==============================================================================
C Commons with information on the current process under consideration.
C
	COMMON /PROC_INFO/ pid, owner_pid, privileges, pcbsts,
	1	newcputime, newbufioc, newdirioc, groupnum,
	2	account_len, username_len, terminal_len, procnam_len,
	3	ptype, portindex
	INTEGER*4 pid			!Process identification
	INTEGER*4 pcbsts		!Status bits from the PCB
	INTEGER*4 newcputime		!New process CPU time usage
	INTEGER*4 newbufioc		!New process buffered I/O count
	INTEGER*4 newdirioc		!New process direct I/O count
	INTEGER*4 groupnum		!Process group number
	INTEGER*4 privileges(2)		!Privileges bit mask
	INTEGER*4 owner_pid		!Process id of owner of subprocess
	INTEGER*4 account_len		!Length of account text
	INTEGER*4 username_len		!Length of username text
	INTEGER*4 terminal_len		!Length of terminal device text
	INTEGER*4 procnam_len		!Length of process name text
	INTEGER*2 portindex		!Port selector line index number
	INTEGER*2 ptype			!Process type
	INTEGER*2 BATCH			!Batch process
	INTEGER*2 INTERACTIVE		!Interactive process
	INTEGER*2 DETACHED		!Detached process
	INTEGER*2 SUBPROCESS		!Subprocess
	PARAMETER (INTERACTIVE=0, SUBPROCESS=1, DETACHED=2, BATCH=4)
C
	COMMON /PROC_TEXT/ account, terminal, username, process_name
	CHARACTER account*8		!Account name
	CHARACTER terminal*7		!Device name of terminal
	CHARACTER username*12		!Username
	CHARACTER process_name*15	!Process name
C
	INTEGER*2 prcindex		!Process index from pid
	INTEGER*2 prcseqno		!Process sequence number from pid
	INTEGER*2 pid__w(2)
	EQUIVALENCE (pid,prcindex,pid__w),(pid__w(2),prcseqno)
	INTEGER*2 owner_prcindex	!Owner process index
	EQUIVALENCE (owner_pid,owner_prcindex)
C=======
C==============================================================================
C
C Buffer for list of items from $GETJPI
C
	COMMON /GETJPI_ITEM_LIST/ jpibuf
	INTEGER*4 jpibuf(3*item_count+1)
C=======
C
C Arrays to hold cputime and I/O counts for processes from previous
C monitoring pass.
C
	INTEGER*4 cputime(maxprocess)	!last monitored CPU time
	INTEGER*4 bufiocnt(maxprocess)	!last monitored buffered I/O count
	INTEGER*4 diriocnt(maxprocess)	!last monitored direct I/O oper. count
	INTEGER*2 procseqno(maxprocess)	!last monitored process sequence no.
	INTEGER*2 warning(maxprocess)	!warning count
	BYTE	  portline(maxprocess)	!Port selector line number (0=hard)
	BYTE	  proctype(maxprocess)	!Process type indicator
C
	INTEGER*4 delta_cputime,delta_bufioc,delta_dirioc
C
	LOGICAL*4 PRIVUSER		!Routine tests for privileged user
	INTEGER*4 PORT_SELECTOR		!Return port selector line number
	INTEGER*4 SYS$SETPRN		!Set process name service
	INTEGER*4 SYS$DELPRC		!Delete process service
	INTEGER*4 SYS$GETJPI		!Get job/process info. service
	INTEGER*4 SYS$WAITFR		!Wait-for-event flag service
	INTEGER*4 SYS$SCHDWK		!Scheduled wakeup service
	INTEGER*4 SYS$SETIMR		!Set timer service
	INTEGER*4 SYS$RESUME		!Resume process service
	INTEGER*4 TAKE_ACTION		!Return kill/no-action/warn action code
	EXTERNAL  SEND_A_BREAK		!AST routine to send break character
	INTEGER*4 status		!Completion status
	INTEGER*4 getjpi_status		!Completion status of $GETJPI
	INTEGER*4 seedpid		!Wildcard pid context
	INTEGER*4 time(2)		!Scheduled wakeup time
	INTEGER*4 break_time(2)		!Send-a-break time
	INTEGER*2 jpi_iosb(4)		!status block for asynch. $GETJPI
C
	LOGICAL*1 port_killed(32)	!Marks terminal lines to attach
	LOGICAL*1 any_killed		!Set if any process killed on pass
	INTEGER*2 wkstate		!Kill=-1/No-action=0/Warn=+1
	INTEGER*4 grace			!Grace multiplier (if any)
	INTEGER*4 itime(2)		!Time calculation temporary
	EQUIVALENCE (itime, privileges)	!Save memory and paging time
	INTEGER*4 ticks_per_second(2)	!Constant, what it says
C
	EXTERNAL SS$_SUSPENDED, SS$_NONEXPR, SS$_NOMOREPROC
C
C Set delta time for 3 minutes (note: system clock unit is 100 nanoseconds)
C
	DATA time/-three_minutes,-1/
D	DATA time/-fifteen_seconds,-1/	!Used for debugging
C
C Constant quadword value of ticks/second.
C
	DATA ticks_per_second/ one_second, 0/
C
C Set delta time for 2 seconds for sending pseudo-break
C
	DATA break_time/-two_seconds,-1/
C
C Setup condition handler to send signals to OPCOM
C
	CALL LIB_LOG_SIGNALS( 'unused', 'From Argus: !AS.',
	1		      OPC$M_NM_CENTRL, %VAL(2))
C
C Setup the $GETJPI item list.
C
	CALL SETUP_JPIBUF
C
C Initialize process sequence numbers to 0
C
	DO prcindex=1,maxprocess
	    procseqno(prcindex) = 0
	    ENDDO
C
C Initializations nearly done, see if there are any user's we can annoy on
C the first pass.
C
	status = sys$setprn('Argus')
	IF (.NOT.status) CALL ARGUSBUG(status)
C
C Initialize list of port selector terminals.
C
	CALL SETUP_PORT_LINES
C
C But first, a message from our sponsor ...
C The VMS scheduler which shall ring our bells every 3 minutes or so as we
C schedule the awakening of this corpus of a program ...
C
	status = SYS$SCHDWK(,, time, time)
	IF (.NOT.status) CALL ARGUSBUG(status)
C
C *** Start of Main Loop
C
	DO WHILE (.TRUE.)				!9999 ENDDO
	    any_killed = .FALSE.
	    DO portindex = 1,32
		port_killed( portindex) = .FALSE.
		ENDDO
C
C Calculate the time-of-day (in seconds) to check for prime time in order
C to set the grace factor.
C
	    CALL SYS$GETTIM( itime)		!Current system time
	    CALL MTH_QUAD_DIV( itime, ticks_per_second, itime)	!... in seconds
	    CALL MTH_QUAD_EDIV( itime, seconds_per_day,
	1			status, grace)	!Time-of-day in seconds
	    IF ((grace .LT. primetime_begin) .OR.
	1	(grace .GT. primetime_end)) THEN
		grace = offhours_grace		!More idling during off hours
		ELSE
		grace = 1			!No grace during prime time!
		ENDIF
C
C Do a wildcard $GETJPI to examine all the processes
C
	    seedpid = -1
	    getjpi_status = 0
C
C	Scan process list as long as there are processes to monitor
C
	    DO WHILE (getjpi_status .NE. %LOC(SS$_NOMOREPROC))	!999 ENDDO
C
C Get some information on a process
C
		getjpi_status =
	1	    SYS$GETJPI( %val(efn), seedpid,, jpibuf, jpi_iosb,,)
C
C If all OK so far, wait for the $GETJPI to finish
C
		IF (getjpi_status) CALL SYS$WAITFR( %VAL(efn))
C
C Check for end of process list
C
		IF (getjpi_status .EQ. %LOC(SS$_NOMOREPROC)) GOTO 999
C
C Check for any errors before starting checks
C
		IF (getjpi_status .NE. %LOC(SS$_SUSPENDED)) THEN
		    IF (.NOT.getjpi_status) CALL ARGUSBUG(getjpi_status)
		    status = jpi_iosb(1)
		    IF (.NOT.status) CALL ARGUSBUG(status)
		    ENDIF
C
C Check for process sequence number match (make sure same process as last
C time through this loop).
C
		IF (procseqno(prcindex) .NE. prcseqno) THEN
C
C New process, clear monitor information and save static information
C unless it is suspended ...
C
			IF (getjpi_status .EQ. %LOC(SS$_SUSPENDED))
	1			GOTO 999
C
			procseqno(prcindex) = prcseqno
			warning(prcindex) = 0
			cputime(prcindex) = newcputime
			bufiocnt(prcindex) = newbufioc
			diriocnt(prcindex) = newdirioc
C
C Save port selector line number (or 0=hard line/no terminal)
C
			portline(prcindex) =
	1			PORT_SELECTOR(terminal(1:terminal_len))
C
C Save process type (BATCH, DETACHED, INTERACTIVE, SUBPROCESS)
C
			IF (owner_pid .NE. 0) THEN
			    ptype = SUBPROCESS
			    ELSE IF (terminal_len .EQ. 0) THEN
			    IF (BTEST( pcbsts, PCB$V_BATCH)) THEN
				ptype = BATCH
				ELSE
				ptype = DETACHED
				ENDIF
			    ELSE
			    ptype = INTERACTIVE
			    ENDIF
			proctype(prcindex) = ptype
			GOTO 999	!Next process
			ENDIF
C
C Old process, set process type and port selector index
C
		    ptype = proctype(prcindex)
		    portindex = portline(prcindex)
C
C Check for suspended process using a port selector terminal.
C If not port selector line, ignore and continue with next process.
C
		IF (getjpi_status .EQ. %LOC(SS$_SUSPENDED)) THEN
		    IF (portindex .EQ. 0) GOTO 999	!Next process
		    warning(prcindex) = warning(prcindex) + 1
C
C Warning count incremented, but not sent to the suspended terminal.
C When delete count reached or exceeded, then kill the process and
C (to have the kill take effect) resume the process.
C
		    IF (warning(prcindex) .GE. delete_count) THEN
			CALL KILL_USER
			status = SYS$DELPRC( pid,)
			IF ((.NOT.status) .AND.
	1		    (status .NE. %LOC(SS$_NONEXPR)))
	2			CALL ARGUSBUG( status)
			status = SYS$RESUME( pid,)
			IF ((.NOT.status) .AND.
	1		    (status .NE. %LOC(SS$_NONEXPR)))
	2			CALL ARGUSBUG( status)
			any_killed = .TRUE.	!Tis a port line!
			port_killed(portindex) = .TRUE.
			ELSE
			CALL WARN_USER( grace*warning(prcindex),
	1				grace*warning_count,
	2				hard_warning_count)
			ENDIF
		    GOTO 999		!Next process
		    ENDIF
C
C Operating old process, compute time and I/O usage in interval.
C And save current CPU time and I/O counts for next interval.
C
		delta_cputime = newcputime - cputime(prcindex)
		delta_bufioc = newbufioc - bufiocnt(prcindex)
		delta_dirioc = newdirioc - diriocnt(prcindex)
		cputime(prcindex) = newcputime
		bufiocnt(prcindex) = newbufioc
		diriocnt(prcindex) = newdirioc
C
C Check for process idle during time interval
C
		IF ((delta_cputime .GT. min_cputime) .OR.
	1	    (delta_bufioc+delta_dirioc .GT. 0)) THEN
C
C Process did something since last pass, cancel warnings
C
		    warning(prcindex) = 0
C
C If process is a (busy) subprocess, decrement its owner process's warning
C count (holding at 0).
C
			IF (ptype .EQ. SUBPROCESS) THEN
			    warning(owner_prcindex) =
	1			warning(owner_prcindex) - 1
			    IF (warning(owner_prcindex).LT.0)
	1			warning(owner_prcindex) = 0
			    ENDIF
		    ELSE
C
C Process is idle, increment warning count.
C
		    warning(prcindex) = warning(prcindex) + 1
		    ENDIF
C
C If not an interactive process, skip to next process.
C Clear warning count for BATCH and DETACHED processes.
C
		IF (ptype .NE. INTERACTIVE) THEN
		    IF (ptype .NE. SUBPROCESS) warning(prcindex) = 0
		    GOTO 999
		    ENDIF
C
C Now check for warning/kill limit reached.  Different limits used for
C port selector lines and hard/network lines.
C
		wkstate = 0		!No action
		IF (portindex .EQ. 0) THEN
		    wkstate = TAKE_ACTION( warning(prcindex),
	1				   hard_warning_count,
	2				   hard_delete_count)
		    ELSE IF ((groupnum .LE. systems_group) .OR.
	1		     PRIVUSER( privileges)) THEN
C
C This is a privileged user with an idle process on a Port Selector line.
C
		    wkstate = TAKE_ACTION( warning(prcindex),
	1				   grace*warning_count,
	2				   grace*priv_delete_count)
		    ELSE
C
C This is a non-privileged user with an idle process on a Port Selector line.
C
		    wkstate = TAKE_ACTION( warning(prcindex),
	1				   grace*warning_count,
	2				   grace*delete_count)
		    ENDIF
C
C Do we have to generate a message, kill the process or take no action?
C
		IF (wkstate .LT. 0) THEN
C
C Kill!  Kill!  Kill the wabbit!  Kill the wabb.. Er! Ah!  Kill the process!
C ... and tell the user we did him in!
C
		    CALL KILL_USER
		    status = SYS$DELPRC( pid,)
		    IF ((.NOT.status) .AND.
	1		(status .NE. %LOC(SS$_NONEXPR)))
	2		    CALL ARGUSBUG(status)
C
C So we killed the process!     Boo Hoo, we killed the process (heh heh).
C Remember that if on a port selector line.
C
		    IF (portindex .GT. 0) THEN
			any_killed = .TRUE.
			port_killed(portindex) = .TRUE.
			ENDIF
		    ELSE IF (wkstate .GT. 0) THEN
C
C Aw shucks!  We just warn the user.
C
		    CALL WARN_USER( grace*warning(prcindex),
	1			    grace*warning_count,
	2			    hard_warning_count)
		    ENDIF
C
C End of process scan loop
C
999		ENDDO			!Loop over processes
C
C If any port selector processes killed, then send pseudo-breaks on those
C lines to disconnect the port selector (a pseudo-break is an ASCII NUL
C character at 50 baud).
C
	    IF (any_killed) THEN
		DO portindex = 1,32
		    IF (port_killed(portindex)) THEN
C
C After 2 seconds, send the pseudo_breaks to the port selector
C
			status = SYS$SETIMR(, two_seconds, SEND_A_BREAK,
	1				    %VAL(portindex),)
			IF (.NOT.status) CALL ARGUSBUG(status)
			ENDIF
		    ENDDO
		ENDIF
C
C Purge the working set so we don't impact the system greatly while waiting.
C
	    CALL PURGE_WORKING_SET
C
C And then go to sleep until Prince Charming (the Scheduler) awakens us
C with a kiss (the timer queue entry).
C
	    CALL SYS$HIBER()
C
C *** Go back to start of main loop
C
9999	    ENDDO			!Main loop -- forever --
C Never ever exits!
	END
	SUBROUTINE ARGUSBUG(condition_value)
	INTEGER*4 condition_value
C
C FUNCTION:
C	This subroutine handles Argus errors when a system service
C	returns an unexpected condition value.
C
C INPUTS:
C	condition_value is the long word with the returned status from
C		a system service or library call.
C
C OUTPUTS:
C	NONE
C
C SIDE EFFECTS:
C	For condition values with FATAL or ERROR severity, the image
C	will be exited.
C
	CALL lib$signal(%VAL(condition_value))
	RETURN
	END
	SUBROUTINE KILL_USER
C
C FUNCTION:
C	This procedure will broadcast a message to the terminal saying
C	that is about to be logged off.  Another message giving the
C	process identification, user name, and terminal
C	will be sent to the operator log file.
C
C INPUTS:
C	NONE
C
C OUTPUTS:
C	Message sent to the terminal.
C	Message sent to the CENTRAL operator and the operator log file.
C
	INCLUDE	'FERMI$LIB:LCLFORDEF($OPCDEF)' !Send-to-operator codes
C
	EXTERNAL SS$_DEVOFFLINE
C==============================================================================
C Commons with information on the current process under consideration.
C
	COMMON /PROC_INFO/ pid, owner_pid, privileges, pcbsts,
	1	newcputime, newbufioc, newdirioc, groupnum,
	2	account_len, username_len, terminal_len, procnam_len,
	3	ptype, portindex
	INTEGER*4 pid			!Process identification
	INTEGER*4 pcbsts		!Status bits from the PCB
	INTEGER*4 newcputime		!New process CPU time usage
	INTEGER*4 newbufioc		!New process buffered I/O count
	INTEGER*4 newdirioc		!New process direct I/O count
	INTEGER*4 groupnum		!Process group number
	INTEGER*4 privileges(2)		!Privileges bit mask
	INTEGER*4 owner_pid		!Process id of owner of subprocess
	INTEGER*4 account_len		!Length of account text
	INTEGER*4 username_len		!Length of username text
	INTEGER*4 terminal_len		!Length of terminal device text
	INTEGER*4 procnam_len		!Length of process name text
	INTEGER*2 portindex		!Port selector line index number
	INTEGER*2 ptype			!Process type
	INTEGER*2 BATCH			!Batch process
	INTEGER*2 INTERACTIVE		!Interactive process
	INTEGER*2 DETACHED		!Detached process
	INTEGER*2 SUBPROCESS		!Subprocess
	PARAMETER (INTERACTIVE=0, SUBPROCESS=1, DETACHED=2, BATCH=4)
C
	COMMON /PROC_TEXT/ account, terminal, username, process_name
	CHARACTER account*8		!Account name
	CHARACTER terminal*7		!Device name of terminal
	CHARACTER username*12		!Username
	CHARACTER process_name*15	!Process name
C
	INTEGER*2 prcindex		!Process index from pid
	INTEGER*2 prcseqno		!Process sequence number from pid
	INTEGER*2 pid__w(2)
	EQUIVALENCE (pid,prcindex,pid__w),(pid__w(2),prcseqno)
	INTEGER*2 owner_prcindex	!Owner process index
	EQUIVALENCE (owner_pid,owner_prcindex)
C=======
C
	INTEGER*4 status		!Completion status
	INTEGER*4 SYS$BRDCST		!Broadcast system service
	INTEGER*4 SYS$SNDOPR		!Send-to-operator system service
	CHARACTER message*80		!Buffer for message to terminal
	CHARACTER opr_msg*128		!Buffer for message to operator
	INTEGER*2 next,new
C
C Initialize message to blanks
C
	message = ' '
C
C Stick current time into the message
C
	CALL TIME( message(1:9))
	next = 10
C
C Add the terminal name to the message
C
	new = next + terminal_len + 1
	message(next:new) = terminal(1:terminal_len)
	next = new
C
C Finally fill out the message with the logging out text.
C
	message(next:80) = 'logged off by Argus.'
C
C Send message to the terminal with broadcast system service
C
	IF (terminal_len .GT. 0) THEN
	    status = SYS$BRDCST( message, terminal(1:terminal_len))
	    ELSE
	    status = 1			!No broadcast as no terminal name!
	    ENDIF
	IF (.NOT.status) THEN
C
C Allow the terminal to be off-line or not allowing broadcast messages
C
		IF (status .NE. %LOC(SS$_DEVOFFLINE))
	1		CALL ARGUSBUG(status)
		ENDIF
C
C Now build the message for the CENTRAL operator.
C
	next = OPC$B_MS_TYPE+1
	opr_msg(next:next) = CHAR(OPC$_RQ_RQST)
C
C Set target operator bit for CENTRAL
C
	next = OPC$B_MS_TARGET+1
	CALL LIB$INSV( 1, OPC$M_NM_CENTRL, 1, %REF(opr_msg(next:next)))
C
C Clear the request identification number (no reply)
C
	next = OPC$L_MS_RQSTID
	opr_msg(next+1:next+1) = CHAR(0)
	opr_msg(next+2:next+2) = CHAR(0)
	opr_msg(next+3:next+3) = CHAR(0)
	opr_msg(next+4:next+4) = CHAR(0)
C
C Setup the message text with process id, username and terminal name
C
	next = OPC$L_MS_TEXT + 1
	new = next + 8
	opr_msg(next:new) = 'Process'
	next = new
C
C Insert the process id (in hexadecimal)
C
	new = next + 9
	WRITE (opr_msg(next:new),100) pid
100	FORMAT(Z8)
	next = new
C
C Add the user name
C
	new = next + username_len + 1
	opr_msg(next:new) = username(1:username_len)
	next = new
C
C Add the terminal name
C
	new = next + terminal_len + 1
	opr_msg(next:new) = terminal(1:terminal_len)
	next = new
C
C Fill out with the text
C
	opr_msg(next:128) = 'idle and logged off by Argus'
C
C Send the message to the operator
C
	status = SYS$SNDOPR( opr_msg,)
	IF (.NOT.status) THEN
C
C Allow for no such operator enabled (and ignore such an error).
C
		IF (status .NE. %LOC(SS$_DEVOFFLINE))
	1		CALL ARGUSBUG(status)
		ENDIF
	RETURN
	END
	INTEGER*4 FUNCTION PORT_SELECTOR( terminal )
	CHARACTER*(*) terminal
C
C FUNCTION:
C	This function returns the port selector line given the terminal
C	number.
C
C INPUTS:
C	terminal is the character string giving the name of the terminal
C	in the form "TTCn:".
C
C OUTPUTS:
C	Function returns non-zero for port selector lines and 0 otherwise.
C
	COMMON /PORT_TTYN/ n_port_ttys
	INTEGER*4 n_port_ttys		!Number of port selector lines
	COMMON /PORT_TTYS/ port_tty_line(32), port_controllers
	CHARACTER*5 port_tty_line	!Terminal name of port selector line
	CHARACTER*16 port_controllers	!List of terminal controllers with ...
C
	INTEGER*4 ii
C
	port_selector = 0
C
	IF (LEN(terminal) .EQ. 0) RETURN
	IF (LEN(terminal) .LT. 5) RETURN
C
C Quick check by searching controller list.
C
	IF (INDEX( port_controllers, terminal(3:3)) .EQ. 0) RETURN
C
	DO ii = 1,n_port_ttys
	    IF (terminal .EQ. port_tty_line(ii)) THEN
		port_selector = ii
		RETURN
		ENDIF
	    ENDDO
C
	RETURN
	END
	LOGICAL FUNCTION PRIVUSER( privilege_mask)
	INTEGER*4 privilege_mask(2)
C
C FUNCTION:
C	This function tests for a privileged user defined by having at least
C	one of the privileges SETPRV, SYSPRV, DETACH or CMKRNL set in his
C	authorized privilege mask.
C
C INPUTS:
C	The 64-bit privilege mask in privilege_mask.
C
C OUTPUTS:
C	Function value is .TRUE. if any of the SETPRV, SYSPRV, DETACH or CMKRNL
C	privilege bits are ON in the privilege mask.  .FALSE. is returned only
C	if all of these bits are OFF.
C
	INCLUDE 'FERMI$LIB:LCLFORDEF($PRVDEF)'
	LOGICAL*4 LIB$EXTV
C
C
C Test for the privilege bits on
C
	IF (LIB$EXTV(PRV$V_SETPRV,1,privilege_mask) .OR.
	1   LIB$EXTV(PRV$V_SYSPRV,1,privilege_mask) .OR.
	2   LIB$EXTV(PRV$V_DETACH,1,privilege_mask) .OR.
	3   LIB$EXTV(PRV$V_CMKRNL,1,privilege_mask)) THEN
C
C This is a privileged user, he has at least one of SYSPRV, SETPRV, DETACH
C or CMKRNL privileges.
C
		privuser = .TRUE.
		ELSE
C
C This is not a privileged user.
C
		privuser = .FALSE.
		ENDIF
	RETURN
	END
	SUBROUTINE PURGE_WORKING_SET
C
C FUNCTION:
C	This procedure will purge the entire working set from physical memory.
C
C INPUTS:
C	NONE
C OUTPUTS:
C	NONE
C
	INTEGER*4 range(2)		!Address range for all P0 and P1 space
	INTEGER*4 SYS$PURGWS		!Purge working set service
	INTEGER*4 status		!Completion status
C
C This range of addresses will purge the entire working set as it specifies
C all of the address space.
C
	DATA range/0,'7FFFFFFF'X/
C
	status = sys$purgws(range)
	IF (.not.status) CALL ARGUSBUG(status)
	RETURN
	END
	SUBROUTINE SEND_A_BREAK( port_i)
	INTEGER*4 port_i
C
C FUNCTION:
C	Send a pseudo-break to the port selector over a specific VAX
C	terminal line.
C
C INPUTS:
C	The terminal line index (1-4) for the particular port selector
C	line as an immediate value!
C
C OUTPUTS:
C	NONE
C
	INCLUDE 'FERMI$LIB:LCLFORDEF($IODEF)'
	INCLUDE	'FERMI$LIB:LCLFORDEF($TTDEF)'
C
	COMMON /PORT_TTYN/ n_port_ttys
	INTEGER*4 n_port_ttys		!Number of port selector lines
	COMMON /PORT_TTYS/ port_tty_line(32), port_controllers
	CHARACTER*5 port_tty_line	!Terminal name of port selector line
	CHARACTER*16 port_controllers	!List of terminal controllers with ...
C
	EXTERNAL SS$_DEVOFFLINE, SS$_DEVALLOC
C
	INTEGER*4 port			!Port number
	INTEGER*2 iosb(4)		!I/O status block
	INTEGER*2 chan			!I/O channel number
	INTEGER*2 speed			!Terminal baud setting
	INTEGER*4 status		!Completion status
	INTEGER*4 SYS$ASSIGN		!Assign I/O channel service
	INTEGER*4 SYS$QIOW		!System I/O service
	INTEGER*4 SYS$DASSGN		!Deassign I/O channel service
	INTEGER*4 characteristics(2)	!Device characteristics buffer
C
	port = %LOC(port_i)		!Get port line number
	IF (port .EQ. 0) RETURN		!Hardline, not port selector line
C
C Assign channel to terminal
C
	status = SYS$ASSIGN( port_tty_line(port), chan,,)
	IF (.NOT.status) THEN
	    IF (status.NE.%LOC(SS$_DEVALLOC)) CALL ARGUSBUG(status)
	    RETURN
	    ENDIF
C
C Get current terminal baud setting and characteristics
C
	status = SYS$QIOW(%VAL(port),%VAL(chan),%VAL(IO$_SENSECHAR),
	2		iosb,,,characteristics,,,,,)
	IF (.NOT.status) CALL ARGUSBUG(status)
	status = iosb(1)
	IF (.NOT.status) CALL ARGUSBUG(status)
	speed = iosb(2)		!Save current baud rate setting
C
C Set PASSALL characteristic and speed to 50 baud
C
	characteristics(2) = characteristics(2) .OR. TT$M_PASSALL
	status = SYS$QIOW(%VAL(port),%VAL(chan),%VAL(IO$_SETCHAR),
	2		iosb,,,characteristics,,%VAL(TT$C_BAUD_50),,,)
	IF (.NOT.status) CALL ARGUSBUG(status)
	status = iosb(1)
	IF (.NOT.status) CALL ARGUSBUG(status)
C
C Now send 4 NUL characters to simulate breaks to the port selector
C
	status = SYS$QIOW(%VAL(port),%VAL(chan),%VAL(IO$_WRITEPBLK),
	2		iosb,,,0,%VAL(4),,,,)
	IF (.NOT.status) CALL ARGUSBUG(status)
	status = iosb(1)
	IF (.NOT.status) CALL ARGUSBUG(status)
C
C Restore previous terminal baud rate and characteristics
C
	characteristics(2) = characteristics(2) .AND.
	2			(.NOT.TT$M_PASSALL)
	status = SYS$QIOW(%VAL(port),%VAL(chan),%VAL(IO$_SETCHAR),
	2		iosb,,,characteristics,,%VAL(speed),,,)
	IF (.NOT.status) CALL ARGUSBUG(status)
	status = iosb(1)
	IF (.NOT.status) CALL ARGUSBUG(status)
C
C Deassign the channel to disconnect from the terminal line
C
	status = SYS$DASSGN(%VAL(chan))
	IF (.NOT.status) CALL ARGUSBUG(status)
C
	RETURN
	END
	SUBROUTINE  SETUP_JPIBUF
C
C+/SETUP_JPIBUF
C
C Functional Description:
C	Setup item list for $GETJPI.
C
C Input Parameters:
C	NONE
C
C Implicit Inputs:
C	/PROC_INFO/ - process information items whose addresses are needed
C	/PROC_TEXT/ - process text items whose addresses are needed
C
C Output Parameters:
C	NONE
C
C Implicit Outputs:
C	/GETJPI_ITEM_LIST/ - item list setup in this buffer
C
C Condition Codes Signalled:
C	NONE
C
C Side Effects:
C	NONE
C-
	INCLUDE 'SYS$LIBRARY:FORSYSDEF($JPIDEF)' !Job/process information codes
C
	INTEGER*4 item_count		!number of $GETJPI items in list
	PARAMETER (item_count = 12)
C==============================================================================
C Commons with information on the current process under consideration.
C
	COMMON /PROC_INFO/ pid, owner_pid, privileges, pcbsts,
	1	newcputime, newbufioc, newdirioc, groupnum,
	2	account_len, username_len, terminal_len, procnam_len,
	3	ptype, portindex
	INTEGER*4 pid			!Process identification
	INTEGER*4 pcbsts		!Status bits from the PCB
	INTEGER*4 newcputime		!New process CPU time usage
	INTEGER*4 newbufioc		!New process buffered I/O count
	INTEGER*4 newdirioc		!New process direct I/O count
	INTEGER*4 groupnum		!Process group number
	INTEGER*4 privileges(2)		!Privileges bit mask
	INTEGER*4 owner_pid		!Process id of owner of subprocess
	INTEGER*4 account_len		!Length of account text
	INTEGER*4 username_len		!Length of username text
	INTEGER*4 terminal_len		!Length of terminal device text
	INTEGER*4 procnam_len		!Length of process name text
	INTEGER*2 portindex		!Port selector line index number
	INTEGER*2 ptype			!Process type
	INTEGER*2 BATCH			!Batch process
	INTEGER*2 INTERACTIVE		!Interactive process
	INTEGER*2 DETACHED		!Detached process
	INTEGER*2 SUBPROCESS		!Subprocess
	PARAMETER (INTERACTIVE=0, SUBPROCESS=1, DETACHED=2, BATCH=4)
C
	COMMON /PROC_TEXT/ account, terminal, username, process_name
	CHARACTER account*8		!Account name
	CHARACTER terminal*7		!Device name of terminal
	CHARACTER username*12		!Username
	CHARACTER process_name*15	!Process name
C
	INTEGER*2 prcindex		!Process index from pid
	INTEGER*2 prcseqno		!Process sequence number from pid
	INTEGER*2 pid__w(2)
	EQUIVALENCE (pid,prcindex,pid__w),(pid__w(2),prcseqno)
	INTEGER*2 owner_prcindex	!Owner process index
	EQUIVALENCE (owner_pid,owner_prcindex)
C=======
C==============================================================================
C
C Buffer for list of items from $GETJPI
C
	COMMON /GETJPI_ITEM_LIST/ jpibuf__l
	INTEGER*4 jpibuf__l(3*item_count+1)
C=======
	INTEGER*2 jpibuf__w(6*item_count+2)
	EQUIVALENCE (jpibuf__l,jpibuf__w)
C
C statement functions to determine $GETJPI item list for first word or
C long word for a particular item.
C
	item_word(itemno) = 6*itemno - 5
	item_long(itemno) = 3*itemno - 1
C
C				item 1 = process identification code
	jpibuf__w(item_word( 1)+1) = JPI$_PID
	jpibuf__w(item_word( 1)  ) = 4
	jpibuf__l(item_long( 1)  ) = %LOC(pid)
	jpibuf__l(item_long( 1)+1) = 0
C				item 2 = process name string
	jpibuf__w(item_word( 2)+1) = JPI$_PRCNAM
	jpibuf__w(item_word( 2)  ) = LEN(process_name)
	jpibuf__l(item_long( 2)  ) = %LOC(process_name)
	jpibuf__l(item_long( 2)+1) = %LOC(procnam_len)
C				item 3 = accumulated CPU time (in 10 ms units)
	jpibuf__w(item_word( 3)+1) = JPI$_CPUTIM
	jpibuf__w(item_word( 3)  ) = 4
	jpibuf__l(item_long( 3)  ) = %LOC(newcputime)
	jpibuf__l(item_long( 3)+1) = 0
C				item 4 = accumulated buffered I/O count
	jpibuf__w(item_word( 4)+1) = JPI$_BUFIO
	jpibuf__w(item_word( 4)  ) = 4
	jpibuf__l(item_long( 4)  ) = %LOC(newbufioc)
	jpibuf__l(item_long( 4)+1) = 0
C				item 5 = accumulated direct I/O operation count
	jpibuf__w(item_word( 5)+1) = JPI$_DIRIO
	jpibuf__w(item_word( 5)  ) = 4
	jpibuf__l(item_long( 5)  ) = %LOC(newdirioc)
	jpibuf__l(item_long( 5)+1) = 0
C				item 6 = user name string
	jpibuf__w(item_word( 6)+1) = JPI$_USERNAME
	jpibuf__w(item_word( 6)  ) = LEN(username)
	jpibuf__l(item_long( 6)  ) = %LOC(username)
	jpibuf__l(item_long( 6)+1) = %LOC(username_len)
C				item 7 = account name string
	jpibuf__w(item_word( 7)+1) = JPI$_ACCOUNT
	jpibuf__w(item_word( 7)  ) = LEN(account)
	jpibuf__l(item_long( 7)  ) = %LOC(account)
	jpibuf__l(item_long( 7)+1) = %LOC(account_len)
C				item 8 = terminal name string
	jpibuf__w(item_word( 8)+1) = JPI$_TERMINAL
	jpibuf__w(item_word( 8)  ) = LEN(terminal)
	jpibuf__l(item_long( 8)  ) = %LOC(terminal)
	jpibuf__l(item_long( 8)+1) = %LOC(terminal_len)
C				item 9 = group number
	jpibuf__w(item_word( 9)+1) = JPI$_GRP
	jpibuf__w(item_word( 9)  ) = 4
	jpibuf__l(item_long( 9)  ) = %LOC(groupnum)
	jpibuf__l(item_long( 9)+1) = 0
C				item 10 = authorized privileges
	jpibuf__w(item_word(10)+1) = JPI$_AUTHPRIV
	jpibuf__w(item_word(10)  ) = 8
	jpibuf__l(item_long(10)  ) = %LOC(privileges)
	jpibuf__l(item_long(10)+1) = 0
C				item 11 = process id of owner process
	jpibuf__w(item_word(11)+1) = JPI$_OWNER
	jpibuf__w(item_word(11)  ) = 4
	jpibuf__l(item_long(11)  ) = %LOC(owner_pid)
	jpibuf__l(item_long(11)+1) = 0
C				item 12 = process status bits from PCB
	jpibuf__w(item_word(12)+1) = JPI$_STS
	jpibuf__w(item_word(12)  ) = 4
	jpibuf__l(item_long(12)  ) = %LOC(pcbsts)
	jpibuf__l(item_long(12)+1) = 0
C				end of list
	jpibuf__l(3*item_count+1) = 0
C
	RETURN
	END
	SUBROUTINE  SETUP_PORT_LINES
C
C+/SETUP_PORT_LINES
C
C Functional Description:
C	Setup common with list of terminal lines connected to the Micom
C	Port Selector.
C
C Input Parameters:
C	NONE
C
C Implicit Inputs:
C	NONE
C
C Output Parameters:
C	NONE
C
C Implicit Outputs:
C	port_tty_line - terminal device name of port selector terminal lines
C	n_port_ttys - number of port selector lines
C	port_controllers - list of terminal controllers with port lines
C
C Condition Codes Signalled:
C	See $TRNLOG system service.
C
C Side Effects:
C	The port selector terminal list is initialzed for lines TTC4:, TTC5:,
C	TTC6: and TTC7: (applicable to the Fermilab Accelerator Division's
C	ACNET Software Development VAX).  If the logical name ARGUS_PORTS is
C	defined, then it must contain a list of port selector lines which
C	override the DATA'd list.  The DATA'd list is equivalent to:
C
C		$ DEFINE  ARGUS_PORTS  TTC4:TTC5:TTC6:TTC7:
C
C	Note the lack of spaces and the presence of the ":" characters!
C-
	COMMON /PORT_TTYN/ n_port_ttys
	INTEGER*4 n_port_ttys		!Number of port selector lines
	COMMON /PORT_TTYS/ port_tty_line(32), port_controllers
	CHARACTER*5 port_tty_line	!Terminal name of port selector line
	CHARACTER*16 port_controllers	!List of terminal controllers with ...
C
	DATA n_port_ttys/ 4/
	DATA port_tty_line/ 'TTC4:', 'TTC5:', 'TTC6:', 'TTC7:', 28*' '/
	DATA port_controllers/ 'C'/
C
	INTEGER*4 SYS$TRNLOG		!Translate logical name service
	INTEGER*4 status		!Completion status
	INTEGER*2 ll,lx,tx		!Indices for arrays/substrings
	CHARACTER*63 etext		!Logical name equivalence text
	INTEGER*2 length		!Length of equivalence text
	EXTERNAL  SS$_NOTRAN
C
C Translate logical name, signal error and exit if no such logical name.
C
	status = SYS$TRNLOG( 'ARGUS_PORTS', length, etext,,,)
	IF (.NOT.status) CALL ARGUSBUG( status)
	IF (status .EQ. %LOC(SS$_NOTRAN)) RETURN
C
C Now decompose TTcu:TTcu:... text into separate terminal names.
C
	tx = 1				!Terminal index
	ll = 1				!Start position in string
	DO WHILE (ll .LT. length)
	    lx = INDEX( etext(ll:length), ':')
	    IF (lx .EQ. 0) THEN
		ll = length + 1		!No ":", terminate scan
		ELSE
		port_tty_line(tx) = etext(ll:lx)
		tx = tx + 1		!To next slot in array
		ll = lx + 1
		ENDIF
	    ENDDO
	n_port_ttys = tx - 1		!Count of terminals
C
C Now scan to setup the list of terminal controllers
C
	ll = 1
	port_controllers = port_tty_line(1)(3:3)
	DO tx = 1,n_port_ttys
	    lx = INDEX( port_controllers, port_tty_line(tx)(3:3))
	    IF (lx .EQ. 0) THEN
		ll = ll + 1		!New controller added
		port_controllers(ll:ll) = port_tty_line(tx)(3:3)
		ENDIF
	    ENDDO
C
	RETURN
	END
	INTEGER*4 FUNCTION  TAKE_ACTION( count, warn_on, kill_on)
C
	IMPLICIT INTEGER*4 (A-Z)
	INTEGER*2 count, warn_on, kill_on
C
C+/TAKE_ACTION
C
C Functional Description:
C	Calculate state code for action to be taken at this still-idle count.
C
C Input Parameters:
C	count - current idle interval count.
C	warn_on - send warning message every "n" idle intervals.
C	kill_on - kill process after "n" total idle intervals.
C
C Implicit Inputs:
C	NONE
C
C Output Parameters:
C	Returns state code:
C		-1  kill process, idle time exceeded
C		 0  no action
C		+1  send warning message to idle terminal
C
C Implicit Outputs:
C	NONE
C
C Condition Codes Signalled:
C	NONE
C
C Side Effects:
C	NONE
C-
	IF (count .GE. kill_on) THEN
	    take_action = -1		!Kill process!
	    ELSE IF ((count .GT. 0) .AND.
	1	     (MOD( count, warn_on) .EQ. 0)) THEN
	    take_action = +1		!Warning message
	    ELSE
	    take_action = 0		!No action (at this time)
	    ENDIF
C
	RETURN
	END
	SUBROUTINE WARN_USER( warning_count, t1, t2 )
	INTEGER*2 warning_count, t1, t2
C
C FUNCTION:
C	This procedure will broadcast a message to the specified terminal.
C	This message will warn the user that his process has been idle and
C	is a candidate for being logged off by us.
C
C INPUTS:
C	warning_count is the count of the number of times the user has been
C	warned (including this one).
C	t1 and t2 are values to test warning_count against for the "first"
C	warning.
C
C OUTPUTS:
C	Message sent to the terminal.
C
	EXTERNAL SS$_DEVOFFLINE
C==============================================================================
C Commons with information on the current process under consideration.
C
	COMMON /PROC_INFO/ pid, owner_pid, privileges, pcbsts,
	1	newcputime, newbufioc, newdirioc, groupnum,
	2	account_len, username_len, terminal_len, procnam_len,
	3	ptype, portindex
	INTEGER*4 pid			!Process identification
	INTEGER*4 pcbsts		!Status bits from the PCB
	INTEGER*4 newcputime		!New process CPU time usage
	INTEGER*4 newbufioc		!New process buffered I/O count
	INTEGER*4 newdirioc		!New process direct I/O count
	INTEGER*4 groupnum		!Process group number
	INTEGER*4 privileges(2)		!Privileges bit mask
	INTEGER*4 owner_pid		!Process id of owner of subprocess
	INTEGER*4 account_len		!Length of account text
	INTEGER*4 username_len		!Length of username text
	INTEGER*4 terminal_len		!Length of terminal device text
	INTEGER*4 procnam_len		!Length of process name text
	INTEGER*2 portindex		!Port selector line index number
	INTEGER*2 ptype			!Process type
	INTEGER*2 BATCH			!Batch process
	INTEGER*2 INTERACTIVE		!Interactive process
	INTEGER*2 DETACHED		!Detached process
	INTEGER*2 SUBPROCESS		!Subprocess
	PARAMETER (INTERACTIVE=0, SUBPROCESS=1, DETACHED=2, BATCH=4)
C
	COMMON /PROC_TEXT/ account, terminal, username, process_name
	CHARACTER account*8		!Account name
	CHARACTER terminal*7		!Device name of terminal
	CHARACTER username*12		!Username
	CHARACTER process_name*15	!Process name
C
	INTEGER*2 prcindex		!Process index from pid
	INTEGER*2 prcseqno		!Process sequence number from pid
	INTEGER*2 pid__w(2)
	EQUIVALENCE (pid,prcindex,pid__w),(pid__w(2),prcseqno)
	INTEGER*2 owner_prcindex	!Owner process index
	EQUIVALENCE (owner_pid,owner_prcindex)
C=======
C
	INTEGER*4 status		!Completion status
	INTEGER*4 SYS$BRDCST		!Broadcast system service
	CHARACTER message*80		!Message for broadcast to terminal
	INTEGER*2 next,new		!String indices
C
C Initialize message to blanks and beeps (BEL is 7)
C
	message = CHAR(7)//' '
C
C Stick current time into the message
C
	CALL TIME( message(2:10))
	message(11:11) = CHAR(7)
	next = 12
C
C Add the user's name to the message
C
	new = next + username_len + 1
	message(next:new) = username(1:username_len)
	next = new
C
C Add the terminal name to the message
C
	new = next + terminal_len + 1
	message(next:new) = terminal(1:terminal_len)
	next = new
C
C Finally fill out the message with the warning text.
C
	IF ((warning_count .EQ. t1) .OR.
	1   (warning_count .EQ. t2)) THEN
C
C First warning -
C
	    CALL SYS$FAO( 'has been idle for !UW minutes.',,
	1		  message(next:80), %VAL(3*warning_count))
	    ELSE
C
C All subsequent warnings -
C
	    message(next:80) =
	1		'continues to be idle; will be logged off.'
	    ENDIF
C
C Send message to the terminal with broadcast system service
C
	status = SYS$BRDCST( message, terminal(1:terminal_len))
	IF (.NOT.status) THEN
C
C Allow the terminal to be off-line or not allowing broadcast messages
C
	    IF (status .NE. %LOC(SS$_DEVOFFLINE))
	1			CALL ARGUSBUG(status)
	    ENDIF
C
	RETURN
	END