%TITLE 'COLLECT_PINFO' MODULE COLLECT_PINFO (IDENT='V1.4') = BEGIN !++ ! FACILITY: FINGER ! ! ABSTRACT: Collects process information for FINGER. ! ! MODULE DESCRIPTION: ! ! description ! ! AUTHOR: M. Madison ! Copyright © 1994,1995 MadGoat Software. ! ALL RIGHTS RESERVED. ! ! CREATION DATE: 16-APR-1990 ! ! MODIFICATION HISTORY: ! ! 16-APR-1990 V1.0 Madison Initial coding. ! 30-AUG-1991 V1.0-1 Madison Add NOMOREPROC check after $GETJPI call. ! 27-MAY-1993 V1.1 Goatley Modified to get owner name instead of image. ! 31-MAY-1993 V1.1-1 Goatley Change $GETJPI to $GETJPIW so it'll work. ! 6-APR-1994 V1.2 Goatley Use RMS instead of $GETUAI. ! 12-APR-1994 V1.3 Goatley Fix bug that left SYSUAF open. Duh. ! 25-FEB-1995 V1.4 Madison Add /NOCLUSTER support. !-- LIBRARY 'SYS$LIBRARY:LIB'; LIBRARY 'FINGER'; LIBRARY 'FIELDS'; FORWARD ROUTINE COLLECT_PINFO, JPIAST; LITERAL PCTX_S_TRMNAM = 64, PCTX_S_ACCNAM = 64, PCTX_S_USRNAM = 32, PCTX_S_NODENAM = 16, PCTX_S_IMGNAM = 255; _DEF (PCTX) PCTX_Q_IOSB = _QUAD, PCTX_L_TXTQA = _LONG, PCTX_L_STATADR = _LONG, PCTX_L_ASTADR = _LONG, PCTX_L_ASTPRM = _LONG, PCTX_L_ITMLST = _LONG, PCTX_L_JPICTX = _LONG, PCTX_L_JPIFLG = _LONG, PCTX_X_UAFFAB = _BYTES (FAB$C_BLN), PCTX_X_UAFRAB = _BYTES (FAB$C_BLN), PCTX_W_USRPAT = _WORD, PCTX_T_USRPAT = _BYTES (PCTX_S_USRNAM), PCTX_W_TRMNAM = _WORD, PCTX_T_TRMNAM = _BYTES (PCTX_S_TRMNAM), PCTX_W_ACCNAM = _WORD, PCTX_T_ACCNAM = _BYTES (PCTX_S_ACCNAM), PCTX_W_USRNAM = _WORD, PCTX_T_USRNAM = _BYTES (PCTX_S_USRNAM), PCTX_W_NODENAM = _WORD, PCTX_T_NODENAM = _BYTES (PCTX_S_NODENAM), PCTX_W_IMGNAM = _WORD, PCTX_T_IMGNAM = _BYTES (PCTX_S_IMGNAM), PCTX_T_UAFREC = _BYTES (UAF$K_LENGTH) _ENDDEF (PCTX); EXTERNAL PRVMSK : VECTOR [2,LONG], NOCLUSTER; OWN TEMPLT : $ITMLST_DECL (ITEMS=6) PSECT ($PLIT$); EXTERNAL ROUTINE G_HAT (LIB$GET_VM, LIB$FREE_VM); %SBTTL 'COLLECT_PINFO' GLOBAL ROUTINE COLLECT_PINFO (USRNAM_A, TXTQ_A, STATUS_A, ASTADR, ASTPRM) = BEGIN !++ ! FUNCTIONAL DESCRIPTION: ! ! Collects process information for all interactive users matching ! the specified pattern. Completes asynchronously. ! ! RETURNS: cond_value, longword (unsigned), write only, by value ! ! PROTOTYPE: ! ! COLLECT_PINFO username, textq, astadr, astprm ! ! IMPLICIT INPUTS: None. ! ! IMPLICIT OUTPUTS: None. ! ! COMPLETION CODES: ! ! SS$_NORMAL: normal successful completion. ! ! SIDE EFFECTS: ! ! None. !-- BIND USRNAM = .USRNAM_A : BLOCK [,BYTE]; LOCAL PSCLST : $ITMLST_DECL (ITEMS=5), TMPLST : $ITMLST_DECL (ITEMS=6), CTX : REF PCTXDEF, STATUS; STATUS = LIB$GET_VM (%REF (PCTX_S_PCTXDEF), CTX); IF NOT .STATUS THEN RETURN .STATUS; CH$FILL (%CHAR (0), PCTX_S_PCTXDEF, .CTX); $FAB_INIT (FAB = ctx [PCTX_X_UAFFAB], FNS = %CHARCOUNT('SYSUAF'), FNA = UPLIT ('SYSUAF'), DNS = %CHARCOUNT('SYS$SYSTEM:.DAT'), DNA = UPLIT ('SYS$SYSTEM:.DAT'), FAC = GET, SHR = (GET,PUT,UPD,DEL,MSE)); $RAB_INIT (RAB = ctx [PCTX_X_UAFRAB], FAB = ctx [PCTX_X_UAFFAB], RAC = KEY, KRF = 0, KSZ = 12, KBF = ctx [PCTX_T_USRNAM], USZ = UAF$K_LENGTH, UBF = ctx [PCTX_T_UAFREC]); $SETPRV (ENBFLG=1, PRVADR=PRVMSK); status = $OPEN (FAB = ctx [PCTX_X_UAFFAB]); IF (.status) THEN status = $CONNECT (RAB = ctx [PCTX_X_UAFRAB]); $SETPRV (ENBFLG=0, PRVADR=PRVMSK); IF NOT (.status) THEN BEGIN LIB$FREE_VM (%REF (PCTX_S_PCTXDEF), ctx); RETURN .status; END; CTX [PCTX_L_TXTQA] = .TXTQ_A; CTX [PCTX_L_STATADR] = .STATUS_A; CTX [PCTX_L_ASTADR] = .ASTADR; CTX [PCTX_L_ASTPRM] = .ASTPRM; CTX [PCTX_W_USRPAT] = MIN (PCTX_S_USRNAM, .USRNAM [DSC$W_LENGTH]); CH$MOVE (.CTX [PCTX_W_USRPAT], .USRNAM [DSC$A_POINTER], CTX [PCTX_T_USRPAT]); $ITMLST_INIT (ITMLST=PSCLST, (ITMCOD=PSCAN$_MODE, BUFADR=JPI$K_INTERACTIVE, BUFSIZ=0, RETLEN=PSCAN$M_EQL), (ITMCOD=PSCAN$_TERMINAL, BUFADR=UPLIT (' '), BUFSIZ=1, RETLEN=PSCAN$M_NEQ), (ITMCOD=PSCAN$_USERNAME, BUFADR=CTX [PCTX_T_USRPAT], BUFSIZ=.CTX [PCTX_W_USRPAT], RETLEN=(IF .CTX [PCTX_W_USRPAT] EQL 1 AND CH$RCHAR (CTX [PCTX_T_USRPAT]) EQL %C'*' THEN PSCAN$M_WILDCARD ELSE PSCAN$M_CASE_BLIND)), (ITMCOD=(IF .NOCLUSTER THEN 0 ELSE PSCAN$_NODE_CSID), BUFADR=0, BUFSIZ=0, RETLEN=PSCAN$M_NEQ)); STATUS = $PROCESS_SCAN (PIDCTX=CTX [PCTX_L_JPICTX], ITMLST=PSCLST); IF NOT .STATUS THEN BEGIN $SETPRV (ENBFLG=1, PRVADR=PRVMSK); $CLOSE (FAB = ctx [PCTX_X_UAFFAB]); $SETPRV (ENBFLG=0, PRVADR=PRVMSK); LIB$FREE_VM (%REF (PCTX_S_PCTXDEF), CTX); RETURN .STATUS; END; STATUS = LIB$GET_VM (%REF (%ALLOCATION (TEMPLT)), CTX [PCTX_L_ITMLST]); IF NOT .STATUS THEN BEGIN $PROCESS_SCAN (PIDCTX=CTX [PCTX_L_JPICTX]); $SETPRV (ENBFLG=1, PRVADR=PRVMSK); $CLOSE (FAB = ctx [PCTX_X_UAFFAB]); $SETPRV (ENBFLG=0, PRVADR=PRVMSK); LIB$FREE_VM (%REF (PCTX_S_PCTXDEF), CTX); RETURN .STATUS; END; CTX [PCTX_L_JPIFLG] = JPI$M_NO_TARGET_INSWAP OR JPI$M_IGNORE_TARGET_STATUS; $ITMLST_INIT (ITMLST=TMPLST, (ITMCOD=JPI$_GETJPI_CONTROL_FLAGS, BUFSIZ=4, BUFADR=CTX [PCTX_L_JPIFLG]), (ITMCOD=JPI$_TT_PHYDEVNAM, BUFSIZ=PCTX_S_TRMNAM, BUFADR=CTX [PCTX_T_TRMNAM], RETLEN=CTX [PCTX_W_TRMNAM]), (ITMCOD=JPI$_USERNAME, BUFSIZ=PCTX_S_USRNAM, BUFADR=CTX [PCTX_T_USRNAM], RETLEN=CTX [PCTX_W_USRNAM]), (ITMCOD=JPI$_NODENAME, BUFSIZ=PCTX_S_NODENAM, BUFADR=CTX [PCTX_T_NODENAM], RETLEN=CTX [PCTX_W_NODENAM]), ! (ITMCOD=JPI$_IMAGNAME, BUFSIZ=PCTX_S_IMGNAM, ! BUFADR=CTX [PCTX_T_IMGNAM], RETLEN=CTX [PCTX_W_IMGNAM]), (ITMCOD=JPI$_TT_ACCPORNAM, BUFSIZ=PCTX_S_ACCNAM, BUFADR=CTX [PCTX_T_ACCNAM], RETLEN=CTX [PCTX_W_ACCNAM])); CH$MOVE (%ALLOCATION (TEMPLT), TMPLST, .CTX [PCTX_L_ITMLST]); $SETPRV (ENBFLG=1, PRVADR=PRVMSK); STATUS = $GETJPIW (PIDADR=CTX [PCTX_L_JPICTX], IOSB=CTX [PCTX_Q_IOSB], ASTADR=JPIAST, ASTPRM=.CTX, ITMLST=.CTX [PCTX_L_ITMLST]); $SETPRV (ENBFLG=0, PRVADR=PRVMSK); IF NOT .STATUS THEN BEGIN $SETPRV (ENBFLG=1, PRVADR=PRVMSK); $CLOSE (FAB = ctx [PCTX_X_UAFFAB]); $SETPRV (ENBFLG=0, PRVADR=PRVMSK); LIB$FREE_VM (%REF (%ALLOCATION (TEMPLT)), CTX [PCTX_L_ITMLST]); $PROCESS_SCAN (PIDCTX=CTX [PCTX_L_JPICTX]); LIB$FREE_VM (%REF (PCTX_S_PCTXDEF), CTX); RETURN (IF .STATUS EQL SS$_NOMOREPROC THEN SS$_NORMAL ELSE .STATUS); END; .STATUS END; ! COLLECT_PINFO %SBTTL 'JPIAST' ROUTINE JPIAST (CTX : REF PCTXDEF) = BEGIN !++ ! FUNCTIONAL DESCRIPTION: ! ! AST completion routine for $GETJPI call. ! ! RETURNS: cond_value, longword (unsigned), write only, by value ! ! PROTOTYPE: ! ! JPIAST ! ! IMPLICIT INPUTS: None. ! ! IMPLICIT OUTPUTS: None. ! ! COMPLETION CODES: ! ! SS$_NORMAL: normal successful completion. ! ! SIDE EFFECTS: ! ! None. !-- BIND INFQUE = .CTX [PCTX_L_TXTQA] : QUEDEF, IOSB = CTX [PCTX_Q_IOSB] : BLOCK [,BYTE], STATUS = IOSB [0,0,16,0] : WORD, USTAT = .CTX [PCTX_L_STATADR]; LOCAL I : REF INFDEF, INF : REF INFDEF, FAOBUF : BLOCK [512,BYTE], FAOLEN : WORD, FAODSC : BLOCK [DSC$K_S_BLN,BYTE] PRESET ( [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$W_LENGTH] = %ALLOCATION (FAOBUF), [DSC$A_POINTER] = FAOBUF), ASTADR, ASTPRM, UAI_ITMLST : $ITMLST_DECL (ITEMS=1), OWNER_LEN, USRNAM_D : $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_S); IF NOT .STATUS THEN BEGIN USTAT = (IF .STATUS EQL SS$_NOMOREPROC THEN SS$_NORMAL ELSE .STATUS); ASTADR = .CTX [PCTX_L_ASTADR]; ASTPRM = .CTX [PCTX_L_ASTPRM]; IF .STATUS NEQ SS$_NOMOREPROC THEN $PROCESS_SCAN (PIDCTX=CTX [PCTX_L_JPICTX]); LIB$FREE_VM (%REF (%ALLOCATION (TEMPLT)), CTX [PCTX_L_ITMLST]); LIB$FREE_VM (%REF (PCTX_S_PCTXDEF), CTX); $SETPRV (ENBFLG=1, PRVADR=PRVMSK); $CLOSE (FAB = ctx [PCTX_X_UAFFAB]); $SETPRV (ENBFLG=0, PRVADR=PRVMSK); $DCLAST (ASTADR=.ASTADR, ASTPRM=.ASTPRM); RETURN SS$_NORMAL; END; IF NOT CH$EQL (7, UPLIT (''), .CTX [PCTX_W_USRNAM], CTX [PCTX_T_USRNAM], %C' ') THEN BEGIN LIB$GET_VM (%REF (INF_S_INFDEF), INF); INF [INF_W_USERNAME] = MIN (.CTX [PCTX_W_USRNAM], INF_S_USERNAME); CH$MOVE (.INF [INF_W_USERNAME], CTX [PCTX_T_USRNAM], INF [INF_T_USERNAME]); INF [INF_W_TERMINAL] = MIN (.CTX [PCTX_W_TRMNAM], INF_S_TERMINAL); CH$MOVE (.INF [INF_W_TERMINAL], CTX [PCTX_T_TRMNAM], INF [INF_T_TERMINAL]); INF [INF_W_ACCPOR] = MIN (.CTX [PCTX_W_ACCNAM], INF_S_ACCPOR); CH$MOVE (.INF [INF_W_ACCPOR], CTX [PCTX_T_ACCNAM], INF [INF_T_ACCPOR]); ! INF [INF_W_IMAGE] = MIN (.CTX [PCTX_W_IMGNAM], INF_S_IMAGE); ! CH$MOVE (.INF [INF_W_IMAGE], CTX [PCTX_T_IMGNAM], INF [INF_T_IMAGE]); INF [INF_W_NODE] = MIN (.CTX [PCTX_W_NODENAM], INF_S_NODE); CH$MOVE (.INF [INF_W_NODE], CTX [PCTX_T_NODENAM], INF [INF_T_NODE]); inf [INF_W_OWNER] = 0; I = .INFQUE [QUE_L_HEAD]; WHILE .I NEQA INFQUE [QUE_L_HEAD] DO BEGIN ! ! To minimize the number of calls to $GETUAI (thus increasing ! performance), check to see if we found an entry for the same ! username. If so, just copy the owner name from it. ! IF (.inf [INF_W_OWNER] EQLU 0) AND (CH$EQL (.I [INF_W_USERNAME], I [INF_T_USERNAME], .INF [INF_W_USERNAME], INF [INF_T_USERNAME], %C' ')) THEN BEGIN inf [INF_W_OWNER] = .i [INF_W_OWNER]; CH$MOVE (.inf [INF_W_OWNER] + 1, i [INF_T_OWNER], inf [INF_T_OWNER]); END; IF CH$GTR (.I [INF_W_USERNAME], I [INF_T_USERNAME], .INF [INF_W_USERNAME], INF [INF_T_USERNAME], %C' ') THEN BEGIN INSQUE (.INF, .I [INF_L_BLINK]); EXITLOOP; END; I = .I [INF_L_FLINK]; END; ! ! If we don't have an owner name yet, then call $GETUAI to get it. ! IF (.inf [INF_W_OWNER] EQLU 0) THEN BEGIN CH$MOVE (10, UPLIT(%ASCII'[Unknown]'), INF [INF_T_OWNER]); INF [INF_W_OWNER] = 9; $SETPRV (ENBFLG=1, PRVADR=PRVMSK); status = $GET (RAB = ctx [PCTX_X_UAFRAB]); $SETPRV (ENBFLG=0, PRVADR=PRVMSK); IF (.status) THEN BEGIN BIND uaf = ctx [PCTX_T_UAFREC] : $BBLOCK; inf [INF_W_OWNER] = CH$RCHAR (uaf [UAF$T_OWNER]); CH$MOVE (.inf [INF_W_OWNER], uaf [UAF$T_OWNER] + 1, inf [INF_T_OWNER]); END; END; IF .I EQLA INFQUE [QUE_L_HEAD] THEN INSQUE (.INF, .INFQUE [QUE_L_TAIL]); END; $SETPRV (ENBFLG=1, PRVADR=PRVMSK); $GETJPIW (PIDADR=CTX [PCTX_L_JPICTX], IOSB=CTX [PCTX_Q_IOSB], ASTADR=JPIAST, ASTPRM=.CTX, ITMLST=.CTX [PCTX_L_ITMLST]); $SETPRV (ENBFLG=0, PRVADR=PRVMSK); SS$_NORMAL END; END ELUDOM