zar@JULIET.CALTECH.EDU.UUCP (06/18/87)
$!------------------------------Cut Here-------------------------
$ chk = "1279866454"
$ create build.com
$ deck/dollars="ThEgReAtZaR"
$ j = 0
$ k = 0
$ files = "nmain.for,nfunc.for,nannyacp.for,wakeacp.for,nanny.tex,nanny.inp"
$ lp: k = k + 1
$ lp1: i = f$locate(",",files)
$ file = f$extract(0,i,files)
$ if "''f$search(file)'".eqs."" then j = 1
$ if "''f$search(file)'".eqs."" then write sys$output "''file' doesn't exist"
$ if i.eq.f$length(files) then goto ed1
$ files = f$extract(i+1,f$length(files),files)
$ goto lp1
$ ed1: if k.eq.1 then files = "startnan.com,nanny.inc"
$ if k.eq.1 then goto lp
$ if j.ne.0 then write sys$output " "
$ if j.ne.0 then write sys$output "You haven't received the full Nanny"
$ if j.ne.0 then write sys$output "distribution yet. Try again later."
$ if j.ne.0 then exit %x2c
$ fortran/list=nanny/noopt/debug/object=nanny nmain+nfunc
$ link/nomap nanny
$ delete/nolog nanny.obj.
$ fortran/nolist/noopt/nodebug nannyacp
$ link/nomap nannyacp
$ delete/nolog nannyacp.obj.
$ fortran/nolist/noopt/nodebug wakeacp
$ link/nomap wakeacp
$ delete/nolog wakeacp.obj.
$!
$! Add next line to system login.com
$!
$ wake :== $'f$trnlnm("SYS$DISK")''f$directory()'wakeacp
$!
$ type sys$input:
Edit the files NANNY.INP and STARTNAN.COM. See NANNY.TEX for specifics
and limited help. To start things, type "@STARTNAN" (also insert this
in SYS$MANAGER:SYSTARTUP.COM). Run NANNYACP to talk to Nanny (send
requests) except for WAKE functions (use the WAKE command as defined
in BUILD.COM).
If you gets requests for Nanny, please try to inform the author (see
NMAIN.FOR for mail address). You should also try subscribing to nanny-users
where you may ask questions you have about Nanny and request additions.
To subscribe, send mail to the author (see NMAIN.FOR).
Remember: A VAX without a Nanny is like a child without a mother.
From The Great
Zar
$ eod
ThEgReAtZaR
$ checksum build.com
$ if chk.nes.checksum$checksum then write sys$output -
"BUILD.COM didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ chk = "404296638"
$ create startnan.com
$ deck/dollars="ThEgReAtZaR"
$ PRIORITY = F$GETSYI("DEFPRI") + 4
$ RUN CIT_SYSTEM:NANNY -
/UIC = [1,4] -
/PRIORITY = 'PRIORITY' -
/INPUT = NANNY.INP
/OUTPUT = SYS$SCRATCH:NANNY.OUT -
/ERROR = SYS$SCRATCH:NANNY.ERR -
/AST_LIMIT = 40 -
/BUFFER_LIMIT = 20480 -
/IO_BUFFERED = 12 -
/IO_DIRECT = 12 -
/FILE_LIMIT = 20 -
/WORKING_SET = 64 -
/MAXIMUM_WORKING_SET = 1024 -
/PAGE_FILE = 10240 -
/QUEUE_LIMIT = 40 -
/SUBPROCESS_LIMIT = 1 -
/PRIVILEGES =(NOSAME, -
ALLSPOOL,ALTPRI,BYPASS,CMEXEC,EXQUOTA, -
GROUP,GRPNAM,LOG_IO,OPER,PRMMBX,SYSNAM, -
SYSPRV,TMPMBX,VOLPRO,WORLD)
ThEgReAtZaR
$ checksum startnan.com
$ if chk.nes.checksum$checksum then write sys$output -
"STARTNAN.COM didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ chk = "1764699561"
$ create nanny.inp
$ deck/dollars="ThEgReAtZaR"
Nanny !The process name to use
010 !Any group =< this number is ignored (3 digit octal)
SYSTEM !The system account name
3000 !Time interval to wait between cycles (30 sec)
3 !# of Nanny cycles for CPU averaging (3 cycles or 1.5min)
120,2400 !Maxidle time and Maxelapsed (1hr and 20hr)
5,1 !CPU, I/O needed to be non-idle (0.05 sec CPU, 1 I/O)
0 !Using more than this much memory, allow suspending
0 !Resume jobs if only using less than this much memory
NO !Should we purge working set after cycles
50 !If maxblocks/"this value" > freeblocks, send disk full warn
SYS$SYSDEVICE: !Check these disks for low space (<1/"above line" space left)
!Extra ttys to send Nanny messages to
00000202 !Command disable mask (hex) -- DIE + NEW commands enabled
80000000 !Function enable mask (bit 31 or 32 set=DEBUG(hex))
!Users to ignore
OPA0:,TTA0: !Terminals to ignore
ThEgReAtZaR
$ checksum nanny.inp
$ if chk.nes.checksum$checksum then write sys$output -
"NANNY.INP didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ chk = "2063871130"
$ create wakeacp.for
$ deck/dollars="ThEgReAtZaR"
IMPLICIT INTEGER(A-Z)
CHARACTER*128 INLINE
CHARACTER*40 PROM
CHARACTER*23 REQ_DATE
CHARACTER*14 REQ_USER
CHARACTER*12 MBXNAM
INTEGER*4 QWAIT(2)
INTEGER*2 REQ_ID,REQ_UIC(2)
LOGICAL*1 ILOGI,BUFF(28)
EQUIVALENCE (BUFF(1),REQ_ID ),(REQ_UIC,BUFF(3))
EQUIVALENCE (REQ_USER,BUFF(7)),(QWAIT,BUFF(21))
c
OPEN(UNIT=1,NAME='NANNYS$BOX',SHARED,STATUS='OLD',ERR=2)
CALL SYS$CREMBX(%VAL(0),MBXCHN,,,,,'NAN$RET')
CALL SYS$TRNLOG('NAN$RET',,MBXNAM,,,)
CALL LIB$GET_FOREIGN(INLINE,,L)
IF (L.EQ.0) THEN
WRITE(6,'(A)') '$To(username or terminal): '
READ(5,'(A)',END=2) PROM
IF (LENCH(PROM).EQ.0) GOTO 2
CALL STR$UPCASE(PROM,PROM)
INLINE='WAKE '//PROM(:LENCH(PROM))//':'
WRITE(6,'(A)') '$Time(dd-mmm-yyyy hh:mm:ss.ss): '
READ(5,'(A)',END=2) PROM
IF (LENCH(PROM).EQ.0) PROM='-- ::.'
CALL STR$UPCASE(PROM,PROM)
IF (SYS$BINTIM(PROM,QWAI).GT.1) GOTO 3
INLINE=INLINE(:LENCH(INLINE))//' '//PROM(:LENCH(PROM))//' "'
WRITE(6,'(A)') '$Message: '
READ(5,'(A)',END=2) PROM
IF (LENCH(PROM).EQ.0) GOTO 2
IF (PROM(1:1).EQ.'"') PROM=PROM(2:)
INLINE=INLINE(:LENCH(INLINE))//PROM
ELSE IF (INDEX(INLINE,'/S').NE.0.OR.INDEX(INLINE,'/s').NE.0)
1 THEN
WRITE(6,'(A)') ' '
WRITE(6,'(A)') ' * Wake-up queue "Nanny" Joblim=25'
WRITE(6,'(A)') ' '
INLINE='WSHOW '//MBXNAM(:LENCH(MBXNAM))//' '
WRITE(1,'(A)') ' '//INLINE(:LENCH(INLINE)+1)
1 CODE=SYS$QIOW(,%VAL(MBXCHN),%VAL('31'X),,,,BUFF,%VAL(28),,,,)
IF (CODE.NE.1) CALL SYS$EXIT(%VAL(CODE))
IF (REQ_ID.NE.-1) THEN
CODE=SYS$ASCTIM(,REQ_DATE(:23),QWAIT,)
IF (CODE.NE.1) CALL SYS$EXIT(%VAL(CODE))
DO I=LEN1(REQ_USER),14
REQ_USER(I:I)=' '
END DO
WRITE(6,'(A,I2,A,O3,A,O3,A)') ' #',REQ_ID+9,' from [',
1 REQ_UIC(2),',',REQ_UIC(1),'] to '//REQ_USER//' at '//
2 REQ_DATE(:20)
GOTO 1
END IF
CALL EXIT
ELSE IF (INDEX(INLINE,'/D').NE.0.OR.INDEX(INLINE,'/d').NE.0)
1 THEN
IF (INDEX(INLINE,'=').EQ.0) THEN
INLINE='WCLR '//MBXNAM(:LENCH(MBXNAM))//' * '
ELSE
INLINE=INLINE(INDEX(INLINE,'=')+1:)
IF (LENCH(INLINE).EQ.0) STOP 'Invalid request number'
INLINE='WCLR '//INLINE(:2)
END IF
ELSE
I=INDEX(INLINE,'"')
IF (I.EQ.0) STOP 'No message'
I=INDEX(INLINE,'-')
IF (I.EQ.0) STOP 'No date'
I=INDEX(INLINE,':')
IF (I.EQ.0) STOP 'Bad time specified'
I=INDEX(INLINE,'.')
IF (I.EQ.0) STOP 'Bad time specified'
I=INDEX(INLINE,' ')
IF (INLINE(I-1:I-1).NE.':') INLINE=INLINE(1:I-1)//
1 ':'//INLINE(I:)
INLINE='WAKE '//INLINE
END IF
INLINE=INLINE(:5)//MBXNAM(:LENCH(MBXNAM))//' '//INLINE(6:)
WRITE(1,'(A)') ' '//INLINE(:LENCH(INLINE))
CALL SYS$QIOW(,%VAL(MBXCHN),%VAL('31'X),,,,ILOGI,%VAL(1),,,,)
I=ILOGI
IF (I.LT.0) WRITE(6,'(A,I2,A)') ' Wake-up call request #',I*-1,
1 ' queued'
IF (I.GT.1) STOP 'Nanny could not process request; try again.'
IF (I.EQ.1) STOP 'Request cancelled'
2 CALL EXIT
3 STOP 'Bad date/time'
END
INTEGER FUNCTION LENCH(STRING)
C
C This code was created solely by The Zar.
C All portions of this routine/program are licensed
C only by The Zar. Duplication or transportation of
C this code is in violation of copy rights. Any
C duplication and/or transportation of this code may
C cause portions of this program/routine not to work.
C
C -The Zar
C
CHARACTER*(*) STRING
CHARACTER*1 NUL
DATA NUL/0/
IF (STRING.EQ.' '.OR.STRING(1:1).EQ.NUL) THEN
LENCH=0
RETURN
ENDIF
DO 100 LENCH=LEN(STRING),1,-1
IF (STRING(LENCH:LENCH).NE.' '.AND.STRING(LENCH:LENCH).NE.NUL)
1 GOTO 200
100 CONTINUE
LENCH=0
200 RETURN
END
FUNCTION LEN1(STR)
C
C This code was created solely by The Zar.
C All portions of this routine/program are licensed
C only by The Zar. Duplication or transportation of
C this code is in violation of copy rights. Any
C duplication and/or transportation of this code may
C cause portions of this program/routine not to work.
C
C -The Zar
C
CHARACTER*(*) STR
I=LENCH(STR)
IF (I.EQ.0) I=1
LEN1=I
RETURN
END
ThEgReAtZaR
$ checksum wakeacp.for
$ if chk.nes.checksum$checksum then write sys$output -
"WAKEACP.FOR didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ chk = "1342642494"
$ create nannyacp.for
$ deck/dollars="ThEgReAtZaR"
program nanny
c
c Execute some of the Nanny's functions
c
parameter ss$_normal = 1
parameter maxcom = 21
parameter nan$_comdis = '1f'x
parameter nan$_invcom = '1d'x
parameter nan$_nonsys = '21'x
parameter nan$_nopriv = '20'x
parameter nan$_normal = 1
parameter nan$_noslot = '1b'x
parameter nan$_nosuchcom = '1e'x
parameter nan$_retwarn = '1c'x
parameter nan_inp = 'NANNYS$BOX:'
implicit integer*4 (a-z)
include '($jpidef)'
include '($lnmdef)'
character*80 comand
character*23 req_datim
character*14 tty
character*10 shoe_box_nam
character*8 my_pid
character*7 coms(maxcom)
integer*4 jpilist(4),com_abv(maxcom),qwait(2),lnmlis(4)
integer*2 term_chan,req_id,req_user(2)
logical*1 buff,buffr(28)
equivalence (req_id,buffr(1)),(req_user,buffr(3))
equivalence (tty,buffr(7)),(qwait,buffr(21))
data coms/'ADDACC','DIE','ENTER','FORGET','FREE','GRAB',
1 'IGNORE','KILL','LISTEN','NEW','ODIS','OEN','QSTART','QSTOP',
2 'REQUEUE','RESUME','STOP','SUSPEND','WAKE','WCLR','WSHOW'/
data com_abv/1,1,2,2,2,1,1,1,1,1,2,2,4,4,3,3,2,2,2,2,2/
c
c Create a mailbox to communicate with the Nanny
c
code = sys$crembx(%val(0),term_chan,,,,,'SHOE_BOX')
if (code.ne.ss$_normal) call sys$exit(%val(code))
lnmlis(1) = lnm$_string * 2**16 + 10
lnmlis(2) = %loc(shoe_box_nam)
lnmlis(3) = 0
lnmlis(4) = 0
code = sys$trnlnm(,'LNM$JOB','SHOE_BOX',,lnmlis)
if (code.ne.ss$_normal) call sys$exit(%val(code))
c
c Get the user's process I.D.
c
jpilist(1) = jpi$_pid*2**16 + 4
jpilist(2) = %loc(pid)
jpilist(3) = 0
jpilist(4) = 0
code = lib$get_ef(ef)
if (code.ne.ss$_normal) call sys$exit(%val(code))
code = sys$getjpi(%val(ef),,,jpilist,,,)
if (code.ne.ss$_normal) call sys$exit(%val(code))
call sys$waitfr(%val(ef))
write(my_pid,'(Z8)',err=1) pid
do while(lench(my_pid(1:1)).eq.0)
my_pid = my_pid(2:)
end do
goto 2
c
c Error converting the process I.D. to a character string.
c
1 call errsns(i,j,k,l,code)
call sys$exit(%val(code))
c
c Open the mailbox to the Nanny
c
2 open(unit=1,name=nan_inp,shared,err=1,status='old')
c
c Prompt for commands
c
3 write(5,'(a)',err=4) '$Nanny> '
4 read(5,'(a)',err=3,end=999) comand
if (lench(comand).eq.0) goto 3
call str$upcase(comand,comand)
do while(lench(comand(1:1)).eq.0)
comand = comand(2:)
end do
c
c Give help
c
if (comand(1:1).eq.'H') then
write(6,100)
goto 3
end if
c
c Replace the input command with the full length command
c
comnum=0
i=index(comand,' ')
j=index(comand,'"')
if (j.eq.0) j=lench(comand)
do j=1,maxcom
if (comand(:i-1).eq.coms(j)(:i-1)) comnum=j
end do
if (comnum.eq.0) then
write(6,'(a)') ' No such command'
goto 3
end if
if (i.lt.com_abv(comnum)) then
write(6,'(a)') ' Ambiguous command'
goto 3
end if
comand=coms(comnum)(:len1(coms(comnum)))//' '//comand(i+1:)
c
c Insert the receiving mailbox
c
i=index(comand,' ')
comand=comand(:i)//shoe_box_nam(:len1(shoe_box_nam))//' '//
1 comand(i+1:)
if (comnum.eq.1.or.comnum.eq.2.or.comnum.eq.5) goto 6
if (comnum.eq.6.or.comnum.eq.7.or.comnum.eq.9) goto 6
if (comnum.eq.10.or.comnum.ge.19) goto 6
comand=comand(:len1(comand))//' '//my_pid
6 write(1,'(a)',err=1) comand(:len1(comand))//' '
if (comnum.ne.19) then
write(5,'(a)',err=5) ' waiting for a reply from your Nanny...'
else
write(6,'(a)') ' '
write(6,'(a)') ' * Wake-up queue "Nanny" Joblim=25'
write(6,'(a)') ' '
7 code=sys$qiow(,%val(term_chan),%val('31'x),,,,buffr,%val(28),,
1 ,,)
if (code.ne.ss$_normal) then
8 write(6,'(a)') ' Error receiving queue information'
goto 3
end if
if (req_id.ne.-1) then
code=sys$asctim(,req_datim(:23),qwait,)
if (code.ne.ss$_normal) goto 8
do ii=len1(tty),14
tty(ii:ii)=' '
end do
write(6,'(a,i2,a,o3,a,o3,a)') ' #',req_id+9,' from [',
1 req_user(2),',',req_user(1),'] to '//tty//' at '//
2 req_datim(:20)
goto 7
end if
end if
5 code=sys$qiow(,%val(term_chan),%val('31'x),,,,buff,%val(1),,,,)
if (code.eq.ss$_normal) then
if (buff.eq.1) write(6,'(a)') ' Function granted by your '//
1 'Nanny'
if (buff.eq.nan$_nopriv) write(6,'(a)') ' Function denied'
if (buff.eq.nan$_nonsys) write(6,'(a)') ' Function denied: '//
1 'non-system user'
if (buff.eq.nan$_comdis) write(6,'(a)') ' Function disabled'
if (buff.eq.nan$_invcom) write(6,'(a)') ' Function incor'//
1 'rectly sent'
if (buff.eq.nan$_noslot) write(6,'(a)') ' Function denied: '//
1 'no slot available in queue'
if (buff.eq.nan$_retwarn) write(6,'(a)') ' Function issued:'//
1 ' error return status from manager received'
if (buff.lt.0) write(6,'(a,i2,a)') ' Function issued: '//
1 'request #',-1*buff,' has been queued'
else
write(6,'(a)') ' Error sending request'
end if
goto 3
100 format(' Comands:',t20,'ADDACC req_pid mess',/,t20,'DIE',/,
1 t20,'ENTER target_pid',/,t20,'FORGET target_pid',/,
2 t20,'FREE devnam',/,t20,'GRAB devnam',/,
3 t20,'HELP',/,t20,'IGNORE',/,t20,'KILL target_pid',/,
4 t20,'LISTEN',/,t20,'NEW',/,
5 t20,'ODIS',/,t20,'OEN',/,t20,'QSTART queue',/,
6 t20,'QSTOP queue',/,t20,'REQUEUE queue',/,
7 t20,'RESUME target_pid',/,t20,'STOP target_pid',/,
8 t20,'SUSPEND target_pid',/,t20,'WAKE tty date time mess',/,
9 t20,'WCLR tim_num',/,t20,'WSHOW',/,/,
1 ' See "HELP @USER Nanny" for more information.')
999 end
INTEGER FUNCTION LENCH(STRING)
C
C This code was created solely by The Zar.
C All portions of this routine/program are licensed
C only by The Zar. Duplication or transportation of
C this code is in violation of copy rights. Any
C duplication and/or transportation of this code may
C cause portions of this program/routine not to work.
C
C -The Zar
C
CHARACTER*(*) STRING
CHARACTER*1 NUL
DATA NUL/0/
IF (STRING.EQ.' '.OR.STRING(1:1).EQ.NUL) THEN
LENCH=0
RETURN
ENDIF
DO 100 LENCH=LEN(STRING),1,-1
IF (STRING(LENCH:LENCH).NE.' '.AND.STRING(LENCH:LENCH).NE.NUL)
1 GOTO 200
100 CONTINUE
LENCH=0
200 RETURN
END
FUNCTION LEN1(STR)
C
C This code was created solely by The Zar.
C All portions of this routine/program are licensed
C only by The Zar. Duplication or transportation of
C this code is in violation of copy rights. Any
C duplication and/or transportation of this code may
C cause portions of this program/routine not to work.
C
C -The Zar
C
CHARACTER*(*) STR
I=LENCH(STR)
IF (I.EQ.0) I=1
LEN1=I
RETURN
END
ThEgReAtZaR
$ checksum nannyacp.for
$ if chk.nes.checksum$checksum then write sys$output -
"NANNYACP.FOR didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ chk = "90101888"
$ create nanny.inc
$ deck/dollars="ThEgReAtZaR"
C
C (do not change this include file and expect things to fly on
C the first go -- I suggest you consult me first as the include
C file is new for VMS V4)
C
C (c) Zar Ltd. 1985
C
parameter maxdisks = 16
parameter maxig_term = 16
parameter maxig_user = 32
parameter maxpri = 15
parameter maxuser = 128
parameter max_average = 10
parameter max_wake = 25
parameter nan$_comdis = '1f'x
parameter nan$_invcom = '1d'x
parameter nan$_nonsys = '21'x
parameter nan$_nopriv = '20'x
parameter nan$_normal = '01'x
parameter nan$_noslot = '1b'x
parameter nan$_nosuchcom = '1e'x
parameter nan$_retwarn = '1c'x
parameter nan$v_batch = 0
parameter nan$v_detach = 1
parameter nan$v_inter = 2
parameter nan$v_network = 3
parameter nan$v_subproc = 4
parameter nan$v_unknown = 5
parameter nan$_system = 6
parameter opcom = 'OPA0:'
character*15 nan_prcnam
character*12 c_username
character*12 ig_user(maxig_user)
character*10 c_phy_term
character*10 c_terminal
character*10 ig_term(maxig_term)
character*8 c_account
character*8 prefacc(maxuser)
character*8 sysaccnam
character*6 consoles(8)
character*6 disks(maxdisks)
integer*4 cpu_average
integer*4 crush(maxuser)
integer*4 crush_p
integer*4 c_authpriv(2)
integer*4 c_bufio
integer*4 c_cpulim
integer*4 c_cputim
integer*4 c_dirio
integer*4 c_owner
integer*4 c_pageflts
integer*4 c_ipid
integer*4 c_pid
integer*4 c_sts
integer*4 c_wssize
integer*4 disable
integer*4 functmsk
integer*4 ipid(maxuser)
integer*4 lasterr(maxdisks)
integer*4 lowdivd
integer*4 lowphymem
integer*4 low_free
integer*4 maxelapsed
integer*4 maxidle
integer*4 maxphymem
integer*4 minio
integer*4 mintim
integer*4 pid(maxuser)
integer*4 ranjpipid
integer*4 susp_ipid(maxuser)
integer*4 susp_pid(maxuser)
integer*4 suspids
integer*4 sysgrp
integer*4 truewait(2)
integer*4 waitim
integer*2 authpri(maxuser)
integer*2 crpri(maxuser)
integer*2 c_prccnt
integer*2 c_prib
integer*2 c_uic(2)
integer*2 die
integer*2 mbx2
integer*2 mbx3
integer*2 mbxchan
integer*2 prib(maxuser)
integer*2 system(maxuser)
real*4 prefadd(maxuser)
logical*1 debugging
logical*1 dsk_die
logical*1 inbuff(128)
logical*1 listen
logical*1 purgews
logical*1 startup_flg
common/diecom/ authpri,crush,crpri,crush_p,prib,debugging
common/dsk_com/ dsk_die,disks,low_free,lasterr
common/jpicom_i/c_authpriv,c_bufio,c_cpulim,c_cputim,c_dirio,
1 c_owner,c_pageflts,c_ipid,c_pid,c_prccnt,
2 c_prib,c_sts,c_uic,c_wssize,ranjpipid
common/jpicom_s/c_account,c_phy_term,c_terminal,c_username
common/nanny/ mbx2,mbx3,die,mbxchan,inbuff,ipid,pid,disable,
1 system
common/nanopr/ consoles,listen
common/param/ sysgrp,waitim,cpu_average,maxidle,maxelapsed,
1 mintim,minio,truewait,lowdivd,purgews,maxphymem,
2 lowphymem,functmsk,prefadd
common/param1/ sysaccnam,nan_prcnam,ig_user,ig_term,prefacc
common/strtup/ startup_flg
common/susped/ susp_ipid,susp_pid,suspids
ThEgReAtZaR
$ checksum nanny.inc
$ if chk.nes.checksum$checksum then write sys$output -
"NANNY.INC didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ exit