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

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

$!------------------------------Cut Here-------------------------
$ chk = "739047707"
$ create nf6.for
$ deck/dollars="ThEgReAtZaR"
        subroutine      kill(inline,inp_uic,dumy)
C
C       Routine to delete, force exit, suspend, or resume a process.
C       Both the calling process and the target process must have the
C       same UIC.
c
c       (c) Zar Ltd. 1985
c
        parameter       ss$_normal   = 1
        parameter       wait_time    = '0 0:0:3.0'
        implicit        integer*4 (a-z)
        include         'nanny.inc'
        include         '($jpidef)'
        character*(*)   inline
        character*80    message
        character*12    userc,usert
        character*8     fnction
        integer*4       getlis(7),qwait(2)
        integer*2       uict(2),uicc(2),inp_uic(2)
        logical*1       dumy
C
C       Initialize and get command
C
        dumy      = nan$_invcom
        call str$upcase(inline,inline)
        if (inline(1:5).ne.'KILL '.and.inline(1:5).ne.'STOP '.and.
     1  inline(1:8).ne.'SUSPEND '.and.inline(1:7).ne.'RESUME ') return
        i=index(inline,' ')-1
        fnction=inline(1:i)
C
C       Decode the target Process ID
C
        inline=inline(i+2:)
        if (lench(inline).eq.0) goto 999
        do while(inline(1:1).eq.' ')
         inline=inline(2:)
        end do
        j=index(inline,' ')-1
        read(inline(:j),'(z<j>)',err=999) pidt
C
C       Try to get the target UIC
C
        getlis(1) = jpi$_uic * 2**16 + 4
        getlis(2) = %loc(uict)
        getlis(3) = 0
        getlis(4) = jpi$_username * 2**16 + 12
        getlis(5) = %loc(usert)
        getlis(6) = 0
        getlis(7) = 0
        code = sys$bintim(wait_time,qwait)
        if (bug(code,'BINTIM').ne.ss$_normal) goto 999
        code = sys$setimr(%val(11),qwait,,)
        if (bug(code,'SETIMR').ne.ss$_normal) goto 999
        code = sys$getjpi(%val(12),pidt,,getlis,,,)
        if (bug(code,'GETJPI').ne.ss$_normal) goto 999
        code = sys$wflor(%val(11),%val(2**11.or.2**12))
        call bug(code,'WFLOR')
C
C       Decode the requesting Process ID
C
        inline=inline(j+2:)
        if (lench(inline).eq.0) goto 999
        do while(inline(1:1).eq.' ')
         inline=inline(2:)
        end do
        j=index(inline,' ')-1
        read(inline(:j),'(z<j>)',err=999) pidc
C
C       Try to get the requesting UIC
C
        getlis(1) = jpi$_uic * 2**16 + 4
        getlis(2) = %loc(uicc)
        getlis(3) = 0
        getlis(4) = jpi$_username * 2**16 + 12
        getlis(5) = %loc(userc)
        getlis(6) = 0
        getlis(7) = 0
        code = sys$setimr(%val(11),qwait,,)
        if (bug(code,'SETIMR').ne.ss$_normal) goto 999
        code = sys$getjpi(%val(12),pidc,,getlis,,,)
        if (bug(code,'GETJPI').ne.ss$_normal) goto 999
        code = sys$wflor(%val(11),%val(2**11.or.2**12))
        call bug(code,'WFLOR')
C
C       Make sure the requestor's UIC and the mailbox UIC are the same
C
        if (inp_uic(1).ne.uicc(1).or.inp_uic(2).ne.uicc(2)) then
          write(message,'(a,o3,a,o3,a)') 'System being violated'//
     1    ' by UIC [',inp_uic(2),',',inp_uic(1),']'
          call output(2,message(:38))
          dumy = nan$_nopriv
          return
        end if
C
C       If the two UICs aren't the same, don't delete.
C
        if (uicc(2).gt.sysgrp.and.(uicc(1).ne.uict(1).or.uicc(2).ne.
     1  uict(2))) goto 888
        if (uicc(2).gt.sysgrp.and.(usert.ne.userc.or.pidt.eq.0))
     1  goto 888
C
C       Delete the target process and raise its priority to make
C       sure it goes away.
C
        if (fnction.eq.'KILL') then
          code = sys$forcex(pidt,,%val('2c'x))
          call bug(code,'FORCEX')
          code = sys$delprc(pidt,)
          if (bug(code,'DELPRC').eq.ss$_normal) then
            code = sys$setpri(pidt,,%val(13),)
            call bug(code,'SETPRI')
          else
            goto 999
          end if
C
C       Force a process to stop execution of the image it's running.
C
        else if (fnction.eq.'STOP') then
          code = sys$forcex(pidt,,%val('2c'x))
          if (bug(code,'FORCEX').ne.ss$_normal) goto 999
C
C       Suspend a process
C
        else if (fnction.eq.'SUSPEND') then
          code = sys$suspnd(pidt,)
          if (bug(code,'SUSPND').ne.ss$_normal) goto 999
C
C       Resume a process
C
        else if (fnction.eq.'RESUME') then
          code = sys$resume(pidt,)
          if (bug(code,'RESUME').ne.ss$_normal) goto 999
        end if
C
C       Stamp SYS$OUTPUT with a completion message
C
        message = 'Request to '//fnction(:len1(fnction))//' process '//
     1  usert(:len1(usert))//' by '//userc(:len1(userc))//' approved'
        call output(2,message(:len1(message)))
        dumy=1
        return
888     message = 'Request to '//fnction(:len1(fnction))//' process '//
     1  usert(:len1(usert))//' by '//userc(:len1(userc))//' denied'
        call output(1,message(:len1(message)))
        dumy = nan$_retwarn
        return
999     message = 'Request to '//fnction(:len1(fnction))//' process '//
     1  usert(:len1(usert))//' by '//userc(:len1(userc))//' aborted'//
     2  ' on error'
        call output(1,message(:len1(message)))
        return
        end
        subroutine      loop
c
c       Be recursive
c
c       (c) Zar Ltd. 1985
c
        parameter       ss$_normal   = 1
        implicit        integer*4 (a-z)
        include         'nanny.inc'
        include         '($iodef)'
        external        gotmess
c
        code = sys$qio(,%val(mbxchan),%val(io$_readvblk),,gotmess,,
     1  inbuff,%val(128),,,,)
        if (bug(code,'QIO').ne.ss$_normal)
     1  call output(2,'Recursive I/O stopped. Input will be ignored')
        return
        end
c
c       Function Lench
c
c This function takes a character string and finds out how long the
c "actual" string is (i.e. not including padded blanks on the right).
c
c       (c) Zar Ltd. 1985
c
        integer*4 function lench(string)
        character*(*)   string
        character*255   dumy
c
        do while(index(string,char(0)).ne.0)
         i = index(string,char(0))
         string(i:i) = ' '
        end do
        call str$trim(dumy,string,line_l)
        lench = line_l
        return
        end
c
c=====================================================================
c
        subroutine      new_log(dumy)
c
c       Get parameters for this run from startup file.
c
c       (c) Zar Ltd. 1985
c
        implicit        integer*4 (a-z)
        include         'nanny.inc'
        character*80    disknams,oprttys,com_file
        character*15    onan_prcnam
        character*9     dat
        character*8     osysaccnam
        integer*4       otruewait(2)
        logical*1       dumy,opchk
c
c       Close the output and reopen it
c
        progress = 0
        dumy = 32
        inquire(unit=6,opened=opchk)
        if (opchk) call output(1,'Logfile closed')
        open(unit=6,name='SYS$OUTPUT:',carriagecontrol='list',shared,
     1  recl=512,status='new')
        close(unit=6)
c
c       Reread the parameter file
c
        open(unit=1,name='NANNY$START:',readonly,shared,err=6,
     1  carriagecontrol='list',status='old')
        goto 7
6       open(unit=1,name='SYS$INPUT:',readonly,shared,err=3,
     1  carriagecontrol='list',status='old')
c
c       Get the process name
c
7       read(1,110,err=3,end=3) onan_prcnam
        if (nan_prcnam.ne.onan_prcnam) then
          code=sys$setprn(onan_prcnam)
          call bug(code,'SETPRN')
          nan_prcnam=onan_prcnam
        end if
        progress=progress+1
c
c       Get the system group UIC
c
        read(1,120,err=3,end=3) osysgrp
        if (osysgrp.lt.1.or.osysgrp.gt.255) goto 3
        progress=progress+1
c
c       Get the system account name
c
        read(1,100,err=3,end=3) osysaccnam
        if (sysaccnam.ne.osysaccnam) sysaccnam = osysaccnam
        progress=progress+1
c
c       Get the cycle time
c
        read(1,*,err=3,end=3) owaitim
        if (owaitim.lt.1000.or.owaitim.gt.30000) goto 3
c
c       Convert cycle time to system quadword format
c
        k=owaitim
        i=float(k)/6000.
        k=k-i*6000
        j=float(k)/100.
        k=k-j*100
        dat='0 0:'
        l=5
        m=0
        if (i.gt.9) m=1
        write(dat(l:l+m),'(i<m+1>)',err=3) i
        l=l+m+2
        dat(l-1:l-1)=':'
        m=0
        if (j.gt.9) m=1
        write(dat(l:l+m),'(i<m+1>)',err=3) j
        l=l+m+2
        dat(l-1:l-1)='.'
        m=0
        if (k.gt.9) m=1
        write(dat(l:l+m),'(i<m+1>)',err=3) k
        l=l+m
        if (sys$bintim(dat(:l),otruewait).ne.1) goto 3
        progress=progress+1
c
c       Get the number of cycles to use for CPU use average
c
        read(1,*,err=3,end=3) ocpu_average
        if (ocpu_average.lt.1.or.ocpu_average.gt.max_average) goto 3
        progress=progress+1
c
c       Get the maximum idle time for a terminal and the maximum elapsed
c       time limit for interactive processes in "cycle" units
c
        read(1,*,err=3,end=3) omaxidle,omaxelapsed
        if (omaxidle.gt.8640.or.omaxelapsed.gt.86400) goto 3
        if ((omaxidle.ne.0.and.omaxidle.lt.3).or.(omaxelapsed.ne.0
     1  .and.omaxelapsed.lt.omaxidle)) goto 3
        progress=progress+1
c
c       Get the minimum time to be considered not idle
c
        read(1,*,err=3,end=3) omintim,ominio
        if (omintim.lt.0.or.omintim.gt.299) goto 3
        if (ominio.lt.0.or.ominio.gt.299) goto 3
        progress=progress+1
c
c       Get the maximum usable physical memory(guestimate)
c
        read(1,*,err=3,end=3) omaxphymem
        if (omaxphymem.ne.0.and.(omaxphymem.lt.2048.or.omaxphymem
     1  .gt.65536)) goto 3      !Between 1-32 Megabytes of memory
        progress=progress+1
c
c       Define memory size to resume suspended jobs
c
        read(1,*,err=3,end=3) olowphymem
        if (olowphymem.ne.0.and.(olowphymem.lt.128.or.olowphymem
     1  .gt.65536)) goto 3      !Between 0-32 Meg of memory
        if (olowphymem.gt.omaxphymem) olowphymem = omaxphymem
        progress=progress+1
ThEgReAtZaR
$ checksum nf6.for
$ if chk.nes.checksum$checksum then write sys$output -
  "NF6.FOR didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ exit
