+-+-+-+ Beginning of part 19 +-+-+-+ X CHARACTER*31`009QUEUE_NAME X INTEGER*2`009SEARCH_NAME_LEN X INTEGER*2 QUEUE_NAME_LEN X INTEGER*4`009SEARCH_FLAGS X integer*4`009pid,job_pid X XC Solicit queue name to search; it may be a wildcard name X SEARCH_NAME='*' X SEARCH_NAME_LEN=1 XC Initialize item list for the display operation X QUEUE_LIST(1).BUFLEN = SEARCH_NAME_LEN X QUEUE_LIST(1).ITMCOD = QUI$_SEARCH_NAME X QUEUE_LIST(1).BUFADR = %LOC(SEARCH_NAME) X QUEUE_LIST(1).RETADR = 0 X QUEUE_LIST(2).BUFLEN = 4 X QUEUE_LIST(2).ITMCOD = QUI$_SEARCH_FLAGS X QUEUE_LIST(2).BUFADR = %LOC(SEARCH_FLAGS) X QUEUE_LIST(2).RETADR = 0 X QUEUE_LIST(3).BUFLEN = 31 X QUEUE_LIST(3).ITMCOD = QUI$_QUEUE_NAME X QUEUE_LIST(3).BUFADR = %LOC(QUEUE_NAME) X QUEUE_LIST(3).RETADR = %LOC(QUEUE_NAME_LEN) X QUEUE_LIST(4).END_LIST = 0 X XC Initialize item list for the display job operation X JOB_LIST(1).BUFLEN = 4 X JOB_LIST(1).ITMCOD = QUI$_SEARCH_FLAGS X JOB_LIST(1).BUFADR = %LOC(SEARCH_FLAGS) X JOB_LIST(1).RETADR = 0 X JOB_LIST(2).BUFLEN = 4 X JOB_LIST(2).ITMCOD = QUI$_JOB_PID X JOB_LIST(2).BUFADR = %LOC(JOB_PID) X JOB_LIST(2).RETADR = 0 X JOB_LIST(3).END_LIST= 0 X XC Request search of all jobs present in output queues; also force XC wildcard mode to maintain the internal search context block after XC the first call when a non-wild queue name is entered--this preserves XC queue context for the subsequent display job operation X SEARCH_FLAGS = (QUI$M_SEARCH_WILDCARD .OR. X 1 QUI$M_SEARCH_executing_jobs .OR. X 2 QUI$M_SEARCH_ALL_JOBS. or. X 3`009`009 qui$M_SEARCH_BATCH) X XC Dissolve any internal search context block for the process X STATUS_Q = SYS$GETQUIW (,%VAL(QUI$_CANCEL_OPERATION),,,,,) X IF (.NOT. STATUS_Q) CALL EXIT(STATUS_Q) X XC Locate next output queue; loop until an error status is returned X DO WHILE (STATUS_Q) X STATUS_Q = SYS$GETQUIW(, X 1 %VAL(QUI$_DISPLAY_QUEUE),, X 2 QUEUE_LIST, X 3 IOSB,,) X IF (.NOT. STATUS_Q) CALL EXIT(STATUS_Q) X IF (STATUS_Q) STATUS_Q = IOSB.STS X STATUS_J = 1 X XC Get information on next job in queue; loop until error return X DO WHILE (STATUS_Q .AND. STATUS_J) X STATUS_J = SYS$GETQUIW (, X 1 %VAL(QUI$_DISPLAY_JOB),, X 2 JOB_LIST, X 3 IOSB,,) X IF (.NOT. STATUS_J) CALL EXIT(STATUS_J) X IF (STATUS_J) STATUS_J = IOSB.STS X IF (STATUS_J.and.(job_pid.eq.pid)) THEN X X get_queue = QUEUE_NAME(1:INDEX(QUEUE_NAME,CHAR(0))-1) X`009 return X ENDIF X X ENDDO X X ENDDO X get_queue=' '`009 X return X END $ GOSUB UNPACK_FILE $ FILE_IS = "IDLE-MON.MAR" $ CHECKSUM_IS = 186205168 $ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY X`009.Title`009Install-Idle-Monitor X; X;`009This loads code into system space and patches into the X;`009terminal port/class interface to update UCB$L_ABSTIM whenever X;`009a character is sent or received. This allows us to keep X;`009track of 'idletime' on non-TIMED devices. X; X X`009.library /SYS$LIBRARY:LIB/ X`009$CXBDEF X`009$DDTDEF X`009$DPTDEF X`009$DYNDEF X`009$TTYUCBDEF X`009$TTYVECDEF X`009$UCBDEF X X`009.Entry`009Install_Idle_Monitor,`094m<> X`009$CMKRNL_S $$Install_Idle_Monitor X`009Ret X X X`009.Entry`009$$Install_Idle_Monitor,`094m X X`009; X`009; See if we have an RTA0 device installed. X`009; X X`009Clrl`009R7`009`009`009; Assume no RTDRIVER DDT to patch X`009Jsb`009G`094Sch$IOLockR`009`009; Lock the I/O database X X`009MovAQ`009RT_DEVICE,R1 X`009Jsb`009G`094IOC$SearchDev`009`009; Search for RTA0 X`009Blbc`009R0,1$ X`009Movl`009UCB$L_DDT(R1),R7 X1$: X X; X;`009Allocate a buffer to hold the code the be loaded into X;`009nonpaged pool X; X X`009MovL`009#CodeLen+12,R1`009`009; Skip 12 bytes for pool header X`009TstL`009R7 X`009BEql`0092$ X`009AddW2`009DDT$W_FDTSIZE(R7),R1`009; Room for old FDT X`009AddW2`009#3*4,R1`009`009`009; Room for the new FDT entry X2$: X X`009Jsb`009G`094Exe$AllocBuf X`009Blbs`009R0,10$ X`009Pushl`009R0 X`009Brb`009Done X10$: X X; X;`009Copy the code into the pool X; X X`009MovAB`00912(R2),R6`009`009 ; Address of start of code X`009MovC3`009#CodeLen,W`094Code,(R6)`009 ; Copy code into pool X X; X;`009Link the code into the class interface to TTDRIVER. X; X X`009MovL`009G`094TTY$GL_DPT,R1`009`009 ; Get TTDRIVER DPT X`009MovZWL`009DPT$W_VECTOR(R1),R0`009 ; Offset to CLASS VECTOR X`009AddL2`009R0,R1`009`009`009 ; Address of CLASS VECTOR X X`009MovL`009CLASS_GETNXT(R1),B`094V1_Jump-Code(R6) X`009MovL`009CLASS_PUTNXT(R1),B`094V2_Jump-Code(R6) X`009MovAB`009B`094V1-Code(R6),CLASS_GETNXT(R1) X`009MovAB`009B`094V2-Code(R6),CLASS_PUTNXT(R1) X X; X;`009Build a new FDT routine for RTTDRIVER. X; X`009Tstl`009R7 X`009Beql`00920$ X`009Addl3`009S`094#Patched_RT_FDT-Code,R6,R0; Pointer to start of new FDT X`009Movl`009DDT$L_FDT(R7),R1`009 ; Pointer to start of old FDT X`009MovQ`009(R1)+,(R0)+`009`009 ; Copy the supported I/O mask X`009MovQ`009(R1)+,(R0)+`009`009 ; Copy the buffered I/O mask X`009MovQ`009-16(R1),(R0)+`009`009 ; Copy the supported into the new entry X`009MovAB`009B`094RTT_Fix-Code(R6),(R0)+ ; New FDT code address X`009MovZWL`009DDT$W_FDTSIZE(R7),R2 X`009SubL2`009#16,R2`009`009`009 ; Calculate size of remaining FDT X`009MovC3`009R2,(R1),(R0)`009`009 ; Move it X`009MovAL`009B`094Patched_RT_FDT-Code(R6),DDT$L_FDT(R7) V`009AddW2`009#12,DDT$W_FDTSIZE(R7)`009 ; Update the pointers to the new FD XT X20$: X; X;`009Exit X; X`009Pushl`009#SS$_NORMAL XDone:`009Movl`009G`094CTL$GL_PCB,R4 X`009Jsb`009G`094SCH$IoUnLock X`009PopL`009R0 X`009Ret X X XRT_DEVICE: X`009.Ascid`009/_RTA0:/ X X; X; This code sits in between the port/class interface for each X; terminal and updates the "DUETIM" field when each I/O occurs X; It *Must* be PIC. X; XCode: XV1:`009BBC`009#TTY$V_PC_NOTIME,UCB$W_TT_PRTCTL(R5),10$ X`009MovL`009@#EXE$GL_ABSTIM,UCB$L_DUETIM(R5) X10$:`009Jmp`009@I`094#00000000 XV1_Jump = .-4 X X XV2:`009BBC`009#TTY$V_PC_NOTIME,UCB$W_TT_PRTCTL(R5),10$ X`009MovL`009@#EXE$GL_ABSTIM,UCB$L_DUETIM(R5) X10$:`009Jmp`009@I`094#00000000 XV2_Jump = .-4 X XRtt_Fix:MovL`009@#EXE$GL_ABSTIM,UCB$L_DUETIM(R5) X`009Rsb X XCodeLen = .-Code X XPatched_RT_FDT: X X`009.End`009Install_Idle_Monitor $ GOSUB UNPACK_FILE $ FILE_IS = "INETSYM.INC" $ CHECKSUM_IS = 1498044856 $ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY Xc symbol definitions for Eunice TCP VMS hooks Xc 3-oct-1984 X integer AF_INET X parameter (AF_INET=2) X integer SOCK_STREAM X parameter (SOCK_STREAM=1) X X integer IO$_ACCESS X parameter (IO$_ACCESS='32'x) X integer IO$_READVBLK X parameter (IO$_READVBLK='31'x) X integer IO$_WRITEVBLK X parameter (IO$_WRITEVBLK='30'x) X X integer IO$_SEND X parameter (IO$_SEND=IO$_WRITEVBLK) X integer IO$_RECEIVE X parameter (IO$_RECEIVE=IO$_READVBLK) X integer IO$_SOCKET X parameter (IO$_SOCKET=IO$_ACCESS) X integer IO$_BIND X parameter (IO$_BIND=IO$_ACCESS+64) X integer IO$_LISTEN X parameter (IO$_LISTEN=IO$_ACCESS+128) X integer IO$_ACCEPT X parameter (IO$_ACCEPT=IO$_ACCESS+192) X integer IO$_CONNECT X parameter (IO$_CONNECT=IO$_ACCESS+256) X integer IO$_ACCEPT_WAIT X parameter (IO$_ACCEPT_WAIT=IO$_ACCESS+640) $ GOSUB UNPACK_FILE $ FILE_IS = "INSTALL_FINGER.COM" $ CHECKSUM_IS = 779323160 $ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY X$ Save_verify`009:=`009'F$Verify(0) X$!..Install_Finger.com`009`009`009Install Finger sytem X$!..`009`009`009`009`009R. Garland / C.U.Chemistry / Feb-1985 X$!..`009`009`009`009`009For version 5.1 of VMS X$!`009`009P1`009-`009Options: when set, instructions are terse X$!`009`009`009`009and many more items are optional. X$ On `009Error`009Then GoTo Exit X$ Options`009==`0090 X$ If`009P1.eqs.""`009Then Goto A$1 X$ Options`009==`009P1 X$ A$1: X$ Write`009`009Sys$Output`009" " X$ If Options`009Then Goto L1 X$ Type`009`009Sys$Input X`009This procedure installs the Finger program and associated X`009programs on your system. For each question asked by this X`009procedure, a default answer is given in parentheses after X`009the question. Just hit and the default will be used. X X`009This procedure copies files into system directories and uses X`009the INSTALL utility, so you need to be logged on with system X`009privileges to proceed. X X`009Before running this procedure you should review the installation X`009document ( FINGER.DOC ) and decide if any changes need to be X`009made to any of the source files. These must be edited by you and X`009the object libraries must then be rebuilt using the procedure X`009BUILD_FINGER.COM (or by hand). If you did not receive the object X`009libraries, you must run BUILD_FINGER before proceding. X X`009Some typical reasons for editing and rebuilding are to change X`009the default qualifiers used by finger, or to change the capacity X`009of the database for terminals, network nodes, users, etc. X`009If you have more than 100 terminals, or more than 200 users, or X`009more than 100 network hosts, review the installation document X`009as relates to increasing these limits. X X$ Inquire`009Ans`009" Shall we proceed? (YES) " X$ If`009Ans .eqs. ""`009Then GoTo Proceed X$ If`009Ans`009`009Then GoTo Proceed X$ GoTo`009`009Exit X$ Proceed: X$ Type`009`009Sys$Input X X`009The parts of the finger system go into several directories. The X`009help files will be put into SYS$HELP. If there is a particular X`009directory where executable programs for general use are kept at X`009your site ( a public library ), then finger will be put there. X`009Otherwise it will be put in SYS$COMMON:[SYSEXE]. (In some of X`009the commands in this procedure, the chosen directory will be X`009given the logical name "Finger$Directory". This name is not re- X`009quired once the installation is complete.) X X$ L1: V$ Inquire`009Ans`009" Give name of directory to be used (SYS$COMMON:[SYSEXE]) X " X$ Write`009`009Sys$Output`009" " X$ If`009`009Ans .eqs. ""`009`009Then Ans := Sys$Common:[Sysexe] X$ LogAns`009:=`009`009`009'F$Log(Ans)' X$ If`009`009LogAns .eqs. ""`009`009Then LogAns := 'Ans' X$ If Options`009Then Goto L2 X$ Type`009`009Sys$Input X X`009Ignore possible "... superceded" messages. X X$ L2: X$ Define`009Finger$Directory`009'LogAns' X$ Type`009`009Sys$Input X X`009If you have an old version of finger on your system, it X`009will be deinstalled now. X X$ If Options`009Then Goto L3 X$ Type`009`009Sys$Input X`009This procedure may produce several error messages:`032 X`009`009"No logical name match", or`032 X`009`009"known file entry not found", or`032 X`009`009"File not found".`032 X`009These messages can be ignored. X X$ L3: X$ Set`009NoOn X$ Set Verify X$ Deasign/System/Exec`009FingerShr X$ Run Sys$System:Install XFinger$Directory:Finger`009/Delete XFinger$Directory:FingerShr`009/Delete X$ Type`009`009Sys$Input`009!`009'F$Verify(0) X X$ Inquire`009Ans - X" Do you have ""jnet"" (IBM RSCS networking) support? (NO) " X$ jnet`009=`0090 X$ jlib`009`009:=`009`009`009"Jlib/Lib" X$ If`009`009Ans .eqs. ""`009`009Then GoTo j1 X$ If`009`009.not. Ans`009`009Then GoTo j1 X$ jlib `009`009:= `009`009`009"Jan_Lib:BITLib/Lib" X$ jnet`009=`0091 X$ j1: X$ If Options`009Then Goto L4 X$ Type`009`009Sys$Input X X`009The finger program and the database maintenance program X`009will now be linked and moved to the appropriate directory. X X$ L4: X$ If .not. Options`009Then Goto Lnk$1 X$ Write`009`009Sys$Output`009" " X$ Inquire`009Ans`009" Link FINGERSHR? (YES) " X$ If Ans.eqs.""`009Then Goto Lnk$1 X$ If .not. Ans`009`009Then Goto Lnk$2 X$ Lnk$1: X$ Set Verify X$ Link/NoTrace`009FingerLib/Lib/Include=FingerShr `009- X`009`009/Share='F$Log("Finger$Directory")'FingerShr, - X`009`009Sys$Input/Options XGSMATCH=LEQUAL,1,12 X$ Lnk$2:`009! 'F$Verify(0) X$ If .not. Options`009Then Goto Lnk$3 X$ Write`009`009Sys$Output`009" " X$ Inquire`009Ans`009" Link FINGER? (YES) " X$ If Ans.eqs.""`009Then Goto Lnk$3 X$ If .not. Ans`009`009Then Goto Lnk$4 X$ Lnk$3: X$ If Jnet `009Then Goto Lnk$3a X$ Set Verify X$ Link/NoTrace`009FingerLib/Lib/Include=Finger$Main, `009- X`009`009'jlib',`009- X`009`009Sys$System:Sys.Stb/Sel, `009`009- X`009`009Sys$Input/Options `009`009`009- X`009`009/Exe='F$Log("Finger$Directory")'Finger XFinger$Directory:FingerShr/Share X$ Goto Lnk$3b X$ Lnk$3a: X$ Set Verify X$ Link/NoTrace`009FingerLib/Lib/Include=Finger$Main, `009- X`009`009Sys$System:Sys.Stb/Sel, `009`009- X`009`009Sys$Input/Options `009`009`009- X`009`009/Exe='F$Log("Finger$Directory")'Finger XFinger$Directory:FingerShr/Share Xjanshr/share X$ Lnk$3b:`009! 'F$Verify(0) X$ Open/Write`009FingerLAT`009Finger$Directory:FingerLAT.com X$ Write`009FingerLAT`009"$ !'f$verify(0)" X$ Write FingerLAT`009"$ set proc/priv=(oper,sysprv)" X$ Write FingerLAT`009"$ set noon" X$ Write FingerLAT`009"$ deassign tsm$no_proxy" X$ Write FingerLAT`009"$ tsm/server='p1' SHOW SESSION ALL" X$ Write FingerLAT`009"$ exit" X$ Close`009`009FingerLAT X$ Set File/Prot=(w:re)`009Finger$Directory:FingerLAT.com X$ Lnk$4:`009! 'F$Verify(0) X$ If .not. Options`009Then Goto Lnk$5 X$ Write`009`009Sys$Output`009" " X$ Inquire`009Ans`009" Link FINGMAINT? (YES) " X$ If Ans.eqs.""`009Then Goto Lnk$5 X$ If .not. Ans`009`009Then Goto Lnk$6 X$ Lnk$5: X$ Set Verify X$ Link/NoTrace`009FingerLib/Lib/Include=FingMaint, `009- X`009`009Sys$Input/Options `009`009`009- X`009`009/Exe='F$Log("Finger$Directory")'FingMaint XFinger$Directory:FingerShr/Share X$ LNK$6:`009! 'F$Verify(0) X$ If .not. Options`009Then Goto Lnk$7 X$ Write`009`009Sys$Output`009" " X$ Inquire`009Ans`009" Link IDLE-MON? (YES) " X$ If Ans.eqs.""`009Then Goto Lnk$7 X$ If .not. Ans`009`009Then Goto Lnk$8 X$ LNK$7: X$ Set Verify X$ Link/NoTrace`009Idle-Mon,SYS$SYSTEM:SYS.STB/SELECT`009- X`009`009/Exe='F$Log("Finger$Directory")'Idle-Mon X$ LNK$8:`009! 'F$Verify(0) X$ Write`009`009Sys$Output`009" " X$ Set Verify X$ Define/System/Exec`009FingerShr`009'F$Log("Finger$Directory")'FingerShr X$ If Options`009Then Goto L5`009! 'F$Verify(0) X$ Type`009`009Sys$Input X X`009The help files are normally installed in SYS$HELP. This X`009may be undesirable at some sites. If you wish to use an X`009alternate directory, reply NO to the following prompt, X`009manually issue the commands: X X`009Copy`009Fingmaint.Hlb`009`009 X`009Libr`009/help`009Finger X X$ Inquire`009Ans`009" Install HELP files in SYS$HELP:? (YES) " X$ If Ans.eqs."" `009Then Goto Hlp$0 X$ If .not. Ans`009`009Then Goto Hlp$2 X$ Hlp$0: X$ Type`009`009Sys$Input X X`009The help files will now be installed in SYS$HELP. This X`009step may fail if someone else is using the HELP utility. X`009If it does, just repeat the LIB command (below) at a X`009later time. X$ L5: X$ Set `009`009NoOn X$ If .not. Options`009Then Goto Hlp$1 X$ Write`009`009Sys$Output`009" " X$ Inquire`009Ans`009" Replace HELP files in SYS$HELP:? (YES) " X$ If Ans.eqs.""`009Then Goto Hlp$1 X$ If .not. Ans`009`009Then Goto Hlp$2 X$ Hlp$1: X$ Write`009`009Sys$Output`009" " X$ Set Verify -+-+-+-+-+ End of part 19 +-+-+-+-+-