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

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

$!------------------------------Cut Here-------------------------
$ chk = "539345003"
$ create nf7.for
$ deck/dollars="ThEgReAtZaR"
c
c       Should we purge the working set
c
        read(1,140,err=3,end=3) dat
        call str$upcase(dat,dat)
        purgews = .false.
        if (dat(1:1).eq.'1'.or.dat(1:1).eq.'Y'.or.dat(1:1)
     1  .eq.'T') purgews = .true.
        progress=progress+1
c
c       Get the denominator for determining critical disk space availability
c
        read(1,*,err=3,end=3) olowdivd
        if (olowdivd.le.0.or.olowdivd.gt.200) goto 3
        progress=progress+1
c
c       Get the disk names to watch
c
        read(1,100,err=3,end=3) disknams
        i=index(disknams,'!')-1
        if (i.gt.0) disknams=disknams(:i)
        if (.not.opchk) call dskchk(disknams,.true.)
        if (opchk) call dskchk(disknams,.false.)
        progress=progress+1
c
c       Get the names of the Nanny operator terminals
c
        read(1,100,err=3,end=3) oprttys
        i=index(oprttys,'!')-1
        if (i.gt.0) oprttys=oprttys(:i)
        call opr_par(oprttys)
        progress=progress+1
c
c       Get the disable bit mask
c
        read(1,150,err=3,end=3) odisable
        progress=progress+1
c
c       Get the function enable bit mask
c
        read(1,150,err=3,end=3) ofunctmsk
        progress=progress+1
c
c       Get the names of users to ignore
c
        read(1,100,err=3,end=3) com_file
        i=index(com_file,'!')-1
        if (i.gt.0) com_file=com_file(:i)
        do i=1,maxig_user
         ig_user(i) = ' '
        end do
        ig_p = 1
1       continue
        if (lench(com_file).gt.0) then
          i=index(com_file,',')
          if (i.eq.0) i=lench(com_file)+1
          ig_user(ig_p)=com_file(:i-1)
          ig_p=ig_p+1
          com_file=com_file(i+1:)
          if (ig_p.le.maxig_user) goto 1
        end if
        progress=progress+1
c
c       Get the names of terminals to ignore
c
        read(1,100,err=3,end=3) com_file
        i=index(com_file,'!')-1
        if (i.gt.0) com_file=com_file(:i)
        do i=1,maxig_term
         ig_term(i) = ' '
        end do
        ig_p = 1
2       continue
        if (lench(com_file).gt.0) then
          i=index(com_file,',')
          if (i.eq.0) i=lench(com_file)+1
          ig_term(ig_p)=com_file(:i-1)
          ig_p=ig_p+1
          com_file=com_file(i+1:)
          if (ig_p.le.maxig_term) goto 2
        end if
        progress=progress+1
c
c       Group account preference values
c
        i            = 0
5       read(1,100,end=4) com_file
        if (index(com_file,'!').ne.0) com_file = com_file(:index(
     1  com_file,'!'))
        prefacc(i+1) = com_file(1:8)
        com_file     = com_file(10:)
        if (lench(com_file).eq.0) goto 5
        do while(com_file(1:1).eq.' ')
         com_file    = com_file(2:)
        end do
        line_l       = lench(com_file)
        per_loc      = index(com_file,'.')
        if (per_loc.eq.0) goto 5
        read(com_file,'(f<line_l>.<line_l-per_loc+1>)',err=5) prefadd(
     1  i+1)
        if (prefadd(i+1).eq.-1.1250) prefadd(i+1) = -1.126
        i            = i + 1
        progress=progress+1
        goto 5
4       prefadd(i+1) = 101.0
        close(unit=1)
c
c       Everything went ok, so set the common variables and return
c
        sysgrp      = osysgrp
        waitim      = owaitim
        cpu_average = ocpu_average
        maxidle     = omaxidle
        maxelapsed  = omaxelapsed
        mintim      = omintim
        minio       = ominio
        truewait(1) = otruewait(1)
        truewait(2) = otruewait(2)
        maxphymem   = omaxphymem
        lowphymem   = olowphymem
        lowdivd     = olowdivd
        disable     = odisable
        functmsk    = ofunctmsk
        dumy        = 1
        call output(1,'Logfile initialized')
        return
3       write(dat,'(i3)') progress+1
        call output(2,'Parameter file error on line'//dat)
        return
c
c       Formats
c
100     format(a)
110     format(a15)
120     format(o3)
130     format(a8)
140     format(a1)
150     format(z8)
        end
        subroutine oprman(inline,inp_uic,dumy)
C
C       This will set a terminl to receive operator messages or
C       to terminate operator messages to a terminal(REPLY/ENABLE
C       or REPLY/DISABLE).
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         '($dvidef)'
        include         '($iodef)'
        include         '($jpidef)'
        character*(*)   inline
        character*80    message
        character*23    oprmes
        character*12    user,term,tty
        character*4     funct
        integer*4       getlis(10),qwait(2),dvilis(4),unit_num
        integer*2       inp_uic(2),uicc(2),unit
        integer*2       jbcret
        byte            tty_l,opc$_rq_terme
        logical*1       dumy,edmask(3)
        equivalence     (opc$_rq_terme,oprmes(1:1))
        equivalence     (edmask,oprmes(2:4))
        equivalence     (opc$m_nm_all,oprmes(5:8)),(unit,oprmes(9:10))
        equivalence     (tty_l,oprmes(11:11)),(tty,oprmes(12:23))
        data opc$_rq_terme,opc$m_nm_all/1,'ffffffff'x/
C
        dumy       = nan$_invcom
        call sys$bintim(wait_time,qwait)
C
C       Get the function(OEN or ODIS)
C
        i=index(inline,' ')+1
        funct=inline(1:i-2)
        inline=inline(i:)
        if (lench(inline).eq.0) goto 999
        do while(inline(1:1).eq.' ')
         inline=inline(2:)
        end do
        i=index(inline,' ')+1
C
C       Get the process I.D. of the requestor
C
        if (lench(inline).eq.0) goto 999
        do while(inline(1:1).eq.' ')
         inline=inline(2:)
        end do
        i=index(inline,' ')-1
        read(inline(:i),'(z<i>)',err=999) pidc
C
C       Get the UIC of the requestor
C
        getlis(1)  = jpi$_username * 2**16 + 12
        getlis(2)  = %loc(user)
        getlis(3)  = 0
        getlis(4)  = jpi$_uic * 2**16      +  4
        getlis(5)  = %loc(uicc)
        getlis(6)  = 0
        getlis(7)  = jpi$_terminal * 2**16 + 12
        getlis(8)  = %loc(term)
        getlis(9)  = 0
        getlis(10) = 0
        code = sys$setimr(%val(13),qwait,,)
        if (bug(code,'SETIMR').ne.ss$_normal) goto 999
        code = sys$getjpi(%val(14),pidc,,getlis,,,)
        if (bug(code,'GETJPI').ne.ss$_normal) goto 999
        code = sys$wflor(%val(13),%val(2**13.or.2**14))
        call bug(code,'WFLOR')
C
C       Make sure the requestor and the mailbox UICs 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       Cut up the terminal name
C
        i=index(term,':')
        if (i.eq.0.or.i-4.lt.1) goto 888
        if (term(1:1).ne.'_') term='_'//term
        tty=term
        tty_l=index(tty,':')
C
C       Get the unit number
C
        dvilis(1)=dvi$_unit*2**16 + 4
        dvilis(2)=%loc(unit_num)
        dvilis(3)=0
        dvilis(4)=0
        code = sys$setimr(%val(13),qwait,,)
        if (bug(code,'SETIMR').ne.ss$_normal) goto 999
        code = sys$getdvi(%val(14),,tty(:tty_l),dvilis,,,,)
        if (bug(code,'GETDVI').ne.ss$_normal) goto 999
        code = sys$wflor(%val(13),%val(2**13.or.2**14))
        call bug(code,'WFLOR')
        unit=lib$extzv(0,16,unit_num)
        edmask(1)=0
        edmask(2)=0
        edmask(3)=0
C
C       Do the dirty deed
C
        if (funct(:3).eq.'OEN') then
          edmask(1)=-1
          edmask(2)=-1
          edmask(3)=-1
          code=sys$sndopr(%descr(oprmes(:12+tty_l-1)),%val(mbx2))
          if (bug(code,'SNDOPR').ne.ss$_normal) goto 888
        else if (funct.eq.'ODIS') then
          code=sys$sndopr(%descr(oprmes(:12+tty_l-1)),%val(mbx2))
          if (bug(code,'SNDOPR').ne.ss$_normal) goto 888
        end if
C
C       Read from the mailbox for the completion status
C
        code = sys$setimr(%val(13),qwait,,)
        if (bug(code,'SETIMR').ne.ss$_normal) goto 888
        code = sys$qio(%val(14),%val(mbx2),%val(io$_readvblk),
     1  ,,,jbcret,%val(2),,,,)
        if (bug(code,'QIO').ne.ss$_normal) goto 888
        code = sys$wflor(%val(13),%val(2**13.or.2**14))
        call bug(code,'WFLOR')
        if (jbcret.ne.0) then
          if (bug(jbcret,'SNDOPR').ne.ss$_normal) goto 888
        end if
        code = sys$cancel(%val(mbx2))
        call bug(code,'CANCEL')
C
C       We did it! Let's write out a message now.
C
        dumy=1
        call output(2,'Command '//funct(:len1(funct))//' requested '//
     1  'by '//user(:len1(user))//' completed')
        return
c
c       Error
c
888     code = sys$cancel(%val(mbx2))
        call bug(code,'CANCEL')
        dumy = nan$_retwarn
999     call output(1,'Command '//funct(:len1(funct))//' requested '//
     1  'by '//user(:len1(user))//' aborted')
        return
        end
ThEgReAtZaR
$ checksum nf7.for
$ if chk.nes.checksum$checksum then write sys$output -
  "NF7.FOR didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ exit
