%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 ('<login>'), .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