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

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

$!------------------------------Cut Here-------------------------
$ chk = "438788951"
$ create nm2.for
$ deck/dollars="ThEgReAtZaR"
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
ThEgReAtZaR
$ checksum nm2.for
$ if chk.nes.checksum$checksum then write sys$output -
  "NM2.FOR didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ exit
