program	ARGUS
c
c	program to prevent terminals left idle.
c	warns user at 6 minuites, throws him off at
c	12. In either case, a message is sent to the
c	operators log.
c

	integer*4	pid,newcpu,newioc,grpnum
	integer*2	pid_l,newcpu_l,newioc_l,accnam_l,grpnum_l
	integer*2	ttynum_l,usrnam_l,logint_l,seqn(2)
	real*8		logint
	character	accnam*8,ttynum*7,usrnam*12
	equivalence	(seqn(1),pid)
	integer*4	jpibuf(25)


	parameter	ss$_nomoreproc='9a8'x
	parameter	ss$_normal=1
	parameter	ss$_nopriv='24'x
	parameter	ss$_nonexpr='8e8'x

	parameter	maxuser=256
	parameter	sysgrp=11
c
c	time to delay. in minuites. any value can be used
c	the default is 6. The granularity of the timer is 2 min.
c
	parameter min6=6
	integer*4	cputim(maxuser),bufioc(maxuser),sys$setprn,e,code
	integer*4	warn(maxuser),indpid,efn,sys$delprc,sys$brdcst
	integer*4	seedpid,lib$get_ef,lib$free_ef,sys$getjpi,sys$waitfr
	integer*2	seq(maxuser)
	character	message*40
c
	parameter	jpi$_pid='3190004'x
	parameter	jpi$_cputim='4070004'x
	parameter	jpi$_bufio='40c0004'x
	parameter	jpi$_logintim='2060008'x
	parameter	jpi$_username='202000c'x
	parameter	jpi$_account='2030008'x
	parameter	jpi$_terminal='31d0007'x
	parameter	jpi$_grp='3080004'x
c
c	define the contents of the request buffer
c
	jpibuf(1)=jpi$_pid
	jpibuf(2)=%loc(pid)
	jpibuf(3)=%loc(pid_l)
	jpibuf(4)=jpi$_cputim
	jpibuf(5)=%loc(newcpu)
	jpibuf(6)=%loc(newcpu_l)
	jpibuf(7)=jpi$_bufio
	jpibuf(8)=%loc(newioc)
	jpibuf(9)=%loc(newioc_l)
	jpibuf(10)=jpi$_logintim
	jpibuf(11)=%loc(logint)
	jpibuf(12)=%loc(logint_l)
	jpibuf(13)=jpi$_username
	jpibuf(14)=%loc(usrnam)
	jpibuf(15)=%loc(usrnam_l)
	jpibuf(16)=jpi$_account
	jpibuf(17)=%loc(accnam)
	jpibuf(18)=%loc(accnam_l)
	jpibuf(19)=jpi$_terminal
	jpibuf(20)=%loc(ttynum)
	jpibuf(21)=%loc(ttynum_l)
	jpibuf(22)=jpi$_grp
	jpibuf(23)=%loc(grpnum)
	jpibuf(24)=%loc(grpnum_l)
	jpibuf(25)=0

c
c	declerations done, lets annoy some users
c
	mintim=5
	code=sys$setprn('argus')
	call bug(code)
c
c	do a wildcard getjpi, so we get data on all the users
c
1	continue
	seedpid = -1
	e=0
c
c	as long as there are users
c
	do while (e.ne.ss$_nomoreproc)	
c
c	get an efn from the system
c

	code=lib$get_ef(efn)
	call bug(code)
	if (code.eq.ss$_normal) then
c
c	we have the efn, get some info on the user
c
	   e=sys$getjpi(%val(efn),%ref(seedpid),,%ref(jpibuf),,,)
	   if (e.eq.ss$_normal) then
		code=sys$waitfr(%val(efn))
	   endif
	if (e.ne.ss$_nopriv.and.e.ne.ss$_nonexpr.and.e.ne.ss$_nomoreproc) then
		call bug(e)
	   endif
	endif
c
c	de-allocate the event flag
c
	code=lib$free_ef(efn)
	call bug(code)
	if (e.eq.ss$_normal) then
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
	indpid=seqn(1)
c
c	we have the turkey let us set our next action
c	based on how he was doing 5 min ago
c
		warn(indpid)=warn(indpid)+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(indpid).ne.seqn(2)) then
		seq(indpid)=seqn(2)
		cputim(indpid)=0
		bufioc(indpid)=0
		warn(indpid)=0
	   endif
c
c	I leave the system processes alone, things break if I don't
c
	   if (accnam(1:accnam_l).eq.'SYSTEM') then
		warn(indpid)=0
	   endif
c
c	I leave the systems staff alone, otherwise I would be considered
c	anti-social
c	(besides that makes me immune too!)
c
	   if (grpnum.le.sysgrp) then
		warn(indpid)=0	
	   endif
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 likeley that he is not running enough to notice
c
	   if (ttynum_l.eq.0) then
		warn(indpid)=0

	   endif
c
c	normal user, he can be saved by doing an i/o, or using 50ms of cpu
c
	   if (bufioc(indpid).lt.newioc) then
		warn(indpid)=0
		bufioc(indpid)=newioc
	   endif
	   if (cputim(indpid)+mintim.le.newcpu) then
		warn(indpid)=0
		cputim(indpid)=newcpu
	   endif
c
c	we now know the turkeys state, lets decide what to do with him
c
	   if (warn(indpid).eq.1) then
		warn(indpid)=0		!for now, just warn endlessly
		call warnuser(pid,ttynum,ttynum_l,usrnam,usrnam_l)
	   endif
	   if (warn(indpid).eq.2) then
		message= 'This terminal logged off by ARGUS'
		code=sys$brdcst(message,ttynum)
		call bug(code)
		code=sys$delprc(%ref(pid),)
		call bug(code)
	   endif
	endif
	enddo
	call wait(min6)
	goto 1
	end
	subroutine purgws
c
c	subroutine to get rid of excess working set while waiting
c
	integer*4 range(2),sys$purgws,e
	range(1)=0
	range(2)='7FFFFFFF'X
c
c	the range field provides for purging all of the address space
c
	e=sys$purgws(%ref(range))
	call bug(e)
	return
	end
	subroutine wait(min)
c
c	waits min minutes. has a resolution of 2 min. It purges
c	working set just befor it waits, so its impact is very low
c
	integer*4 min,time(2),efn,e
	integer*4 sys$waitfr,sys$setimr,lib$get_ef,lib$free_ef
	time(1)=-60*10*1000*1000*2
	time(2)= -1
c
c	the time routine has a granularity of 2 minuites. 
c	since the cheap way of specifying allows for a max of 7 min delay
c
	e=lib$get_ef(efn)
	call bug(e)
c	we got a free efn from a library routine
c	now we repeat until we have enough
c
	do period=1,min/2
c
c		set a timer using our efn
c
		e=sys$setimr(%val(efn),%ref(time),,,)
		call bug(e)
c
c		dont waste memory while waiting
c
		call purgws
c
c		and wait for it
c
		e=sys$waitfr(%val(efn))
		call bug(e)
	enddo
	e=lib$free_ef(efn)
c
c	give our efn back to the system
c
	call bug(e)
	return
	end
	subroutine warnuser(pid,ttynum,ttynum_l,usrnam,usrnam_l)
	integer*4 pid,sys$brdcst,e
	integer*2 ttynum_l,usrnam_l,message_l
	character ttynum*7,usrnam*12,timbf*8,message*80
c
c	clear the message buffer
c
	message = ' '
c
c	get the time of day
c
	call TIME(TIMBF)
c
c	assemble the message
c
	message(1:9)=timbf
	message_l=10
	message(message_l:usrnam_l+message_l)=usrnam
	message_l=message_l+usrnam_l+1
	message(message_l:message_l+ttynum_l)=ttynum
	message_l=message_l+ttynum_l+1
c
c	message(message_l:message_l+42)= ' has been inactive, and will be'//
c	1' logged off'
c
	message(message_l:message_l+42)= ' has been inactive for 6 min.'//
	1' wasting resources'
	message_l=message_l+48
c
c	we got a nice  note, send it to him
c

	e=sys$brdcst(message,ttynum)
	call bug(e)
	return
	end
	subroutine bug(e)

	integer*4	pid,newcpu,newioc,grpnum
	integer*2	pid_l,newcpu_l,newioc_l,accnam_l,grpnum_l
	integer*2	ttynum_l,usrnam_l,logint_l,seqn(2)
	real*8		logint
	character	accnam*8,ttynum*7,usrnam*12
	equivalence	(seqn(1),pid)
	integer*4	jpibuf(25)

	integer*4 e,lib$signal,i
	return
	end