From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 27-OCT-1989 21:05
To:	MRGATE::"ARISIA::EVERHART"
Subj:	re: determining rights identifiers

Message-Id:  <8910280047.AA22709@crdgw1.ge.com>
Received: From CUNYVM.CUNY.EDU by CRVAX.SRI.COM with TCP; Fri, 27 OCT 89 17:20:06 PDT
Received: from DGOGWDG5.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.2.1MX) with BSMTP id 0776; Fri, 27 Oct 89 20:21:30 EDT
Date:    Sat, 28 Oct 1989 01:18:10  +0100
From: "GWDGV1::MOELLER"  <U0012%DGOGWDG5.BITNET@CUNYVM.CUNY.EDU>
To: info-vax@sri.COM
Subject: re: determining rights identifiers

PAUL E. NUNEZ <nunez@tawc1.eglin.af.mil> asked:
>Is there a way, other than SHOW PROC/PRIV, to determine what rights identifiers
>my process has.  I can't find a lexical function that will return process
>identifiers (just privileges).

Not officially. VMS support for rightslists is less than complete ...
Not only does the command $ SET RIGHTS *not* do what the documentation says,
there is no service at all to display the rightslist of another process.

The problem with SET RIGHTS I leave to the VMS designers, but here is
my SHOWRIGHTS program - w/o warranty, of course (works with V4 & V5).
[The memory resident rightslists even lack complete symbolic definitions ...]

Enjoy,
        -wjm

Wolfgang J. Moeller, GWDG, D-3400 Goettingen, F.R.Germany | Disclaimer ...
Bitnet/Earn: U0012@DGOGWDG5         Phone: +49 551 201516 | No claim intended

$! ................... Cut between dotted lines and save. ...................
$!...........................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.10 7-FEB-1989.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user MOELLER
$! on 28-OCT-1989 01:03:02.52.
$!
$! It contains the following 2 files:
$!        GETIDENT.MAR
$!        SHOWRIGHTS.FOR
$!
$!============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.10 7-FEB-1989 requires VMS V4.4 or higher."
$ EXIT 44 ! SS$_ABORT
$VERSION_OK:
$ GOTO START
$!
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail
& LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); ENDLOOP
; POSITION( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK
( NONE ) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 )
; IF s_x = '+' THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip
<> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF
; ENDIF; IF s_x = '-' THEN r_skip := SEARCH( pat_end, FORWARD, EXACT )
; IF r_skip <> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip
:= MARK( NONE ); r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip
<> 0 THEN POSITION( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET )
; MOVE_VERTICAL( 1 ); MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part
) ); ENDIF; ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = 'V' THEN s_x := ''; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1
; MOVE_VERTICAL( 1 ); ENDIF; IF s_x = 'X' THEN s_x := ''; IF i_append_line
<> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> '' THEN i_errors
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL
( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH
( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER
( 1 ); COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDLOOP
; IF i_errors = 0 THEN SET( NO_WRITE, b_errors, ON ); ELSE POSITION
( BEGINNING_OF( b_errors ) ); COPY_TEXT( FAO
( "The following !UL errors were detected while unpacking !AS", i_errors
, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" )
; ENDIF; EXIT;
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!!,passed." )
$ RETURN
$!
$START:
$ FILE_IS = "GETIDENT.MAR"
$ CHECKSUM_IS = 1062952652
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009.title`009get_ident`009epid => list of identifiers held
X;
X;`009integer function get_ident(epid,maxent,actent,list) = status
X;`009integer epid`009`009! in
X;`009integer maxent`009`009! in (max # of id's to be transferred)
X;`009integer actent`009`009! out (# of id's found), maybe > maxent
X;`009integer list(2,maxent)`009! out
X;
X;`009***** Note: rightslist entries are ASSUMED to be 2 longwords ******
X;
X;*****
X;
X`009.library`009"SYS$LIBRARY:LIB"
X`009.link`009`009"SYS$SYSTEM:SYS.STB"/selective_search
X;
X`009$arbdef
X`009$pcbdef
X;
Xsmp_code=0`009`009`009`009;assume V4
X.iif df pcb$l_affinity,smp_code=1`009;no, V5
X;
X.if ne smp_code
X`009$spldef
X.iff
X`009$ipldef
X.endc
X;
X;
X;*****
X;
Xlckrange1:
X`009.address`009ipl8start,ipl8end
Xlckrange2:
X`009.blkl`0092
X;
X;
X`009.entry`009GET_IDENT,`094m<r2,r3,r4,r5>
X;
X`009clrl`009actent
X`009movzwl`009@2*4(ap),maxent`009`009; max # entries (force into 0..65k)
X`009mull3`009#8,maxent,bufdsc`009; # bytes
X`009pushal`009bufdsc+4`009`009; addr.
X`009pushal`009bufdsc
X`009calls`009#2,g`094lib$get_vm`009`009; get temp. buffer
X`009blbs`009r0,22$
X`009brw`00999$
X22$:
X`009subl3`009#1,bufdsc,r0
X`009movl`009bufdsc+4,lckrange2`009; low address
X`009addl3`009r0,bufdsc+4,lckrange2+4`009; high address
X;
X`009$lkwset_s`009inadr=lckrange2
X`009blbs`009r0,23$
X`009brw`00998$
X23$:
X`009$lkwset_s`009inadr=lckrange1
X`009blbc`009r0,971$
X;
X`009pushl`009@1*4(ap)`009`009; epid (by value)
X`009pushl`009#1
X`009$cmkrnl_s`009routin=k_get_ident,arglst=(sp)`009
X`009blbc`009r0,961$
X;
X`009movl`009actent,r0
X`009movl`009r0,@3*4(ap)`009`009; store 'actent'
X`009cmpl`009r0,maxent
X`009bleq`00941$
X`009movl`009maxent,r0
X41$:
X`009mull2`009#8,r0`009`009`009; # bytes to be copied
X`009movc3`009r0,@bufdsc+4,@4*4(ap)`009; copy them
X;
X`009movzwl`009#ss$_normal,r0
X;
X961$:`009`009`009`009`009; cleanup ...
X`009movl`009r0,r2
X`009$ulwset_s`009inadr=lckrange1
X`009blbs`009r2,969$
X`009movl`009r2,r0
X969$:
X971$:
X`009movl`009r0,r2
X`009$ulwset_s`009inadr=lckrange2
X`009blbs`009r2,979$
X`009movl`009r2,r0
X979$:
X98$:
X`009movl`009r0,r2
X`009pushal`009bufdsc+4
X`009pushal`009bufdsc
X`009calls`009#1,g`094lib$free_vm
X`009blbs`009r2,989$
X`009movl`009r2,r0
X989$:
X99$:
X`009ret`009`009`009`009; ... return
X;
X;
X;*****
X;
Xk_get_ident:`009.word`009`094m<r2,r3,r4,r5>
X;
X`009movab`009g`094lib$sig_to_ret,(fp)`009; won't ever hurt
X;
X`009movl`0091*4(ap),r0`009`009;r0 = epid
X;
X;*****************************************
Xipl8start:`009`009`009`009;*
X;`009`009`009`009`009;*
X.if ne smp_code`009`009`009`009;*
X`009lock`009SCHED,-`009`009`009;*
X`009`009preserve=YES`009`009;*
X.iff`009`009`009`009`009;*
X`009setipl`009#ipl$_synch`009`009;*
X.endc`009`009`009`009`009;*
X;`009`009`009`009`009;*
X`009movzwl`009#ss$_nonexpr,-(sp)`009;* keep status at (sp)
X;`009`009`009`009`009;*
X`009jsb`009g`094exe$epid_to_pcb`009;* r0 => pcb
X`009beql`00990$`009`009`009;* br if bad epid
X;`009`009`009`009`009;*
X`009movzwl`009#ss$_normal,(sp)`009;* status o.k. now
X;`009`009`009`009`009;*
X`009movl`009pcb$l_arb(r0),r5`009;* r5 => arb
X`009movl`009bufdsc+4,r3`009`009;* r3 => buffer
X`009clrl`009r4`009`009`009;* r4 = L-index into arb$l_rightslist
X30$:`009`009`009`009`009;*
X`009movl`009arb$l_rightslist(r5)[r4],r2`009;* r2 => rightslist descr.
X`009beql`00939$`009`009`009;* skip if 0
X`009movq`009(r2),r0`009`009`009;* get descriptor of rightslist
X`009tstl`009r1`009`009`009;* good address?
X`009beql`00939$`009`009`009;* br if 0
X`009movzwl`009r0,r0`009`009`009;* size?
X`009beql`00939$`009`009`009;* br if 0
X`009addl`009r1,r0`009`009`009;* r0 => end of rightslist
X330$:`009`009`009`009`009;*
X`009bisl3`009(r1)+,(r1)+,-4(sp)`009;* null entry? [intended: TSTQ (r1)+]
X`009beql`009339$`009`009`009;* br if yes
X`009incl`009actent`009`009`009;* entry found, count it
X`009cmpl`009actent,maxent`009`009;* table full?
X`009bgtr`009339$`009`009`009;* br if yes
X`009movq`009-8(r1),(r3)+`009`009;* copy entry
X339$:`009`009`009`009`009;*
X`009cmpl`009r1,r0`009`009`009;* end of rightslist?
X`009blssu`009330$`009`009`009;* loop if no
X39$:`009`009`009`009`009;*
X`009incl`009r4`009`009`009;* advance
X`009cmpl`009r4,#<arb$s_rightslist/4>;* end of table?
X`009blss`00930$`009`009`009;* loop if no
X;`009`009`009`009`009;*
X90$:`009`009`009`009`009;*
X.if ne smp_code`009`009`009`009;*
X`009unlock`009SCHED,newipl=#0,-`009;*
X`009`009preserve=NO`009`009;*
X.iff`009`009`009`009`009;*
X`009setipl`009#0`009`009`009;*
X.endc`009`009`009`009`009;*
X`009brb`009ipl8end`009`009`009;* branch over data
X;`009`009`009`009`009;*
X;*** nonpaged data`009`009`009;*
X;`009`009`009`009`009;*
Xbufdsc:`009`009`009`009`009;*
X`009.long`0090-0,0-0`009`009`009;*
Xmaxent:`009.blkl`009`009`009`009;*
Xactent:`009.blkl`009`009`009`009;*
X;`009`009`009`009`009;*
X;*** end of data`009`009`009;*
X;`009`009`009`009`009;*
Xipl8end:`009`009`009`009;*
X;*****************************************
X;
X`009movl`009(sp)+,r0`009`009; pop status
X`009ret
X;
X`009.end
$ GOSUB UNPACK_FILE

$ FILE_IS = "SHOWRIGHTS.FOR"
$ CHECKSUM_IS = 671689650
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
Xc`009hex EPID (lib$get_foreign) => list of identifiers held
Xc
X`009integer maxid
X`009parameter (maxid=128)`009! <<<< arbitrary max. of # id's displayed
Xc
X`009character iline*8,oline*132
X`009integer*2 l_il,l_ol
X`009integer k,epid,actid,i
X`009structure /kgbent/
X`009`009integer*4 id
X`009`009integer*4 flags
X`009end structure
X`009record /kgbent/ idarr(maxid)
X
Xc
X`009integer itrmlen,get_ident
X`009external itrmlen,get_ident
X`009integer lib$get_foreign
X`009external lib$get_foreign
Xc
Xc***
Xc
X`009k=lib$get_foreign(iline,'EPID hex: ',l_il)
X`009if(.not.k) call exit(k)
X`009l_il=itrmlen(iline(:l_il))
X`009read(iline(:l_il),'(z8)') epid
Xc
X`009k=get_ident(epid,maxid,actid,idarr)
X`009if(.not.k) call exit(k)
Xc
X`009call sys$fao('Identifiers held by PID !XL:',l_ol,oline,%val(epid))
X`009call lib$put_output(oline(:l_ol))
X`009do i=1,actid
X`009`009if(idarr(i).id.lt.2**16-1) then`009! identifier
X`009`009`009call sys$fao('  !31<!%I!> !15<%x!-!XL!> flags=!SL',
X     *`009`009`009`009l_ol,oline,
X     *`009`009`009`009%val(idarr(i).id),%val(idarr(i).flags))
X`009`009else
X`009`009`009call sys$fao('  !31<!%I!> !15<!-!%U!> flags=!SL',
X     *`009`009`009`009l_ol,oline,
X     *`009`009`009`009%val(idarr(i).id),%val(idarr(i).flags))
X`009`009endif
X`009`009call lib$put_output(oline(:l_ol))
X`009enddo
Xc
X`009end
Xc+++++
X`009integer*4 function itrmlen(str)
X`009character*(*) str
Xc
X`009itrmlen=len(str)
X`009do while(itrmlen.gt.0)
X`009`009if(str(itrmlen:itrmlen).ne.' ') return
X`009`009itrmlen=itrmlen-1
X`009enddo
X`009return
X`009end
$ GOSUB UNPACK_FILE
$ EXIT
--------------------------------------------------------------------------------

