From:	CSBVAX::MRGATE!HULL%CTSTATEU.BITNET@CUNYVM.CUNY.EDU@SMTP  4-JAN-1978 10:13
To:	ARISIA::EVERHART
Subj:	Getting Process IDs


Received: from YALEVM.YCC.YALE.EDU by MITVMA.MIT.EDU (IBM VM SMTP R1.1) with BSMTP id 6404; Fri, 24 Jun 88 10:32:54 EDT
Received: by YALEVM (Mailer X1.25) id 4979; Fri, 24 Jun 88 09:26:36 EST
Date:
From:         Matthew Hull <HULL%CTSTATEU.BITNET@MITVMA.MIT.EDU>
Subject:      Getting Process IDs
To:           EVERHART%ARISIA.decnet@GE-CRD.ARPA

>Date:         Thu, 16 Jun 88 20:19:00 EST
>Sender:       INFO-VAX Discussion <INFO-VAX@MARIST>
>From:         EVERHART%ARISIA.decnet@GE-CRD.ARPA
>Subject:      Network wide identifiers
>To:           "'Matthew G. Hull'" <HULL@CTSTATEU>
>
>The following is something that occurred to me lately. Anybody have anything
>like it in the works?
>  [...]
>  The server obtains (via CMKRNL ?) information on which "standard
>identifiers" are present for the process being queried about. It sends a
>  [...]
>This looks to me like something that's workable. Anybody done it already?
>Or part of it?
>    Code donations gratefully accepted!
>
>Thanks
>Glenn Everhart
>Everhart%Arisia.decnet@ge-crd.arpa

   Part of it.   We have several situations where Identifiers are added to
a process but not via the UAF.   This would not cause any problems if the
system service Sys$Find_Held worked as we think it should; that is, return
all identifiers in the current process, and NOT just the ones in the UAF.
Towards this problem I wrote a Macro routine which was written to be
implemented as a Site System Service routine.   In the end, it was decided
that our applications did not warrant a Site-specific System Service, and the
routine was shelved.  However, I'd be pleased if _someone_ could benefit
from my efforts, if not ourselves.  The routine accepts an array of longwords
specified by the caller, and fills this array with all the current process'
identifiers.  It enters Kernal mode, copies the critical memory, and exits.
The routine was written for VMS V4.5, and was researched by using
ANALYZE/SYSTEM to examine the process memory to determine the structure of
process identifiers in VMS.  Since it makes assumptions on a VMS critical
structure (the process Rights list), some changes may be needed for different
versions of VMS 4, and I wouldn't expect it to work for VMS 5 (without some
modification, that is).   Nevertheless, if you decide to write your own
system to handle your Identifiers/Access application, this code may be of
some use.


        .PAGE
        .SBTTL  Return Process Identifiers
        .LIBRARY  "SYS$LIBRARY:LIB.MLB"
;++
; Functional Description:
;       This routine returns the longword values of the current process'
;       Identifiers into a longword array.  Written for VMS V4.5 at
;       the Connecticut State University by Matthew G. Hull.
;
; Input Parameters:
;       04(AP) - Number of longwords in longword array - Longword (Byte) value
;       08(AP) - Address of longword array             - Longword address
;       R4     - PCB address of current process
;
; Output Parameters:
;       R0      - Completion Status code
;       @08(AP) - Written with Process Identifiers
;
; Register Use:
;       R4 - PCB address of current process
;       R5 - Temp; Addr of next Rights List descriptor
;       R6 - Address of current ID list
;       R7 - Counter of current ID list
;       R8 - Current pointer into user longword array
;       R9 - Count of User Space IDs stored
;       R10- Address just beyond the 4 Rights List Descr. Addresses
;
; A picture is worth a thousand words:
;       The 4 Rights List pointers each point to a Rights List descriptor.
;       The Descriptors describe a block of Identifiers.
;       An identifier is a longword value, followed by an attributes longword.
;
;       |--------------|       |-------------|
;       | RL Pointer #1| ----> | Descrip #1  |
;       |--------------|       |-- (Size) ---|
;                              |  (Pointer)  | ----> |-----------------------|
;                              |-------------|       |ID array #1|           |
;                                                    |-----------|-----------|
;                                                    | (ID val)  | (Attrib.) |
;                                                    |     .     |     .     |
;                                                    |     .     |     .     |
;                                                    |     .     |     .     |
;---

        $PCBDEF         ; Define Process Control Block offsets
        $ARBDEF         ; Define Access Rights Block offsets
        $SSDEF          ; Define System Services constants

        .ENTRY  USS_GET_IDS,^M<R4,R5,R6,R7,R8,R9,R10>
        CMPL    #2, (AP)                ; Check number of arguments
        BNEQ    40$                     ; Error if not 2
        MOVL    8(AP), R8               ; Get address to store Identifiers
        BEQL    50$                     ; Branch if null address
        MOVZBL  4(AP), R9               ; Load User longword counter
        MULL3   #4, R9, R5              ; Determine # bytes to be written
        PROBEW  #0, R5, (R8)            ; Check if array is writeable
        BEQL    50$                     ; Error if not
        MOVL    PCB$L_ARB(R4), R5       ; Base Address of Access Rights Block
        ADDL2   #ARB$L_RIGHTSLIST, R5   ; Plus offset to 1st Rights List Descrip
        ADDL3   #16, R5, R10            ; Plus 4 longwords
        BRB     10$                     ; Branch beyond Exits

40$:    MOVL    #SS$_INSFARG, R0        ; Indicate insufficient arguments
        RET                             ;  and return
50$:    MOVL    #SS$_ACCVIO, R0         ; Indicate access violation
        RET                             ;  and return
60$:    MOVL    #SS$_NORMAL, R0         ; Set normal completion status
        RET                             ;  and return

10$:    MOVL    (R5)+, R6               ; Load addr of next Rights List descrip
        BEQL    30$                     ; If empty, try next Rights List
        MOVZWL  (R6), R7                ; Load Identifier bytes counter
        ASHL    #-3, R7, R7             ; Divide by 8 (8 bytes per ID)
        MOVL    4(R6), R6               ; Load Address of ID List quadwords
20$:    TSTL    (R6)                    ; See if this ID is blank (zero)
        BEQL    30$                     ; If so, move to next list
        DECL    R9                      ; Decrement User Longword counter
        BLSS    60$                     ; Exit if no more memory
        MOVL    (R6)+, (R8)+            ; Copy Identifier into user space
        ADDL2   #4, R6                  ; Skip attribute flags longword
        SOBGTR  R7, 20$                 ; Decrement ID count, branch if more
30$:    CMPL    R5, R10                 ; Are we at the last Descr address?
        BLSS    10$                     ; If not, process next Rights list
        BRB     60$                     ; Exit normally

        .END

; ==========================================================================
; ==========================================================================

;
;  Test program to simulate the process memory area in order to test
;    the USS_Get_Ids routine.
;
;
; Simulated Process space
;
        .PSECT PROCESS_SPACE  RD,NOWRT,NOEXE
PCB:    .BLKB 140               ; 140 bytes of process info
        .ADDRESS ARB            ; Base addr of ARB
ARB:    .BLKB 32                ; 32 bytes of ARB info
RLDP1:  .ADDRESS RLD1           ; Pointer to 1st Rights List descriptor
RLDP2:  .ADDRESS RLD2           ; Pointer to 2nd Rights List descriptor
RLDP3:  .ADDRESS RLD3           ; Pointer to 3rd Rights List descriptor
RLDP4:  .LONG    0              ; Rights list 4 is empty
;       .ADDRESS RLD4
        .BLKB 40                ; More ARB
        .BLKB 100               ; More PCB

                                ; Descriptors
RLD1:   .LONG ^X40              ; 64 bytes of memory to a Rights List
        .ADDRESS RL1            ; Address of 1st Rights list
RLD2:   .LONG ^X40
        .ADDRESS RL2            ; Address of 2nd Rights list
RLD3:   .LONG ^X40
        .ADDRESS RL3            ; Address of 3rd Rights list
RLD4:   .LONG ^X40
        .ADDRESS RL4            ; Address of 4th Rights list

                                ; Rights Lists
RL1:    .QUAD ^X00030023        ; [3,43]
        .QUAD ^X80010052        ; DIALOUT_ACCESS
        .QUAD ^X80010002        ; STUDENT_HELP
        .QUAD ^X80172172        ; PPS_ACCESS
        .BLKQ 4                 ; The rest are zero

RL2:    .QUAD ^X80000004        ; LOCAL
        .QUAD ^X80000003        ; INTERACTIVE
        .BLKQ 6                 ; The rest zero

RL3:    .QUAD ^X8001004D        ; SYS$NODE_CCSUB
        .QUAD ^X8001004C        ; SAS_ACCESS
        .BLKQ 6                 ; The rest zero

RL4:    .BLKQ 8                 ; Empty

;
; Calling Program Data
;
        .PSECT MY_DATA  RD,WRT,NOEXE
IDENTS: .BLKL 20                ; Max supported = 32 IDs (VMS V4.6)
                                ; Output Longword Array (will receive IDs)
ARR_SIZE:
        .LONG 20                ; Size of Output array
        .LONG   0               ; Buffer

        .PSECT MY_CODE RD,NOWRT,EXE

        BEGIN TEST_GET_IDS

        MOVAL   PCB, R4         ; Addr of PCB into R4
        PUSHAL  IDENTS          ; Push address of Longword array
        PUSHL   ARR_SIZE        ; Push number of longwords in array
        CALLS   #2, USS_GET_IDS ; Get the Identifers in "Process Space"
        MOVL    R0, R8
        $IF R8, NEQ, #SS$_NORMAL, L -
           THEN <PRINTBOMB ^| Error from USS_GET_IDS.|, R8>

        MOVAL   IDENTS, R6
DUMP:   $IF (R6) EQL #0 L THEN <BRW DONE> ELSE <DUMPMEM (R6)+, #4>
        BRB DUMP
DONE:
        EXIT
        .END TEST_GET_IDS
