zar@JULIET.CALTECH.EDU.UUCP (06/18/87)
$!------------------------------Cut Here-------------------------
$ chk = "224578872"
$ create nm1.for
$ deck/dollars="ThEgReAtZaR"
program Nanny
c
c My Daemon (Nanny)
c
c Written by Daniel M. Zirin for Zar Limited
c ZAR @ CITCHEM (bitnet) ZAR @ XHMEIA.Caltech.Edu ([192.12.19.15] arpa)
c XHMEIA::ZAR (area 5 node 920 span/hepnet)
c
c command syntax:
c command ret_mail_box parameters ascii_blank
c
c Nanny input bit masks:
c Debugging 0 - No debugging messages
c (Bits 31 & 32 1 - Do not execute vital functions and display
c of the Function extra messages
c mask) 2 - Execute all functions and display extra
c messages
c
c Function mask Bit Meaning
c 1 - Allow batch priority dither
c 2 - Allow detach priority dither
c 3 - Allow normal user priority dither
c 4 - Allow network process priority dither
c 5 - Allow subprocess priority dither
c 6 - CPU total is accumulated by all dup procs
c 7 - Allow suspending on low memory
c 8 - Allow batch processes to be suspended
c 9 - Allow detach processes to be suspended
c 10 - Allow normal processes to be suspended
c 11 - Allow network processes to be suspended
c 12 - Allow subprocesses to be suspended
c 13 - If set, logoff entire process tree when
c idle. If clear, logoff process with no
c subprocesses first
c 14 - If set, system users are subject to idle-
c time logout (interactive only)
c 15 - Give idle time warning @1/2 maxidle
c 16 - Give idle time warning @<60 seconds left
c 17 - Give CPU warning @time-cycle
c 18 - Allow preference dither
c 19 - Not used
c 27 - Not used
c 28 - Assign/system node name and load average
c to sys$announce
c 29 - Assign/system the day of week and allow
c time reset for DST
c 30 - Reserved
c 31 - Debugging bit 1
c 32 - Debugging bit 2
c
c Command msk Bit Meaning
c 1 - Disable ADDACC command
c 2 - Disable DIE command
c 3 - Disable ENTER command
c 4 - Disable FORGET command
c 5 - Disable FREE command
c 6 - Disable GRAB command
c 7 - Disable IGNORE command
c 8 - Disable KILL command
c 9 - Disable LISTEN command
c 10 - Disable NEW command
c 11 - Disable ODIS command
c 12 - Disable OEN command
c 13 - Disable QSTART command
c 14 - Disable QSTOP command
c 15 - Disable REQUEUE command
c 16 - Disable RESUME command
c 17 - Disable STOP command
c 18 - Disable SUSPEND command
c 19 - Disable WAKE command *
c 20 - Disable WCLR command *
c 21 - Disable WSHOW command *
c 22 - Not used
c 32 - Not used
c
c OUTPUT routine 0 - Output to OPA0: only
c 1 - Output to logfile only
c 2 - Output to OPA0: and logfile
c
c * = Returns special values/output in return mailbox. See help file.
c
c Created Zar ltd. 20-May-83
c Revised Zar ltd. 30-Jun-83
c Revised Zar ltd. 2-Aug-83
c Revised Zar ltd. 30-Oct-83
c Revised Zar ltd. 5-Oct-85 for VMS V4
c Revised Zar ltd. 9-Jun-87
c
c (c) Zar Ltd. 1983,1985,1986,1987
c
parameter pcb$v_batch = '00e'x
parameter pcb$v_netwrk = '015'x
implicit integer*4 (a-z)
include 'nanny.inc'
include '($brkdef)'
include '($ssdef)'
character*100 message
character*12 username(maxuser)
character*10 terminal(maxuser),phy_term(maxuser)
character*9 cur_date
character*8 account(maxuser)
character*2 old_date
integer*4 authpriv(maxuser,2)
integer*4 bufio(maxuser)
integer*4 cputim(maxuser)
integer*4 dirio(maxuser)
integer*4 ncputim(maxuser,max_average)
integer*4 owner(maxuser)
integer*4 pageflts(maxuser)
integer*4 second3(2)
integer*4 seedpid
integer*4 sts(maxuser)
integer*4 warn(maxuser)
integer*4 wssize(maxuser)
integer*4 wstore(2)
integer*2 o_seqnum
integer*2 uic(maxuser,2)
integer*2 usedpri(0:31)
real*4 new_cputim
real*4 preadd
logical*1 dst_chk
logical*1 dumy
logical*1 first
logical*1 limwarn(maxuser)
logical*1 resumeok
logical*1 suspendok
logical*1 susp_flg(maxuser)
logical*1 warned(maxuser)
logical*1 ws_mem_purge
external nanjpi,gotmess,wait_rel,boost
c
c Initialize some variables
c
die = 0
cycle_num = 0
suspids = 0
maxwstot = 0
c_uic(2) = 1 !Fake current UIC is the SYSMGR's
c_uic(1) = 4
wstore(1) = '7fffffff'x
wstore(2) = 0
startup_flg = .false.
listen = .false.
first = .true.
debugging = 0
resumeok = .false.
do i=1,maxuser
pid(i) = 0
ipid(i) = 0
susp_flg(i) = .false.
limwarn(i) = 0
do j=1,max_average
ncputim(i,j) = 0
end do
end do
call sys$bintim('0 0:0:3.0',second3)
call date(cur_date)
old_date = cur_date(1:2)
call waker('1',0,c_uic,old_date(1:1)) !Init the wake-up calls
c
c Declerations done, lets annoy some users
c
code = sys$setprn('Nanny')
c
c Get parameters from input file.
c
call new_log(dumy)
if (dumy.ne.ss$_normal) goto 3
c
c Day of week setup
c
call dayweek(.true.)
dst_chk = .true.
c
c Create a mailbox for communication to the outside world and
c to read termination messages when sending messages to the
c system managers.
c (needs PRMMBX priv)
c
code = sys$crembx(%val(1),mbxchan,,,,,'NANNYS$BOX')
if (bug(code,'CREMBX').ne.ss$_normal) call sys$exit(%val(code))
code = sys$crembx(%val(0),mbx2,,,,,)
if (bug(code,'CREMBX').ne.ss$_normal) call sys$exit(%val(code))
code = sys$crembx(%val(0),mbx3,,,,,'NANNY$PEEK')
if (bug(code,'CREMBX').ne.ss$_normal) call sys$exit(%val(code))
call loop
c
c (start of infinite loop)
c
c Set a timer to wake-up after hibernating
c
call output(0,'Logfile initialized')
1 continue
suspendok = .false.
ws_mem_purge= .true.
seedpid = -1
jpicode = 0
o_seqnum = -1
wstotal = 0
highbat = -1
lowbat = 32
cycle_num = cycle_num + 1
do i = 0, 31
usedpri(i) = 0
end do
code = sys$setimr(,truewait,wait_rel,%val(1))
if (bug(code,'SETIMR').ne.ss$_normal) goto 4
c
c As long as there are users
c
do while (jpicode.ne.ss$_nomoreproc)
c
c Do the $GETJPI service in EXECutive mode
c (needs CMEXEC priv)
c
ranjpipid = seedpid
jpicode = sys$cmexec(nanjpi,)
seedpid = ranjpipid
if (jpicode.ne.ss$_nopriv.and.jpicode.ne.ss$_nomoreproc.and.
1 jpicode.ne.ss$_suspended) jpicode = bug(jpicode,'GETJPI')
if ((jpicode.eq.ss$_normal.or.jpicode.eq.ss$_suspended).and.
1 c_pid.ne.0) then
c
c Get the current user's sequence number(PROC_INDEX)
c
c point = lib$extzv(0,8,c_pid) + 1 !commented out for VMS 4
point = c_ipid
maxseqnum = max(maxseqnum,point)
c if (o_seqnum.ge.point) goto 6 !Don't cycle twice (VMS V4 - out)
c
c Get rid of any user's we had that were skipped over
c
imsk = 'ffffffbf'x.or.functmsk !Function 7
do i=o_seqnum+1,point,-1
if (imsk.eq.'ffffffff'x) then
if (i.lt.point.or.(i.eq.point.and.pid(point).ne.c_pid))
1 then
do j=1,suspids
if (pid(i).eq.susp_pid(j)) then
do k=j,suspids-1
susp_pid(k) = susp_pid(k+1)
end do
susp_pid(suspids) = 0
suspids = suspids - 1
goto 10
end if
end do
end if
end if
10 continue
if (i.lt.point) pid(i) = 0
end do
o_seqnum = point
c
c Flag the process if it is suspended
c
susp_flg(point) = .false.
if (jpicode.eq.ss$_suspended) susp_flg(point) = .true.
c
c If the current PID isn't the same as the one we have for this
c sequence number, its a new user. Initialize the counters.
c (or if a system user has changed into something else)
c
if ((pid(point).ne.c_pid).or.(system(point).ge.nan$_system
1 .and.(lench(c_account).gt.0.and.c_uic(2).gt.sysgrp.and.
2 c_account(:len1(c_account)).ne.sysaccnam(:len1(sysaccnam)))))
3 then
username(point) = c_username
account(point) = c_account
terminal(point) = c_terminal
phy_term(point) = c_phy_term
authpriv(point,1) = c_authpriv(1)
authpriv(point,2) = c_authpriv(2)
bufio(point) = 0
cputim(point) = 0
dirio(point) = 0
owner(point) = c_owner
pageflts(point) = 0
ipid(point) = c_ipid
pid(point) = c_pid
authpri(point) = c_prib
warn(point) = 0
warned(point) = 0
limwarn(point) = 0
c
c Determine the type of process we have
c
typ = nan$v_inter !Default is interactive process
if (lib$extzv(pcb$v_batch,1,c_sts).eq.1) typ = nan$v_batch
if (lib$extzv(pcb$v_netwrk,1,c_sts).eq.1)
1 typ = nan$v_network
if (typ.ne.nan$v_network.and.typ.ne.nan$v_batch.and.
1 lench(c_terminal).eq.0) typ = nan$v_detach
if (owner(point).ne.0) typ = nan$v_subproc
if (c_uic(2).le.sysgrp.or.c_account(:len1(c_account)).eq.
1 sysaccnam(:len1(sysaccnam)).or.lench(c_account).eq.0.or.
2 c_prib.gt.maxpri) typ = typ + nan$_system
system(point) = typ
c
c If we should ignore this user or terminal set typ to 4
c
do cnt=1,maxig_user
if (lench(ig_user(cnt)).le.0) goto 11
if (ig_user(cnt)(:len1(ig_user(cnt))).eq.
1 c_username(:len1(c_username))) system(point) =
2 nan$v_unknown
end do
11 continue
if (system(point).ne.nan$v_unknown) then
do cnt=1,maxig_term
if (lench(ig_term(cnt)).le.0) goto 12
if (ig_term(cnt)(:len1(ig_term(cnt))).eq.
1 c_terminal(:len1(c_terminal))) system(point) =
2 nan$v_unknown
end do
end if
12 continue
end if
sts(point) = 0 !Used for new cpu use stats later
c
c Ignore him if SUSPended
c
if (susp_flg(point).and.system(point).lt.nan$_system)
1 system(point) = system(point) + nan$_system
if (c_prib.gt.authpri(point)) authpri(point) = c_prib
c
c Increment elapsed time logoff if the function is on
c
if (maxelapsed.gt.0.and.lib$extzv(16,16,warn(point))
1 .lt.maxelapsed) warn(point) = warn(point) + 1 * 2**16
c
c Check Normal users for being idle
c
if (maxidle.gt.0.and.(minio.gt.0.or.mintim.gt.0).and.
1 lib$extzv(0,16,warn(point)).lt.maxidle) then
warn(point) = warn(point) + 1
do i=1,cpu_average-1
ncputim(point,i) = ncputim(point,i+1)
end do
ncputim(point,cpu_average) = 0
if (system(point).eq.nan$v_inter.or.system(point)
1 .eq.nan$v_subproc.or.system(point).eq.nan$v_inter+
2 nan$_system) then
if (bufio(point)+dirio(point)+minio.le.c_bufio+
1 c_dirio.and.minio.ne.0) warn(point) = lib$extzv(
2 16,16,warn(point)) * 2**16
if (cputim(point)+mintim.le.c_cputim.and.mintim
1 .ne.0) warn(point) = (lib$extzv(16,16,warn(point))
2 * 2**16)
imsk = 'ffffefff'x.or.functmsk !Function 13
if (imsk.ne.'ffffffff'x.and.c_prccnt.gt.0)
1 warn(point) = lib$extzv(16,16,warn(point)) * 2**16
else
warn(point) = lib$extzv(16,16,warn(point)) * 2**16
end if
if (lib$extzv(0,16,warn(point)).eq.0)
1 warned(point) = 0
c
c Figure out total new CPU use for this user in this CPU group
c
if (system(point).lt.nan$v_unknown) then
imsk='ffffffdf'x.or.functmsk !Function 6
if (imsk.eq.'ffffffff'x) then
do i=1,point-1
c
c If this is a valid process, our PIDs are different, our
c authorized priorities are the same, and our usernames are
c the same, then...
c
if (pid(i).ne.0.and.pid(i).ne.pid(point).and.
1 authpri(i).eq.authpri(point).and.username(i).eq.
2 username(point)) then
j = point !J = (>ncpu user)
k = i !K = (<=ncpu user)
if (ncputim(i,cpu_average).gt.ncputim(point,
1 cpu_average)) j = i
if (j.eq.i) k = point
c
c After getting all processes in this phase of Nanny, 'sts'
c will contain extra cpu to add to 'ncputim' for hogs check
c
sts(j) = sts(k) + ncputim(k,cpu_average)
sts(k) = 0
ncputim(k,cpu_average) = 0
usedpri(authpri(point)) = usedpri(authpri(
1 point)) - 1
end if
end do
end if
end if
end if
c
c Check off potential batch priorities not to suspend
c
imsk = 'ffffffbf'x.or.functmsk !Function 7
if (imsk.eq.'ffffffff'x) then
if (system(point).eq.nan$v_batch) then
if (highbat.ne.-1.and.authpri(point).lt.highbat)
1 suspendok = .true.
if (authpri(point).gt.highbat) highbat = authpri(point)
if (authpri(point).lt.lowbat) lowbat = authpri(point)
end if
end if
c
c Total things
c
ncputim(point,cpu_average) = c_cputim - cputim(point) + j
bufio(point) = c_bufio
cputim(point) = c_cputim
dirio(point) = c_dirio
pageflts(point) = c_pageflts
prib(point) = c_prib
wssize(point) = c_wssize
if (.not.susp_flg(point)) wstotal = wstotal + c_wssize
if (lench(phy_term(point)).gt.0.and.system(point).lt.
1 nan$v_unknown) usedpri(authpri(point)) = usedpri(
2 authpri(point)) + 1
c
c Warn the user if close to his CPU limit
c
imsk = 'fffeffff'x.or.functmsk !Function 17
if (imsk.eq.'ffffffff'x.and.(system(point).eq.nan$v_inter.or.
1 system(point).eq.nan$v_inter+nan$_system).and.c_cpulim.ne.0)
2 then
if (cputim(point).ge.c_cpulim-waitim*2.and.limwarn(point)
1 .lt.2) then
if (limwarn(point).eq.0.or.(cputim(point).ge.
1 c_cpulim-waitim)) then
call time(cur_date)
message = cur_date(:8)//' Nanny: You are about to '//
1 'exceed your CPU limit.'//char(7)
code = sys$brkthru(,%descr(message(:len1(message))),
1 %descr(terminal(point)(:len1(terminal(point)))),
2 %val(brk$c_device),,,,,%val(5),,)
call bug(code,'BRKTHRU')
limwarn(point) = limwarn(point) + 1
call output(1,'Warned '//username(point)(:len1(
1 username(point)))//' about CPU time limit')
end if
end if
end if
end if
end do
c
c We got all the users, let's do something to them...
c
6 if (first) goto 2
if (wstotal.gt.maxwstot) maxwstot = wstotal
crush_p = 0
c
c If memory is plentiful, turn off suspendok flag
c
imsk = 'ffffffbf'x.or.functmsk !Function 7
if (imsk.ne.'ffffffff'x.or.wstotal.le.maxphymem.or.maxphymem
1 .eq.0) ws_mem_purge = .false.
if (.not.ws_mem_purge) suspendok = .false.
do point=1,maxseqnum
if (pid(point).ne.0.and.system(point).ne.nan$v_unknown) then
ThEgReAtZaR
$ checksum nm1.for
$ if chk.nes.checksum$checksum then write sys$output -
"NM1.FOR didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ exit