C***********************************************************************
C
C  PROGRAM LTMONITOR
C
C  This program mostly just hibernates, but wakes up at a predefined
C  interval to see if it can clobber any terminal users that have
C  left their terminals unused for too long.  The method employed
C  is thus:
C
C	0) Program searches through all processes:
C	1) If the process has a terminal, and is interactive, 
C	   check if the terminal's process hasn't budged in about 60 minutes
C	   (no change in CPU, Buffered I/O, Direct I/O, pagefaults)
C	   then clobber it, with a message too.
C
C In practice we run this program as a detached process fired up by the
C system startup file.
C
C
C***********************************************************************
C
	PROGRAM		LTMONITOR
	IMPLICIT	NONE
C
	parameter	max_process_cnt=96
C
C poll interval
C
	character*13	interval
	data		interval/'0 00:10:00.00'/ ! 10 min hibernation
	integer*2	timer(4)
C
C User arrays, with pid, and terminal number
C
	integer		upid(max_process_cnt)
	integer		ustat(8,max_process_cnt)
C
C----------------------
C Program initilization
C----------------------
C
C Set up the hibernation time
C
	CALL SYS$BINTIM(INTERVAL,TIMER)
C
C Set the scheduled wake up
C
	CALL SYS$SCHDWK(,,TIMER,TIMER)
C
C Now go to sleep....
C
	DO WHILE (.TRUE.)
	   CALL SYS$HIBER
	   call proc_chk( upid, ustat, max_process_cnt )
	END DO
	END
C*********************************************************************
C
C  SUBROUTINE PROC_CHK
C
C  This routine checks all processes for disuse ... if unused
C  for more than DISUSE_MINUTES the process is deleted.  If a
C  process has subprocesses, dis-use is not checked at all.
C  "Disuse" is defined as no change in CPU, BIO, DIO or pagefaults
C  in the time allotted.
C
C  1985 07 11 / JA Lloyd
C    
C  Inputs:
C    pids is an array of pids from last time executed
C    stats is array of status corresponding to the pids
C    pid_size is length of pids
C  Outputs:
C    upid, ustat are updated, maybe
C
C  side effects
C    qualified prospects are terminated with extreme prejudice
C
C*********************************************************************
C
	SUBROUTINE PROC_CHK( pids, stats, pid_size )
	IMPLICIT	NONE
C
	parameter	disuse_minutes = 60
	parameter	cr=char(13), lf=char(10)
	parameter	delprcmsg = cr//lf//lf//
     *  	'%SYSTEM-I-DISUSE, your terminal LOGGED OUT for disuse.'
	parameter	bell=char(7)
C
	parameter
     *  		pid = 1,	! current pid of terminal's process
     *  		cputim = 2,	! last measured cpu time
     *  		bufioc = 3,	! last measured buff io count
     *  		dirioc = 4,	! last measured direct io count
     *  		pgfltc = 5,	! last measured pagefault count
     *  		timec1 = 6,	! last measure time (lo order 32b)
     *  		timec2 = 7	! last measure time (hi order 32b)
C
C  Parameters to routine
C
	integer		pid_size
	integer		pids(pid_size)
	integer		stats(8,pid_size)
C
C  Locals 
C
	integer
     *  		newcpu,		! cpu time, 10 ms units
     *  		newbioc,	! buffered io count
     *  		newdioc,	! direct io count
     *  		newpgflts,	! count of pagefaults incurred
     *  		subcount,	! count of subprocesses
     *  		iosb(2)		! status block of GETxxx services
	character*(8)	procterm	! terminal name of interactive process

C
C  Request list for $GETJPI
C
	integer*2	jpibuf(56)
	integer		cpuaddr, cpulen, newcpu_l
	integer		bioaddr, biolen, newbioc_l
	integer		dioaddr, diolen, newdioc_l
	integer		pgfltsaddr, pgfltslen, newpgflts_l
	integer		prccaddr, prcclen
	integer		proctermaddr, proctermlen, procterm_l
C
C  Request list for $GETDVI service
C
	integer*2	dvibuf(36)		! request list for $GETDVI
	integer		newchar, newchar_l	! device characteristics
	integer		newcharaddr, newcharlen
	integer		newpid, newpid_l	! pid owning the terminal
	integer		newpidaddr, newpidlen
	integer		newdep2, newdep2_l	! 2ndary tt characteristics
	integer		newdep2addr, newdep2len
C
	logical*1	jpiinit /.false./
	save		jpiinit, jpibuf, dvibuf
C
C  Others
C
	integer		now(2), r(2), diffe(2)
	integer		s, t, p, mins
	logical*1	puse(1024)
C
	EXTERNAL	ss$_normal, ss$_timeout, ss$_nomoreproc
	EXTERNAL	ss$_suspended
	EXTERNAL	brk$c_device
	EXTERNAL	jpi$_pid,jpi$_cputim,jpi$_bufio,jpi$_dirio
	EXTERNAL	jpi$_pageflts
	EXTERNAL	jpi$_prccnt,jpi$_terminal,jpi$c_listend
	external	dvi$_pid, dvi$_devchar, dev$m_spl
	external	dvi$_devdepend2, tt$m_nobrdcst
C
	external	sys$gettim
	integer		sys$delprc, sys$brkthruw
	integer		sys$getdviw, sys$getjpiw, sys$waitfr
C
C	Define the contents of the request buffers
C
C  jpi buffer
C
	equivalence(jpibuf(3),cpuaddr)
	equivalence(jpibuf(5),cpulen)
	equivalence(jpibuf(9),bioaddr)
	equivalence(jpibuf(11),biolen)
	equivalence(jpibuf(15),dioaddr)
	equivalence(jpibuf(17),diolen)
	equivalence(jpibuf(21),pgfltsaddr)
	equivalence(jpibuf(23),pgfltslen)
	equivalence(jpibuf(27),prccaddr)
	equivalence(jpibuf(29),prcclen)
	equivalence(jpibuf(33),proctermaddr)
	equivalence(jpibuf(35),proctermlen)
C
C  dvi buffer
C
	equivalence(dvibuf(3),newpidaddr)
	equivalence(dvibuf(5),newpidlen)
	equivalence(dvibuf(9),newcharaddr)
	equivalence(dvibuf(11),newcharlen)
	equivalence(dvibuf(13),newdep2len)
C
C  First time, init the pointers
C
	if( .not. jpiinit ) then
	   jpiinit = .true.
C
C	GET THE CPU TIME USED
C
	JPIBUF(1)=4
	JPIBUF(2)=%LOC(jpi$_cputim)
	CPUADDR=%loc(newcpu)
	CPULEN=%LOC(NEWCPU_L)
C
C	GET THE BUFFERED I/O COUNT
C
	JPIBUF(7)=4
	jpibuf(8)=%LOC(jpi$_bufio)
	BIOADDR=%loc(newbioc)
	BIOLEN=%LOC(NEWBIOC_L)
C
C	GET THE Direct I/O COUNT
C
	JPIBUF(13)=4
	jpibuf(14)=%LOC(jpi$_dirio)
	DIOADDR=%loc(newdioc)
	DIOLEN=%LOC(NEWDIOC_L)
C
C	GET THE Pagefault COUNT
C
	JPIBUF(19)=4
	jpibuf(20)=%LOC(jpi$_pageflts)
	pgfltsaddr=%loc(newpgflts)
	pgfltslen=%loc(newpgflts_l)
C
C	GET THE NUMBER OF SUBPROCESSES
C
	JPIBUF(25)=4
	JPIBUF(26)=%LOC(JPI$_PRCCNT)
	PRCCADDR=%LOC(SUBCOUNT)
	PRCCLEN=0
C
C	get the terminal attached to the process
C
	jpibuf(31)=8
	jpibuf(32)=%loc(jpi$_terminal)
	proctermaddr=%loc(procterm)
	proctermlen=%loc(procterm_l)
C
C	END OF LIST
C
	jpibuf(37)=0
	jpibuf(38)=%LOC(JPI$C_LISTEND)

C
C  Device information
C
C  PID:
C
	dvibuf(1) = 4
	dvibuf(2) = %loc(dvi$_pid)
	newpidaddr = %loc( newpid )
	newpidlen = %loc( newpid_l )
C
C  Device independant characteristics
C
	dvibuf(7) = 4
	dvibuf(8) = %loc(dvi$_devchar)
	newcharaddr = %loc( newchar )
	newcharlen = %loc( newchar_l )
C
C  2nd longword of device dependant characteristics (terminal)
C
	dvibuf(13) = 4
	dvibuf(14) = %loc(dvi$_devdepend2)
	newdep2addr = %loc( newdep2 )
	newdep2len = %loc( newdep2_l )
C
C  End of list
C
	dvibuf(19) = 0
	dvibuf(20) = 0
C
	endif
C
C=======
C  Begin
C=======
C
C
C  Find out about processes
C
	p=-1
	call lib$movc5(0,,.false.,pid_size,puse)
	do while (.true.)
	s = sys$getjpiw(%val(1), p,,jpibuf,iosb,,)
	if( s .eq. %loc( ss$_nomoreproc ) ) goto 200
	if( s .ne. %loc( ss$_normal ) ) goto 100
	if( iosb(1) .ne. %loc( ss$_normal ) ) goto 100
C
C  If process has no terminal, assume not interactive
C
	if( procterm_l .le. 0 ) goto 100
C
C  If current owner has subprocesses, ignore him
C
	   if( subcount .ne. 0 ) goto 100
D	type 900, p, newcpu, newbioc, newdioc, procterm
D900	format( ' pid ', z9, ' cpu ', i9, ' bio ', i9,
D    *          ' dio ', i9, ' tt  ', a )
C
C  Check terminal has an owner, and its the same owner
C
	s = sys$getdviw( %val(1), , procterm(:procterm_l), 
     *  dvibuf, iosb, , , )
	if( s .ne. %loc( ss$_normal ) ) goto 100
	if( (newpid_l .eq. 0) ) goto 100
C
C  check if device is spooled
C
	if( 0 .ne. ( %loc(dev$m_spl) .and. newchar ) ) goto 100
C
C  check if pid was known
C
	t=1
	call sys$gettim( now )
	do while( (pids(t) .ne. p) )
	   t=t+1
	   if( t .gt. pid_size ) then
	      t=1
	      do while( t .le. pid_size )
		if( pids(t) .eq. 0 ) then
		puse(t)=.true.
		pids(t)=p
	        stats( pid, t ) = newpid
	        stats( cputim, t ) = newcpu
	        stats( bufioc, t ) = newbioc
	        stats( dirioc, t ) = newdioc
	        stats( pgfltc, t ) = newpgflts
	        stats( timec1, t ) = now(1)
	        stats( timec2, t ) = now(2)
D		type *,' ...added'
		goto 100
		endif
	        t=t+1
	      end do
C
C	      End of pid list... no more space to keep track!
C
	      call sys$brkthruw( %val(0), 
     *  	'%LTMONITOR-E-XPRC process count '//bell//
     *  	'exceeds limit...recompile', 'OPA0:',
     *  	BRK$C_DEVICE, iosb, , ,,,,, )
	      call lib$stop( ss$_timeout )
	   endif
	end do
C
C  Is it the same owner, or has current owner done anything
C
	if( (newpid .ne. stats( pid, t )) .or.
     *  	(stats( cputim, t ) .ne. newcpu ) .or.
     *  	(stats( bufioc, t ) .ne. newbioc) .or.
     *  	(stats( dirioc, t ) .ne. newdioc) .or.
     *  	(stats( pgfltc, t ) .ne. newpgflts) ) then
	   puse( t ) = .true.
	   stats( pid, t ) = newpid
	   stats( cputim, t ) = newcpu
	   stats( bufioc, t ) = newbioc
	   stats( dirioc, t ) = newdioc
	   stats( pgfltc, t ) = newpgflts
	   stats( timec1, t ) = now(1)
	   stats( timec2, t ) = now(2)
D	   type *,' ...reprieved'
	   goto 100
	endif
C
C  See if current owner has done anything recently
C
	   call lib$subx( now, stats( timec1, t ), diffe )
	   call lib$ediv( 60 * 10 000 000, diffe, mins, r )
	   if( mins .gt. disuse_minutes ) then
	        call sys$brkthruw( %val(0), delprcmsg, 
     *  	procterm(:procterm_l),
     *  	BRK$C_DEVICE, iosb, , ,,,,, )
	      call sys$delprc( newpid, )
D	      type *, ' ...terminated'
	   else
	      puse( t ) = .true.
	   endif
100	end do
C
C  clean arrays for logged off processes
C
200	do t=1,pid_size
	if( .not. puse(t) ) pids(t) = 0
	end do
	return
	end
