zar@HAMLET.CALTECH.EDU (Dan Zirin) (06/30/87)
$!------------------------------Cut Here-------------------------
$ chk = "860644863"
$ j = 0
$ required = "nm1.for"
$ if "''f$search(required)'".eqs."" then write sys$output -
"File NM1.FOR must exist prior to running this procedure."
$ if "''f$search(required)'".eqs."" then j = 1
$ required = "nm2.for"
$ if "''f$search(required)'".eqs."" then write sys$output -
"File NM2.FOR must exist prior to running this procedure."
$ if "''f$search(required)'".eqs."" then j = 1
$ required = "nm3.for"
$ if "''f$search(required)'".eqs."" then write sys$output -
"File NM3.FOR must exist prior to running this procedure."
$ if "''f$search(required)'".eqs."" then j = 1
$ if j.eq.1 then exit %x2c
$ create nm4.for
$ deck/dollars="ThEgReAtZaR"
c+++++++
c
c Elapsed time logoff doesn't care what you are doing (CPU and
c I/O activity are ignored).
c
imsk = 'ffffdfff'x .or. functmsk !Function 14
if (maxelapsed.gt.0.and.(system(point).eq.nan$v_inter
1 .or.system(point).eq.nan$v_subproc.or.(system(point)
2 .eq.nan$v_inter+nan$_system.and.imsk.eq.'ffffffff'x)))
3 then
c
c Terminate the program execution of a user if maxelapsed time
c has been exceeded (idle logoff will destroy the user later
c we hope). Idle logoff normally gets them before this check
c unless the program being run is something like KERMIT which
c increases I/O and CPU even though the user hasn't touched the
c keyboard.
c
if (lib$extzv(16,16,warn(point)).ge.maxelapsed) then
if (debugging.ne.1) then
code = sys$forcex(pid(point),,%val('2c'x))
else
code = ss$_normal
end if
message = username(point)(:len1(username(point)))//
1 ' on '//terminal(point)(:len1(terminal(point)))//
2 ' has exceeded maximum login time'//char(7)
if (bug(code,'FORCEX').eq.ss$_normal) then
code = ss$_normal
if (system(point).ne.nan$v_subproc) code =
1 sys$brkthru(,%descr(message(:len1(message))),
2 %descr(terminal(point)(:len1(terminal(point)))),
3 %val(brk$c_device),,,,,%val(5),,)
call bug(code,'BRKTHRU')
call output(2,message(:len1(message)-1))
warn(point) = lib$extzv(0,16,warn(point))
else
if (code.ne.ss$_nonexpr) then
call output(1,'Unable to FORCEX '//username(
1 point)(:len1(username(point)))//' on '//
2 terminal(point)(:len1(terminal(point))))
else
call output(2,message(:len1(message)-1))
warn(point) = lib$extzv(0,16,warn(point))
end if
end if
end if
c
c They do get one warning prior to exceeding maxelapsed
c
if (lib$extzv(16,16,warn(point)).ge.maxelapsed-1) then
message = char(7)//username(point)(:len1(
1 username(point)))//' on '//terminal(point)(:len1(
2 terminal(point)))//' has exceeded maximum login '//
3 'time. Image will be terminated regardless of '//
4 'user actions'//char(7)//char(7)
code = ss$_normal
if (system(point).ne.nan$v_subproc) code =
1 sys$brkthru(,%descr(message(:len1(message))),
2 %descr(terminal(point)(:len1(terminal(point)))),
3 %val(brk$c_device),,,,,%val(5),,)
call bug(code,'BRKTHRU')
end if
end if
end if
end do
c+++++++
c
c We will reset priorities we lowered in (waitim/10) seconds
c
c second3(1) = waitim * -100000
c code = sys$setimr(,second3,boost,%val(2))
c if (bug(code,'SETIMR').ne.ss$_normal) call output(1,'Unable '//
c 1 'to reset priorities')
c+++++++
c
c Resume low priority batch jobs if memory is not being used
c (first in last out one resumed per cycle)
c
imsk = 'ffffffbf'x.or.functmsk !Function 7
if (imsk.eq.'ffffffff'x.and.wstotal.lt.lowphymem.and.
1 lowphymem.ne.0.and.suspids.gt.0) then
if (resumeok) then
point = susp_ipid(suspids)
if (debugging.eq.1) then
code = ss$_normal
else
code = sys$resume(susp_pid(suspids),)
end if
if (code.eq.ss$_normal.or.code.eq.ss$_nonexpr) then
susp_ipid(suspids) = 0
susp_pid(suspids) = 0
suspids = suspids - 1
call output(1,'Resumed '//username(point)(:len1(username(
1 point)))//' (mem)')
else
call bug(code,'RESUME')
call output(1,'Unable to resume '//username(point)(:len1(
1 username(point)))//' (mem)')
end if
else
resumeok = .true.
end if
else
resumeok = .false.
end if
c-------
c
c Create a new log file for each day.
c
2 first = .false.
call date(cur_date)
if (cur_date(1:2).ne.old_date) then
if (debugging.ne.0) then
write(message,'(a40,i5)',err=8) 'Daily maximum physical '//
1 'memory usage was ',maxwstot
call output(1,message(:len1(message)))
maxwstot = 0
end if
8 call new_log(dumy)
old_date = cur_date(1:2)
cycle_num = 0
c
c Purge working set at midnight if WSPurge is off
c
if (.not.purgews) then
code = sys$purgws(wstore)
call bug(code,'PURGWS')
end if
call dayweek(.false.)
dst_chk = .true.
end if
c
c Change SYS$ANNOUNCE to node name + load average
c
imsk = 'f7ffffff'x .or. functmsk !Function 28
if (imsk.eq.'ffffffff'x) then
c call something !???
end if
c
c Daylight savings check (2:00am)
c
call time(cur_date(1:8))
if (dst_chk.and.cur_date(1:2).eq.'02') then
imsk = 'efffffff'x .or. functmsk !Function 29
if (imsk.eq.'ffffffff'x) call dayweek(.false.)
dst_chk = .false.
end if
c
c Are we debugging the Nanny
c
debugging = 0
imsk = 'bfffffff'x .or. functmsk !Function 31
if (imsk.eq.'ffffffff'x) debugging = 1
imsk = '7fffffff'x .or. functmsk !Function 32
if (imsk.eq.'ffffffff'x) debugging = 2 !debugging + 2
c
c Purge working set and wait for another cycle
c
if (purgews.or.ws_mem_purge) then
code = sys$purgws(wstore)
call bug(code,'PURGWS')
end if
call sys$hiber()
call sys$cantim(%val(1),)
c
c If we were told to DIE, do so
c
if (die.eq.1) then
close(unit=6)
call sys$delmbx(%val(mbxchan))
call exit
end if
c
c Loop again
c
goto 1
c
c Errors
c
3 call output(2,'Forced exit: Parameter file error')
call sys$exit(%val('2c'x))
4 call output(2,'Forced exit: Timer error')
call sys$exit(%val('2c'x))
c
end
ThEgReAtZaR
$ checksum nm4.for
$ if chk.nes.checksum$checksum then write sys$output -
"NM4.FOR didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ copy/log nm1.for+nm2.for+nm3.for+nm4.for nmain.for
$ if $status then delete/log nm1.for;,nm2.for;,nm3.for;,nm4.for;
$ chk = "1476594327"
$ create nf3.for
$ deck/dollars="ThEgReAtZaR"
integer*4 function bug(code,routine)
c
c Error handler for the Nanny
c
c (c) Zar Ltd. 1985
c
parameter ss$_normal = 1
implicit integer*4 (a-z)
character*(*) routine
character*132 message
c
c If the code is not equal to a normal status, get the error
c message
c
bug = -1
if (code.ne.ss$_normal) then
i = sys$getmsg(%val(code),message_l,message,%val(15),)
c
c Couldn't get the error message
c
if (i.ne.ss$_normal) then
write(message,'(a,z8)',err=999) 'Unable to receive '//
1 'message for error number ',code
call output(1,'Message from routine '//routine(:len1(
1 routine))//char(13)//char(10)//' '//message(:51))
c
c Write out only Errors, Fatals, Warnings, and Unknowns
c
else
i = index(message,'-') + 1
if (message(i:i).ne.'S'.and.message(i:i).ne.'I'.and.
1 message(i+2:i+7).ne.'NORMAL') then
call output(1,'Message from routine '//routine(:len1(
1 routine))//char(13)//char(10)//' '//
2 message(:message_l))
else
bug = ss$_normal
end if
end if
c
c No error
c
else
bug = ss$_normal
end if
999 return
end
subroutine nan$die
c
c Routine to stop the Nanny cleanly
c
c (c) Zar Ltd. 1985
c
implicit integer*4 (a-z)
include 'nanny.inc'
include '($ssdef)'
c
c Set users priorities back to normal
c
do i=1,maxuser
if (system(i).ne.4.and.system(i).ne.2.and.pid(i).ne.0) then
code = sys$setpri(pid(i),,%val(authpri(i)),)
if (code.ne.ss$_nonexpr) call bug(code,'SETPRI')
end if
end do
c
c Resume any jobs we suspended
c
do i=1,suspids
if (susp_pid(i).ne.0) then
code = sys$resume(susp_pid(i),)
if (code.ne.ss$_nonexpr) call bug(code,'RESUME')
end if
end do
c
c Flag the exit and return to operation
c
die = 1
call output(2,'Request to exit approved')
call wait_rel
return
end
subroutine dskchk(inp_disks,start_flg)
c
c Routine to check disks for low space. If low, a message is
c sent to the operator console.
c
c (c) Zar Ltd. 1985
c
implicit integer*4 (a-z)
include 'nanny.inc'
character*(*) inp_disks
character*6 disknam(maxdisks)
logical*1 start_flg
c
c Sort out the disk names from arg list
c
if (start_flg) dsk_die = .false.
dsk_point = 1
1 i = index(inp_disks,',')
if (i.lt.1) i = lench(inp_disks)
if (i.lt.2) then
if (lench(disks(1)).gt.0) call output(2,'Request to '//
1 'abort disk check approved')
dsk_die = .true.
do cnt=1,maxdisks
disks(cnt) = ' '
end do
return
end if
dsk_die = .false.
disknam(dsk_point) = inp_disks(:i-1)
inp_disks = inp_disks(i+2:)
dsk_point = dsk_point + 1
if (lench(inp_disks).gt.0.and.dsk_point.le.maxdisks) goto 1
c
c Zero the rest of the disk array
c
do i=dsk_point,maxdisks
disknam(i) = ' '
end do
do i=1,maxdisks
if (disks(i).ne.disknam(i)) lasterr(i) = 0
disks(i) = disknam(i)
end do
c
c Start the disk checking mechanism
c
if (start_flg) call dsk_loop('0 0:0:13.0')
return
end
ThEgReAtZaR
$ checksum nf3.for
$ if chk.nes.checksum$checksum then write sys$output -
"NF3.FOR didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ exit