From:	CSBVAX::MRGATE!@KL.SRI.Com:zar@Hamlet.Caltech.Edu@SMTP 30-JUN-1987 10:06
To:	EVERHART
Subj:	Nanny Source V1.0 8/14

Received: from Hamlet.Caltech.Edu by KL.SRI.Com with TCP; Mon 29 Jun 87 17:37:46-PDT
Date:     Mon, 29 Jun 87 17:32:44 PDT
From:     zar@Hamlet.Caltech.Edu (Dan Zirin)
Message-Id: <870629173244.0m8@Hamlet.Caltech.Edu>
Subject:  Nanny Source V1.0 8/14
To:       info-vax@kl.sri.com

$!------------------------------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
