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

Received: from Hamlet.Caltech.Edu by KL.SRI.Com with TCP; Mon 29 Jun 87 17:39:21-PDT
Date:     Mon, 29 Jun 87 17:33:50 PDT
From:     zar@Hamlet.Caltech.Edu (Dan Zirin)
Message-Id: <870629173350.0ma@Hamlet.Caltech.Edu>
Subject:  Nanny Source V1.0 10/14
To:       info-vax@kl.sri.com

$!------------------------------Cut Here-------------------------
$ chk = "236487385"
$ create nf5.for
$ deck/dollars="ThEgReAtZaR"
5       if (inline(1:7).eq.'ADDACC') then
          i='fffffffe'x.or.disable
          if (i.ne.'ffffffff'x) call account(inline,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:4).eq.'DIE') then
          if (uict(2).gt.sysgrp) goto 4
          i='fffffffd'x.or.disable
          if (i.ne.'ffffffff'x) call nan$die
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
          dumy = nan$_normal
        else if (inline(1:6).eq.'ENTER') then
          if (uict(2).gt.sysgrp) goto 4
          i='fffffffb'x.or.disable
          if (i.ne.'ffffffff'x) call forget(inline,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:7).eq.'FORGET') then
          if (uict(2).gt.sysgrp) goto 4
          i='fffffff7'x.or.disable
          if (i.ne.'ffffffff'x) call forget(inline,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:5).eq.'FREE') then
          if (uict(2).gt.sysgrp) goto 4
          i='ffffffef'x.or.disable
          if (i.ne.'ffffffff'x) call alloc(inline,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:5).eq.'GRAB') then
          if (uict(2).gt.sysgrp) goto 4
          i='ffffffdf'x.or.disable
          if (i.ne.'ffffffff'x) call alloc(inline,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:7).eq.'IGNORE') then
          if (uict(2).gt.sysgrp) goto 4
          i='ffffffbf'x.or.disable
          if (i.ne.'ffffffff'x) call listener(0)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
          dumy = nan$_normal
        else if (inline(1:5).eq.'KILL') then
          i='ffffff7f'x.or.disable
          if (i.ne.'ffffffff'x) call kill(inline,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:7).eq.'LISTEN') then
          if (uict(2).gt.sysgrp) goto 4
          i='fffffeff'x.or.disable
          if (i.ne.'ffffffff'x) call listener(1)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
          dumy = nan$_normal
        else if (inline(1:4).eq.'NEW') then
          if (uict(2).gt.sysgrp) goto 4
          i='fffffdff'x.or.disable
          if (i.ne.'ffffffff'x) call new_log(dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:4).eq.'ODIS') then
          i='fffffbff'x.or.disable
          if (i.ne.'ffffffff'x) call oprman(inline,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:3).eq.'OEN') then
          i='fffff7ff'x.or.disable
          if (i.ne.'ffffffff'x) call oprman(inline,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:7).eq.'QSTART') then
          i='ffffefff'x.or.disable
          if (i.ne.'ffffffff'x) call queman(inline,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:6).eq.'QSTOP') then
          i='ffffdfff'x.or.disable
          if (i.ne.'ffffffff'x) call queman(inline,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:8).eq.'REQUEUE') then
          i='ffffbfff'x.or.disable
          if (i.ne.'ffffffff'x) call queman(inline,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:7).eq.'RESUME') then
          if (uict(2).gt.sysgrp) goto 4
          i='ffff7fff'x.or.disable
          if (i.ne.'ffffffff'x) call kill(inline,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:5).eq.'STOP') then
          i='fffeffff'x.or.disable
          if (i.ne.'ffffffff'x) call kill(inline,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:8).eq.'SUSPEND') then
          if (uict(2).gt.sysgrp) goto 4
          i='fffdffff'x.or.disable
          if (i.ne.'ffffffff'x) call kill(inline,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:5).eq.'WAKE') then
          i='fffbffff'x.or.disable
          if (i.ne.'ffffffff'x) call waker(inline,1,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:5).eq.'WCLR') then
          i='fff7ffff'x.or.disable
          if (i.ne.'ffffffff'x) call wakeclr(inline,uict,dumy)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
        else if (inline(1:6).eq.'WSHOW') then
          i='ffefffff'x.or.disable
          if (i.ne.'ffffffff'x) call showake(retmbx)
          if (i.eq.'ffffffff'x) dumy = nan$_comdis
          if (i.eq.'ffffffff'x) goto 1
          dumy = nan$_normal
        else
          call output(1,'Received unknown message: '//
     1    inline(:len1(inline)))
          dumy = nan$_nosuchcom
        end if
        if (.not.startup_flg) goto 3
999     do i=1,128
         inbuff(i)=0
        end do
        call loop
        return
1       call output(1,inline(1:funct_l)//' command aborted. '//
     1  'Function disabled.')
3       code=sys$qio(,%val(retmbx),%val('70'x),,,,dumy,%val(1),,,,)
        call bug(code,'QIO')
        code=sys$dassgn(%val(retmbx))
        call bug(code,'DASSGN')
        goto 999
2       call output(1,inline(1:funct_l)//' command aborted. '//
     1  'No return mailbox.')
        goto 999
4       call output(1,inline(1:funct_l)//' command aborted. Non-'//
     1  'system user.')
        dumy = nan$_nonsys
        goto 3
        end
        integer*4 function nanjpi()
c
c       Do random getjpi on system(needs WORLD privilege)
c
c       (c) Zar Ltd. 1985
c
        parameter       maxwait         = '0 0:0:2.0'
        implicit        integer*4 (a-z)
        include         'nanny.inc'
        include         '($dvidef)'
        include         '($jpidef)'
        include         '($ssdef)'
        integer*4       dvilist(4),jpilist(55),qwait(2)
        integer*4       gpgcnt,ppgcnt
c
c       Initialize
c
        c_account     = ' '
        c_authpriv(1) = 0
        c_authpriv(2) = 0
        c_bufio       = 0
        c_cpulim      = 0
        c_cputim      = 0
        c_dirio       = 0
        gpgcnt        = 0
        c_owner       = 0
        c_pageflts    = 0
        c_phy_term    = ' '
        c_pid         = 0
        ppgcnt        = 0
        c_prccnt      = 0
        c_prib        = 0
        c_ipid        = 0
        c_sts         = 0
        c_terminal    = ' '
        c_uic(1)      = 0
        c_uic(2)      = 0
        c_username    = ' '
        jpilist(1)  = jpi$_account *2**16       + 8
        jpilist(2)  = %loc(c_account)
        jpilist(3)  = 0
        jpilist(4)  = jpi$_authpriv *2**16      + 8
        jpilist(5)  = %loc(c_authpriv)
        jpilist(6)  = 0
        jpilist(7)  = jpi$_bufio *2**16         + 4
        jpilist(8)  = %loc(c_bufio)
        jpilist(9)  = 0
        jpilist(10) = jpi$_cpulim *2**16        + 4
        jpilist(11) = %loc(c_cpulim)
        jpilist(12) = 0
        jpilist(13) = jpi$_cputim *2**16        + 4
        jpilist(14) = %loc(c_cputim)
        jpilist(15) = 0
        jpilist(16) = jpi$_dirio *2**16         + 4
        jpilist(17) = %loc(c_dirio)
        jpilist(18) = 0
        jpilist(19) = jpi$_gpgcnt *2**16        + 4
        jpilist(20) = %loc(gpgcnt)
        jpilist(21) = 0
        jpilist(22) = jpi$_owner *2**16         + 4
        jpilist(23) = %loc(c_owner)
        jpilist(24) = 0
        jpilist(25) = jpi$_pageflts *2**16      + 4
        jpilist(26) = %loc(c_pageflts)
        jpilist(27) = 0
        jpilist(28) = jpi$_pid *2**16           + 4
        jpilist(29) = %loc(c_pid)
        jpilist(30) = 0
        jpilist(31) = jpi$_ppgcnt *2**16        + 4
        jpilist(32) = %loc(ppgcnt)
        jpilist(33) = 0
        jpilist(34) = jpi$_prccnt *2**16        + 2
        jpilist(35) = %loc(c_prccnt)
        jpilist(36) = 0
        jpilist(37) = jpi$_prib *2**16          + 2
        jpilist(38) = %loc(c_prib)
        jpilist(39) = 0
        jpilist(40) = jpi$_proc_index *2**16    + 4
        jpilist(41) = %loc(c_ipid)
        jpilist(42) = 0
        jpilist(43) = jpi$_sts *2**16           + 4
        jpilist(44) = %loc(c_sts)
        jpilist(45) = 0
        jpilist(46) = jpi$_terminal *2**16      + 10
        jpilist(47) = %loc(c_terminal)
        jpilist(48) = 0
        jpilist(49) = jpi$_uic *2**16           + 4
        jpilist(50) = %loc(c_uic)
        jpilist(51) = 0
        jpilist(52) = jpi$_username *2**16      + 12
        jpilist(53) = %loc(c_username)
        jpilist(54) = 0
        jpilist(55) = 0
        dvilist(1)  = dvi$_tt_phydevnam *2**16  + 10
        dvilist(2)  = %loc(c_phy_term)
        dvilist(3)  = 0
        dvilist(4)  = 0
        nanjpi      = ss$_normal
c
c       Convert MAXWAIT to system time
c
        code = sys$bintim(maxwait,qwait)
        if (code.ne.ss$_normal) then
          nanjpi = ss$_abort
          return
        end if
c
c       Set a timer
c
        code = sys$setimr(%val(1),qwait,,%val(3))
        if (code.eq.ss$_normal) then
c
c       Do the $GETJPI service
c
          jpicode = sys$getjpi(%val(2),ranjpipid,,jpilist,,,)
          if (jpicode.eq.ss$_normal) code = sys$wflor(%val(1),
     1    %val(2**1.or.2**2))
        end if
        c_wssize = gpgcnt + ppgcnt
        if (lench(c_terminal).gt.0) then
          if (index(c_terminal,':').eq.0) c_terminal =
     1    c_terminal(:len1(c_terminal))//':'
c
c       Get the physical terminal name if a terminal field exists
c       First cancel the previous timer if its still alive and set a
c       new timer
c
          code = sys$cantim(%val(3),)
          code = sys$setimr(%val(1),qwait,,%val(3))
          if (code.eq.ss$_normal) then
c
c       Do the $GETDVI service
c
            dvicode = sys$getdvi(%val(17),,c_terminal,dvilist,,,,)
            if (dvicode.eq.ss$_normal) code = sys$wflor(%val(1),
     1      %val(2**1.or.2**17))
          end if
        end if
c
c       Clear R0 and return
c
        code = sys$cantim(%val(3),)
        nanjpi = jpicode
        return
        end
ThEgReAtZaR
$ checksum nf5.for
$ if chk.nes.checksum$checksum then write sys$output -
  "NF5.FOR didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ exit
