Conference noted::hackers_v1

	.title	tl
;
; This program will list all RMS$ file locks for a specified file.  This
; is usefull to display all processes that have a file open by RMS on a
; cluser.
;
; the program requires CMEXEC priv since the RMS locks are taken at exec
; mode and we must do the same.
;
; To get the lock information, we must build a resource name like RMS
; does.  The current (X4.6) resource name looks like:
;	RMS$ + file id (3 words) + device lock name (from $GETDVI)
;
; We build this resource name by using a QIO to get the file ID and using
; $PARSE to get the device name which is then passed to $GETDVI to return
; the device lock name.  Once the resource name is built, we'll $ENQ a
; null mode lock on the resource in executive mode.  Then, using the lock ID
; from our $ENQ, call $GETLKI with the item LKI$_LOCKS which should return
; an entry for each lock taken on the resource.  $DEQ the lock just so it
; doesn't hang around for nothing.  Finally, do some output formatting on 
; the result and display it.
;
; theory of operations is something like:
;	- $PARSE of the file name to get the device, DID and full file name.
;	- $GETDVI to get the DEVLOCKNAM
;	- $ASSIGN a channel to the device
;	- $QIO access to get the file ID
;	- $ENQ a lock on the resource name
;	- $GETLKI on our lock ID for all locks on this resource
;	- $DEQ the lock
;	- parse and display the results of the $GETLKI
;
;  7-Apr-1987	njl
;	Initial attempt.
;

	.macro	check, ?l1		; another
	blbs	r0,l1			;  silly macro
	ret				;   to do status
l1:					;    checking
	.endm

	.library	/sys$share:lib/

	.psect	$data$,	rd,wrt,noexe,long

	$fibdef				; FIB layout definitions
	$psldef				; PSL definitions
	$lckdef				; lock definitions
	$lkidef				; $GETLKI definitions
	$syidef				; $GETSYI definitions

file_name: .quad 0			; file name descriptor

fib_block: .blkb fib$k_length		; FIB for opening the file
fib_descr: .long fib$k_length		; FIB descriptor
           .long fib_block

fil:	   .quad 0			; file name+type+version descriptor
files_dev: .quad 0			; device name descriptor for $ASSIGN
					; and $GETDVI

io_status: .blkq 1			; IOSB for $QIO

fab_blk: $fab	fop=nam,-		; FAB for RMS$PARSE
	        nam=nam_blk

nam_blk: $nam	rsa=res_str,-		; NAM for RMS$PARSE
	        rss=nam$c_maxrss,-
	        esa=exp_str,-
	        ess=nam$c_maxrss

exp_str: .blkb nam$c_maxrss		; exanded name string
res_str: .blkb nam$c_maxrss		; resultant name string

chan:	.long	0			; channel to the device

dviitmlst:				; $GETDVI item list to get the lock
	.word	16			; name for the device
	.word	dvi$_devlocknam
	.address devlck
	.long	0
	.long	0

syiitmlst:				; item list to return node name for
	.word	15			; a given CSID
	.word	syi$_nodename
	.address	nodename
	.address	nodename_len
	.long	0

nodename_desc:				; string descriptor for node names
nodename_len:	.long	0		; filled in by $GETSYI
		.address nodename	; text of node name always goes here
nodename:	.blkb	15		; in this buffer

lkiitmlst:				; item list for $GETLKI
	.word	1500			; 1500 bytes won't be enough always
	.word	lki$_locks		; get all the locks
	.address lock_list
	.address lock_len

	.word	4
	.word	lki$_lckcount		; get a count of all the locks
	.address total_locks
	.long	0

	.long	0

total_locks:				; total number of locks on the resource
	.long	0
lock_len:				; length of returned list and the size
	.long	0			; of each entry

lock_list:				; buffer for the lock list
	.blkb	1500		; this may need to be increased

lock_sb:				; LKSB buffer
	.long	0			; status
	.long	0			; LKID
	.blkb	16			; VALUE BLOCK (not used here)

lkidx:					; our LKID
	.long	0

fao_header:				; titles for the columns
	.ascid	<10>\      PID     NODE  LOCK ID  RQ GR QUEUE    REMLKID\
fao_control:				; control string for each entry
	.ascid	/    !XL !6<!AS!> !XL !AS !AS !AS !XL/

;
; two buffers
;
fao_buff1:
	.ascid	/                                                                              /
fao_buff2:
	.ascid	/                                                                         /

fao_h1:					; main header
	.ascid	\!/ !SL locks on resource "!AF" at node !AS::\
fao_h2:
	.ascid	\ File name is: !AS\

resource:				; descriptor for the resource name
	.long	26			; length is always 26 for RMS locks
	.address res_addr		; pointer to the string

res_addr:				; resource name string
	.ascii	/RMS$/			; prefixed with "RMS$"
fid1:	.word	0			;  Three words
fid2:	.word	0			;     of the
fid3:	.word	0			;    file ID
devlck:	.blkb	16			; and then the DVI$_DEVLOCKNAM from
					; $GETDVI
;
; queue names for where the locks are
;
granted_queue:	.ascid	/GRANTED/
convert_queue:	.ascid	/CONVERT/
waiting_queue:	.ascid	/WAITING/

;
; table of mode values.  This table is based on the current (X4.6) lock
; mode values and is indexed into by the lock mode.
;
lock_mode_table:
	.ascii	/NL/		; (0) NULL mode
	.ascii	/CR/		; (1) Concurrent read
	.ascii	/CW/		; (2) Concurrent write
	.ascii	/PR/		; (3) protected read
	.ascii	/PW/		; (4) protected write
	.ascii	/EX/		; (5) exclusive

gr_mode_desc:			; string descriptor for the granted mode lock
	.long	2		; always 2 bytes long
	.long	0		; filled in with the correct mode address

rq_mode_desc:			; same for the requested mode locks
	.long	2
	.long	0

fn_desc:			; input file name string descriptor
	.long	fn_len
	.address fn_text
fn_text:
	.blkb	80
fn_len = .-fn_Text

fn_prompt:			; input file name prompt
	.ascid	/Enter file name: /

	.psect	$code$,	rd,nowrt,exe,long

	.entry	tl,0
main::
;
; determine the file name
;
	pushal	fn_prompt
	pushal	fn_desc
	calls	#2,g^lib$get_input
	check

;
; fill in the NAM block default file name
;
	movb	fn_desc,fab_blk+fab$b_dns
	movl	fn_desc+4,fab_blk+fab$l_dna

;
; do the $PARSE to get the DID and expanded name
;
	$parse fab=fab_blk	; get DID of directory file
	check

	movzbl	nam_blk+nam$b_ess, file_name	; get expanded name
	movl	nam_blk+nam$l_esa, file_name+4

	movzbl	nam_blk+nam$b_dev, files_dev	; get device name for $ASSIGN
	movl	nam_blk+nam$l_dev, files_dev+4

;
; get the device lock name
;
	$getdviw_s -
		itmlst=dviitmlst, -
		devnam=files_dev
	check

;
; assign a channel to the device
;
	$assign_s -
		devnam=files_dev, -		; channel for QIO.
		chan=chan
	check

;
; make a string descriptor of the file name, type and version for the QIO
; IO$ACCESS
;
	addb3	nam_blk+nam$b_name,nam_blk+nam$b_type,fil
	addb2	nam_blk+nam$b_ver,fil
	movl	nam_blk+nam$l_name,fil+4

;
; move the DID to the FIB
;
	movw nam_blk+nam$w_did, fib_block+fib$w_did
	movw nam_blk+nam$w_did+2, fib_block+fib$w_did+2
        movw nam_blk+nam$w_did+4, fib_block+fib$w_did+4
;
; Access the file.
;
	$qiow_s chan=chan,-			; access the file,
	        func=#io$_access,-		; filling in the FID.
	        iosb=io_status,-
	        p1=fib_descr,-
		p2=#fil
	check
	blbs	io_status,5$
	$exit_s code=io_status
;
; get rid of the channel since we no longer need it
;
	$dassgn_s -
		chan=chan
	check

;
; grab the file ID and stuff it into the lock resource name
;
5$:
	movw	fib_block+4,fid1
	movw	fib_block+6,fid2
	movw	fib_block+8,fid3

;
; enq the lock in exec mode on our RMS resource name.
;
	$cmexec_s	routin = enq_lock
	check
	movl	lock_sb+4,lkidx			; save the lock ID

;
; call GETJPI from exec mode since we need information on exec mode locks
;
	$cmexec_s	routin=exec_getlki
	check

;
; DEQ the lock from EXEC mode since we no longer need it
;
	$cmexec_s	routin=deq_lock
	check

	moval	lock_list,r3			; points to lock list

;
; since the resource node master for all the locks will be the same, get
; the first one and call $GETSYI to retrieve the node name of the node that
; is mastering the resource.
;
	$getsyiw_s	csidadr = lki$l_sysid(r3), -
			itmlst = syiitmlst

;
; display a header line including the resource name, the number of locks
; queued on the resource, and the system mastering the resource.
;
	pushal	nodename_desc			; node name descriptor
	pushl	resource+4			; location of resource name
	pushl	resource			; size of resource name
	pushl	total_locks			; total number of locks 
	pushal	fao_buff1			; buffer to hold the result
	pushl	#0				;
	pushal	fao_h1				; control string
	calls	#6,g^sys$fao
	check

	pushal	fao_buff1			; output string from FAO
	calls	#1,g^lib$put_output		; display it

	pushal	file_name
	pushal	fao_buff1
	pushal	fao_buff1
	pushal	fao_h2
	calls	#4,g^sys$fao
	check
	
	pushal	fao_buff1			; output string from FAO
	calls	#1,g^lib$put_output		; display it

	pushal	fao_header			; display the header line
	calls	#1,g^lib$put_output

	divw3	lock_len+2,lock_len,r2		; determine the number of locks
						; in our table
	moval	lock_mode_table,r6		; our list of mode names
	clrl	r4				; index in the lock table

10$:
	addl3	r3,r4,r5			; add the base to the index

	$getsyiw_s -				; get the node that the owner
		csidadr = lki$l_remsysid(r5),-	; of the lock is on
		itmlst = syiitmlst
	check

;
; determine which queue the lock is on and put a pointer to the matching
; string in R0.
;
	moval	granted_queue,r0		; assume that it is granted
	cmpb	lki$b_queue(r5),#lki$c_granted	; is the lock on the granted que
	beql	1119$				; yes, go on

	moval	convert_queue,r0		; assume that it is converting
	cmpb	lki$b_queue(r5),#lki$c_convert	; is it on the CONVERT queue?
	beql	1119$

	moval	waiting_queue,r0		; must then be waiting

1119$:
;
; determine the modes of the locks on the granted and request queues.  Use
; our little table to do all this.
;
	movzbl	lki$b_grmode(r5),r1		; get the mode for granted
	mull	#2,r1				; times 2 for 2 byte modes
	addl3	r6,r1,gr_mode_desc+4		; fill in the descriptor address

	movzbl	lki$b_rqmode(r5),r1		; get the mode for requested
	mull	#2,r1				; fix the offset
	addl3	r6,r1,rq_mode_desc+4		; fill in the address

;
; push the arguments for the FAO and output the string
;
	pushl	lki$l_remlkid(r5)		; remote lock ID
	pushl	r0				; pointer to the queue
	pushal	gr_mode_desc			; mode granted
	pushal	rq_mode_desc			; mode requested
	pushl	lki$l_lockid(r5)		; the lock ID
	pushal	nodename_desc			; node of the locker
	pushl	lki$l_pid(r5)			; PID of the owner
	pushal	fao_buff2			; FAO buffer
	pushl	#0				;
	pushal	fao_control			; control string
	calls	#10,g^sys$fao			; and format it
	check

	pushal	fao_buff2			; display the
	calls	#1,g^lib$put_output		; resultant string

	addw	lock_len+2,r4			; index to the next entry

	subw	#1,r2				; bump the counter
	bleq	999$				; if done, get out
	brw	10$				; if not, do another

999$:	$exit_s code=r0

;
; enq the lock in exeutive mode
;
enq_lock:
	.word	0
	$enqw_s	lkmode = #lck$k_nlmode, -
		lksb = lock_sb, -
		acmode = #psl$c_exec, -
		resnam = resource, -
		flags = #lck$m_system
	ret

;
; DEQ the lock in executive mode
;
deq_lock:
	.word	0
	$deq_s	lkid=lkidx
	ret

;
; get the lock information in EXEC mode
;
exec_getlki:
	.word	0
	$getlkiw_s	lkidadr=lkidx,-
			itmlst=lkiitmlst
	ret

	.end	tl
    

    This is just an early version that is somewhat limited, if I have
    time to write a more spiffy one, I'll submit that, otherwise I'll
    submit this one.  In the mean while, please use and distribute so
    I can get some feed back.

    Gee, Norm, if you're looking for feedback....
    
    A nice thing you might try is interfacing to Nick Carr's CUDRIVER
    stuff. His QIO sensemode stuff would be just the ticket for getting
    usernames and such back based on the lock owner PID. It would be
    very helpful - this tool is neat, there are times on our production
    systems when we run into strange deadlock situations which VMS doesn't
    seem to be able to detect. This could help.
    
    /pjh

    Of course there is much work needed.  I also want to figure out
    who has a file header locked.  This is more involved, but I've not
    given up hope.  The CUDRIVER Interface to get back the process names
    and owners would be a good idea.  I don't know all what is needed.
    Perhaps once the other things on my plate a done...  For now, this
    is what we needed and amazingly enough, it worked...

    I tried this but without .... Boo Hoo!  
    
    NOTES> extract tl.mar
    $ MACRO TL
    $ LINK TL
    $ RUN TL
    Enter file name: SYS$COMMON:[SYSEXE]DCL.EXE
    %SYSTEM-W-NOSUCHFILE, no such file
    

    What did I do wrong???
    

    Is DCL.EXE really in SYS$COMMON:[SYSEXE]??  I just tried it here
    with sys$system:dcl.exe and got the no file found, but
    sys$common:[sysexe] found it.  Other than that, dunno.

    Oooopppssss, exited too early.
    
    Also note that DCL.EXE (nor most other .EXE files I'd bet) is not
    opened with RMS.  TL will only give the expected results on files
    that were opened with RMS.  RMS takes out a lock when it opens a
    file.  Other than that, you'll run TL and find that there is one
    lock on the resource.  This is the lock that TL took out to find
    the rest of the lockers.  Look instead at rightslist.dat or some
    file that an application program opens.

.7>    Is DCL.EXE really in SYS$COMMON:[SYSEXE]??  I just tried it here
.7>    with sys$system:dcl.exe and got the no file found, but
.7>    sys$common:[sysexe] found it.

    The reason why you get the NOTFOUND error is because the code is
    only doing an RMS $PARSE operation -- I believe it must also do
    a $SEARCH if search-listed logical names are used.
    
    				JENelson

    Yes, this is so.  Next release (if there *IS* a next release).

    Here is V1.1 with the $SEARCH, a few more comments, and some insignificant
    code changes.
    
	.title	tl
;
; This program will list all RMS$ file locks for a specified file.  This
; is usefull to display all processes that have a file open by RMS on a
; cluser.
;
; the program requires CMEXEC priv since the RMS locks are taken at exec
; mode and we must do the same.
;
; To get the lock information, we must build a resource name like RMS
; does.  The current (VMS V4) RMS file resource name looks like:
;	RMS$ + file id (3 words) + device lock name (from $GETDVI)
;
; We build this resource name by using a QIO to get the file ID and using
; $PARSE to get the device name which is then passed to $GETDVI to return
; the device lock name.  Once the resource name is built, we'll $ENQ a
; null mode lock on the resource in executive mode.  Then, using the lock ID
; from our $ENQ, call $GETLKI with the item LKI$_LOCKS which should return
; an entry for each lock taken on the resource.  $DEQ the lock just so it
; doesn't hang around for nothing.  Finally, do some output formatting on 
; the result and display it.
;
; theory of operations is something like:
;	- $PARSE and $SEARCH for the file to get device, DID and file name.
;	- $GETDVI to get the DEVLOCKNAM
;	- $ASSIGN a channel to the device
;	- $QIO access to get the file ID
;	- $ENQ a lock on the resource name
;	- $GETLKI on our lock ID for all locks on this resource
;	- $DEQ the lock
;	- parse and display the results of the $GETLKI
;
;	 7-Apr-1987	njl
;	Initial attempt.
;
;	14-APR-1987	njl
;	do a $SEARCH after the $PARSE to handle rooted and searchlist stuff
;

	.macro	check, ?l1		; another
	blbs	r0,l1			;  silly macro
	ret				;   to do status
l1:					;    checking
	.endm

	.library	/sys$share:lib/

	.psect	$data$,	rd,wrt,noexe,long

	$fibdef				; FIB layout definitions
	$psldef				; PSL definitions
	$lckdef				; lock definitions
	$lkidef				; $GETLKI definitions
	$syidef				; $GETSYI definitions

file_name: .quad 0			; file name descriptor

fib_block: .blkb fib$k_length		; FIB for opening the file
fib_descr: .long fib$k_length		; FIB descriptor
           .long fib_block

fil:	   .quad 0			; file name+type+version descriptor
files_dev: .quad 0			; device name descriptor for $ASSIGN
					; and $GETDVI

io_status: .blkq 1			; IOSB for $QIO

fab_blk: $fab	fop=nam,-		; FAB for RMS$PARSE
	        nam=nam_blk

nam_blk: $nam	rsa=res_str,-		; NAM for RMS$PARSE
	        rss=nam$c_maxrss,-
	        esa=exp_str,-
	        ess=nam$c_maxrss

exp_str: .blkb nam$c_maxrss		; exanded name string
res_str: .blkb nam$c_maxrss		; resultant name string

chan:	.long	0			; channel to the device

dviitmlst:				; $GETDVI item list to get the lock
	.word	16			; name for the device
	.word	dvi$_devlocknam
	.address devlck
	.long	0
	.long	0

syiitmlst:				; item list to return node name for
	.word	15			; a given CSID
	.word	syi$_nodename
	.address	nodename
	.address	nodename_len
	.long	0

nodename_desc:				; string descriptor for node names
nodename_len:	.long	0		; filled in by $GETSYI
		.address nodename	; text of node name always goes here
nodename:	.blkb	15		; in this buffer

lkiitmlst:				; item list for $GETLKI
	.word	1500			; 1500 bytes won't be enough always
	.word	lki$_locks		; get all the locks
	.address lock_list
	.address lock_len

	.word	4
	.word	lki$_lckcount		; get a count of all the locks
	.address total_locks
	.long	0

	.long	0

total_locks:				; total number of locks on the resource
	.long	0
lock_len:				; length of returned list and the size
	.long	0			; of each entry

lock_list:				; buffer for the lock list
	.blkb	1500

lock_sb:				; LKSB buffer
	.long	0			; status
	.long	0			; LKID
	.blkb	16			; VALUE BLOCK (not used here)

lkidx:					; our LKID
	.long	0

fao_header:				; titles for the columns
	.ascid	<10>\      PID     NODE  LOCK ID  RQ GR QUEUE    REMLKID\
fao_control:				; control string for each entry
	.ascid	/    !XL !6<!AS!> !XL !AS !AS !AS !XL/

;
; two buffers (crudely done)
;
fao_buff1:
	.ascid	/                                                                              /
fao_buff2:
	.ascid	/                                                                         /

fao_h1:					; main header
	.ascid	\!/ !SL locks on resource "!AF" at node !AS::\
fao_h2:
	.ascid	\ File name is: !AS\

resource:				; descriptor for the resource name
	.long	26			; length is always 26 for RMS locks
	.address res_addr		; pointer to the string

res_addr:				; resource name string
	.ascii	/RMS$/			; prefixed with "RMS$"
fid1:	.word	0			;  Three words
fid2:	.word	0			;     of the
fid3:	.word	0			;    file ID
devlck:	.blkb	16			; and then the DVI$_DEVLOCKNAM from
					; $GETDVI
;
; queue names for where the locks are
;
granted_queue:	.ascid	/GRANTED/
convert_queue:	.ascid	/CONVERT/
waiting_queue:	.ascid	/WAITING/

;
; table of mode values.  This table is based on the current (VMS V4) lock
; mode values and is indexed into by the lock mode.
;
lock_mode_table:
	.ascii	/NL/		; (0) NULL mode
	.ascii	/CR/		; (1) Concurrent read
	.ascii	/CW/		; (2) Concurrent write
	.ascii	/PR/		; (3) protected read
	.ascii	/PW/		; (4) protected write
	.ascii	/EX/		; (5) exclusive

gr_mode_desc:			; string descriptor for the granted mode lock
	.long	2		; always 2 bytes long
	.long	0		; filled in with the correct mode address

rq_mode_desc:			; same for the requested mode locks
	.long	2
	.long	0

fn_desc:			; input file name string descriptor
	.long	fn_len
	.address fn_text
fn_text:
	.blkb	80
fn_len = .-fn_Text

fn_prompt:			; input file name prompt
	.ascid	/Enter file name: /

	.psect	$code$,	rd,nowrt,exe,long

	.entry	tl,0
main::
;
; determine the file name
;
	pushal	fn_prompt
	pushal	fn_desc
	calls	#2,g^lib$get_input
	check

;
; fill in the NAM block default file name
;
	movb	fn_desc,fab_blk+fab$b_dns
	movl	fn_desc+4,fab_blk+fab$l_dna

;
; do the $PARSE and then a $SEARCH to get the DID and expanded name
;
	$parse fab=fab_blk	; get DID of directory file & ready for the 
	check			; $SEARCH

	$search fab=fab_blk	; get the rest of the file information
	check

	movzbl	nam_blk+nam$b_ess, file_name	; get expanded name
	movl	nam_blk+nam$l_esa, file_name+4

	movzbl	nam_blk+nam$b_dev, files_dev	; get device name for $ASSIGN
	movl	nam_blk+nam$l_dev, files_dev+4

;
; get the device lock name
;
	$getdviw_s -
		itmlst=dviitmlst, -
		devnam=files_dev
	check

;
; assign a channel to the device
;
	$assign_s -
		devnam=files_dev, -		; channel for QIO.
		chan=chan
	check

;
; make a string descriptor of the file name, type and version for the QIO
; IO$ACCESS.  do this by adding the sizes of the file name, type and version
; to get the length and just grab the pointer to the name from the nam block
; for the address.  This is safe because the file name type and version
; are stored in order and the file name pointer addresses the start of the
; string.
;
	addb3	nam_blk+nam$b_name,nam_blk+nam$b_type,fil
	addb2	nam_blk+nam$b_ver,fil
	movl	nam_blk+nam$l_name,fil+4

;
; move the DID to the FIB
;
	movl nam_blk+nam$w_did, fib_block+fib$w_did
        movw nam_blk+nam$w_did+4, fib_block+fib$w_did+4
;
; Access the file to get the file ID and then get rid of the 
; channel since we no longer need it.
;
	$qiow_s chan=chan,-			; access the file,
	        func=#io$_access,-		; filling in the FID.
	        iosb=io_status,-
	        p1=fib_descr,-
		p2=#fil
	check					; is R0 meaning success?
	blbs	io_status,5$			; also check the IOSB for OK
	$exit_s code=io_status			; IOSB has an error status

	$dassgn_s -				; don't need this any more...
		chan=chan
	check

;
; grab the file ID and stuff it into the lock resource name (assumes the
; format of the fib).
;
5$:
	movl	fib_block+4,fid1
	movw	fib_block+8,fid3

;
; enq the lock from executive mode on our RMS resource name.
;
	$cmexec_s	routin = enq_lock
	check
	movl	lock_sb+4,lkidx			; save the lock ID

;
; now call GETJPI from executive mode since we need information on 
; an executive mode lock (the one that we use finished ENQing).
;
	$cmexec_s	routin=exec_getlki
	check

;
; DEQ the executive mode lock on our resource since we no longer need it
;
	$cmexec_s	routin=deq_lock
	check


;
; since the resource mastering node for all the locks will be the same, get
; the first one and call $GETSYI to retrieve the node name of the that node
;
	moval	lock_list,r3			; points to lock list
	$getsyiw_s -
		csidadr = lki$l_sysid(r3), -
		itmlst = syiitmlst

;
; display a header line including the resource name, the number of locks
; queued on the resource, and the system mastering the resource.
;
	pushal	nodename_desc			; node name descriptor
	pushl	resource+4			; location of resource name
	pushl	resource			; size of resource name
	pushl	total_locks			; total number of locks 
	pushal	fao_buff1			; buffer to hold the result
	pushl	#0				;
	pushal	fao_h1				; control string
	calls	#6,g^sys$fao
	check

	pushal	fao_buff1			; output string from FAO
	calls	#1,g^lib$put_output		; display it

	pushal	file_name			; file name descriptor
	pushal	fao_buff1
	pushal	fao_buff1
	pushal	fao_h2
	calls	#4,g^sys$fao			; create the second line
	check
	
	pushal	fao_buff1			; line with the file name
	calls	#1,g^lib$put_output		; display it

	pushal	fao_header			; display the header line
	calls	#1,g^lib$put_output

	divw3	lock_len+2,lock_len,r2		; determine the number of locks
						; in our table
	moval	lock_mode_table,r6		; our list of mode names
	clrl	r4				; index in the lock table

;
; loop to skip down the list of locks and display information about each
;
10$:
	addl3	r3,r4,r5			; add the base to the index

	$getsyiw_s -				; get the node that the owner
		csidadr = lki$l_remsysid(r5),-	; of the lock is on
		itmlst = syiitmlst
	check

;
; determine which queue (granted, convert or waiting) the lock is in 
; and put a pointer to the matching string descriptor in R0.
;
	moval	granted_queue,r0		; assume that it is granted
	cmpb	lki$b_queue(r5),#lki$c_granted	; is the lock on the granted que
	beql	1119$				; yes, go on

	moval	convert_queue,r0		; assume that it is converting
	cmpb	lki$b_queue(r5),#lki$c_convert	; is it on the CONVERT queue?
	beql	1119$

	moval	waiting_queue,r0		; must then be waiting

1119$:
;
; determine the modes of the locks on the granted and request queues.  Use
; our little table to do all this.
;
	movzbl	lki$b_grmode(r5),r1		; get the mode for granted
	mull	#2,r1				; times 2 for 2 byte modes
	addl3	r6,r1,gr_mode_desc+4		; fill in the descriptor address

	movzbl	lki$b_rqmode(r5),r1		; get the mode for requested
	mull	#2,r1				; fix the offset
	addl3	r6,r1,rq_mode_desc+4		; fill in the address

;
; push the arguments for the FAO and output the string
;
	pushl	lki$l_remlkid(r5)		; remote lock ID
	pushl	r0				; pointer to the queue
	pushal	gr_mode_desc			; mode granted
	pushal	rq_mode_desc			; mode requested
	pushl	lki$l_lockid(r5)		; the lock ID
	pushal	nodename_desc			; node of the locker
	pushl	lki$l_pid(r5)			; PID of the owner
	pushal	fao_buff2			; FAO buffer
	pushl	#0				;
	pushal	fao_control			; control string
	calls	#10,g^sys$fao			; and format it
	check

	pushal	fao_buff2			; display the
	calls	#1,g^lib$put_output		;  resultant string

	addw	lock_len+2,r4			; index to the next entry

	subw	#1,r2				; bump the counter
	bleq	999$				; if done, get out
	brw	10$				; if not, do another

999$:	$exit_s code=r0


;
; call these next 3 routines with a CHEXEC...
;

;
; enq a lock in exeutive mode
;
enq_lock:
	.word	0
	$enqw_s	lkmode = #lck$k_nlmode, -
		lksb = lock_sb, -
		acmode = #psl$c_exec, -
		resnam = resource, -
		flags = #lck$m_system
	ret

;
; DEQ the lock in executive mode
;
deq_lock:
	.word	0
	$deq_s	lkid=lkidx
	ret

;
; get the lock information in executive mode
;
exec_getlki:
	.word	0
	$getlkiw_s	lkidadr=lkidx,-
			itmlst=lkiitmlst
	ret

	.end	tl
 

This may be reinventing the wheel, but after a few lock problems
on out clusters I put together a program that does the reverse
of .0, given the Pid of a process the program displays all locks
held  (grant mode, request mode, queue, lockid , resource)
if the resource is of the form RMS$ then the resource name
is translated into a full file spec, with .0 this
allows you to get the full story on a lock problem.
If anyone needs this the program is
IOSG""::WHAT.*   (.EXE, .OBJ)

Requires CMEXEC,WORLD,BYPASS (and maybe a few others

This is only a first attempt at this so there maybe a few faults, if anyone
does use this and has problems please mail me  (program
does NOT use Kernel mode so your machine is in no danger)


Peter Bailey

    Interesting.  Can we perhaps see how you do it?
    
    
    --  Barry

>    Interesting.  Can we perhaps see how you do it?


To get the lock values for a given process I follow the list
of LKB blocks pointed to by PCB$L_LOCKQFL this gives me
such things as lock request mode,granted mode,access mode etc
to get the resource name I use the back pointer LKB$L_RSB to get
to the resource block.

As far as I know there is no easy way to translate a resource name (RMS$)
back to a file name, so to do this I build a table
containing the full name of all disk class devices seen (start
with SCS$GQ_CONFIG , follow this down to the DDB list head, check for
disk class device etc) so when I get a lock of the form RMS$.... I can
match the Device Lock name from the resource with the Device lock
name obtained from each disk class device with a GETDVI, then
assign a channel and use QIO to translate the 3 Fid words from the
resource name to a full file spec.

If anyone wants to see the code I can either post it here or Mail
it as soon as I put some comments in the code (and tidy it up a lot)


Peb

    
    Why not post it... we can all look at it and grab it if we want.
    

    If it's going to be posted anywhere, shouldn't it be in the Toolshed?
    

re: file name
    	I really like this program.  Quite nice; please DO post the sources.
    
    	The file name can be determined since the file ID is part of
    the resource name.  It is the 6 bytes following the RMS$ part of
    the resource.  The device name is not really there, just a hacked
    up sort of the volume label (that is not always the CURRENT label
    of the volume in question).  In any case, LIB$FID_TO_NAME can convert
    the FID to a file name, given the device where the file is...  If
    LIB$FID_TO_NAME has no external interface, let me know and I'll
    get you the sources for it.
    
    	At the sub- level, there are a number of locks that RMS maintains.
    These include record locks (by RFA I think), bucket locks (I've
    not got a clue), and the APPENDER lock (for shared sequential files).
    You can look through the RMS sources (many, many files) and determine
    how these are all used, if you are so inclined.  ;-)

    re: -.12
    
    Would you run software with those privileges without looking at
    the code and compiling/linking it yourself?
    
    Just a thought
    
    Pat M.

Ok you asked for it......


Source for What follows




; Program to display all locks for a given process and convert
; locks of the form RMS$ to a full file spec
;
;
;
; To get the lock values for a given process I follow the list
; of LKB blocks pointed to by PCB$L_LOCKQFL this gives me
; such things as lock request mode,granted mode,access mode etc
; to get the resource name I use the back pointer LKB$L_RSB to get
; to the resource block.
;
; To convert an RMS$ lock to a file spec I build a table 
; containing the full name of all disk class devices seen (start
; with SCS$GQ_CONFIG , follow this down to the DDB list head, check for
; disk class device etc) so when I get a lock of the form RMS$.... I can
; match the Device Lock name from the resource with the Device lock
; name obtained from each disk class device with a GETDVI, then
; assign a channel and use QIO to translate the 3 Fid words from the
; resource name to a full file spec.
;
	.link	/sys$system:sys.stb/
	.library	/sys$library:lib/

	$iodef
	$atrdef
	$sbkdef
	$fibdef
	$dcdef
	$sbdef
	$ddbdef
	$ucbdef
	$rsbdef
	$lkbdef
	$lckdef
	$rsbdef
	$pcbdef



ac_tbl:	.byte	6			; array of counted ascii strings
	.ascii	/Kernel /		; of access modes for locks
	.byte 	4	
	.ascii	/Exec   /
	.byte	5	
	.ascii	/Super  /
	.byte	4	
	.ascii	/User   /

dviitmlst:				; $getdvi item list to get the lock
	.word	16			; name for the device
	.word	dvi$_devlocknam
	.address devlck
	.long	0
	.long	0

devlck:	.blkb	30			; device lock name

out:	.long	200			; output string descriptor for use
	.long	out+8			; by fao
	.blkb	200

rmode:	.blkw	1			; lock requested mode

gmode:	.blkw	1			; lock granted mode

nmode:	.ascii	/??/			; default lock type

modes:	.ascii	/NL/			; array of lock types
	.ASCII	/CR/
	.ASCII	/CW/
	.ASCII	/PR/
	.ASCII	/PW/
	.ASCII	/EX/

pmt:	.ascid	/whats the pid  ? > /	; user prompt to get the pid

jpi_item:	.word	20		; item list for getjpi
		.word	jpi$_prcnam	; get process name
		.long	process_name
		.long	process_name_len
;
		.word	4
		.word	jpi$_pid	; get process pid
		.long	epid
		.long	0
;
		.word	20
		.word	jpi$_username	; get username
		.long	username
		.long	0
;
		.word	100
		.word	jpi$_imagname	; get current image name
		.long	image
		.long	image_len
;
		.long	0

image:		.blkb	100		; image name

image_len:	.blkl	1		; image length

process_name:	.blkb	20		; process name

process_name_len:	.blkl	1	; process name length

username:		.blkb	20	; username string

epid:	.blkl	1			; target process extended pid

ipid:	.blkl	1			; target process internal pid

len:	.blkw	1			; length of user input

iosb:	.blkl	2			; io status block for use by qio


; very silly macro to check return status 

	.macro	check	ar0,aerror,?l3
	blbs	ar0,l3
	brw	aerror
l3:	nop
	.endm	check

	.entry	start,0			; main program starts here

; get the pid

	pushaw	len			; length of user input
	pushaq	pmt			; prompt string if no input supplied
	pushaq	out			; store input in the 'out' descriptor
	calls	#3,g^lib$get_foreign	; get foreign command line
	check	r0,error		; did we get an error ?

; convert input length to long

	cvtwl	len,out

; convert hex text to a longword

	pushl	#4			; we want 4 bytes (longword) out
	pushal	epid			; store result in epid
	pushaq	out			; input (from user) descriptor
	calls	#3,g^ots$cvt_tz_l	; convert hex text to a longword
	check	r0,error		; did we get an error ?

; now use getjpi to (1) check this process exists & (2) get some usefull
; data about it (process nam,full pid, image name )

	$getjpiw_s	pidadr=epid,-		; get data for the process user gave
			itmlst=jpi_item,-	; jpi item list address
			iosb=iosb		; io status block
	check	r0,error		; did we get an error ?	
	movw	iosb,r0			; check the status in the iosb
	check	r0,error		; did we get an error ?

; convert the epid to an ipid

	movl	epid,r0			; 
	jsb	g^exe$epid_to_ipid	;  converting from epid to ipid
	bneq	10$			; did we get an error ?
	movl	#0,r0
	ret
10$:	nop
	movl	r0,ipid			; shuffle ipid for later

; report the data obtained from getjpi

	movl	#200,out		; ensure string length set to 200 bytes
	$fao_s	ctrstr=ctr1,outbuf=out,outlen=out,-
		p1=epid,-		; extended pid
		p2=#15,-		; 15 bytes of
		p3=#username,-		; userename
		p4=process_name_len,-	; process name length
		p5=#process_name	; process name
	pushaq	out			; output descriptor from fao
	calls	#1,g^lib$put_output	; tell the world

; report the processes current image name

	movl	#200,out    		; ensure string length set to 200 bytes
	$fao_s	ctrstr=ctr3,outbuf=out,outlen=out,-
		p1=image_len,-		; image name 
		p2=#image
	pushaq	out			; output descriptor from fao
	calls	#1,g^lib$put_output	; tell the world

; now enter the main loop of the program, each call to get_lkb
; will return data about one lock held by the target process
; signals ss$_nomorelock when there are no more locks 

loop:	$cmexec_s	routin=get_lkb
	check	r0,error		; did we get an error ?

; set lock requested/granted modes default (in case of corrupt data)

	movw	nmode,gmode
	movw	nmode,rmode

; now store the ascii string for the granted mode

	movzbl	granted_mode,r0		; get granted mode
	movw	modes[r0],gmode

; now store the ascii string for the requested mode

	movzbl	request_mode,r0
	movw	modes[r0],rmode

; store the counted ascii string (8 bytes) for the lock access mode

	movl	ac_mode,r0
	movq	ac_tbl[r0],ac_mode

; store the ascii queue name on which the lock resides 

	tstl	state
	blss	600$
	bgtr	610$
	movab	c_str,a_state		; lock converting
	brw	620$
600$:	nop
	movab	w_str,a_state		; lock waiting
	brw	620$
610$:	nop
	movab	g_str,a_state		; lock granted
620$:	nop

; report data about the lock (lockid,access mode,resource name etc)

	movl	#200,out		; set descriptor length to 200
	$fao_s	ctrstr=ctr2,outbuf=out,outlen=out,-
		p1=#10,-		; queue name length
		p2=a_state,-		; queue name
		p3=#ac_mode,-		; lock access mode 
		p4=lkid,-		; lock id
		p5=#2,-			; lock requested string
		p6=#rmode,-
		p7=#2,-			; lock granted string
		p8=#gmode,-
		p9=resnam_length,-	; lock resource name
		p10=#resnam
	pushaq	out
	calls	#1,g^lib$put_output	; tell the world

; if this lock is of the form  RMS$.... then branch to the translate
; routine to return us the full file spec for this lock

	cmpl	#^a/RMS$/,resnam
	bneq	300$
	bsbw	translate
300$:	nop

	brw	loop

error:	ret				; general error exit 


; translate subroutine, this (should) give us the file spec
; for a lock of the form RMS$....
;
; the first time we enter this routine we build a table containing
; (dev_list  format   device length (long)  device string etc)
; the device names of all disk class devices , then
; we try to match the device lock name from the lock resource
; with the lock name given by a getdvi for each device
; when we get a match we assign a channel to this device
; and use qio to return the full file spec


translate:	nop			; entry point

	tstl	dev_list		; have we built the device table ?
	bneq	100$			; skip build 
	$cmexec_s	routin=get_dev	; build table in exec mode
	check	r0,error		; error ?
100$:	nop				; table built

	movab	dev_list,dev_point	; set starting point
					; for device search at
					; start of table

; build a descriptor (descr) for the curerent device

150$:	movl	@dev_point,descr	; put the device length in descr	
	bneq	450$			; if length = 0 then exit routine
	brw	400$			; end of device table
450$:	nop				; ok continue

	addl2	#4,dev_point		; point no to the device string

	movl	dev_point,descr+4	; fill in the descriptor

	addl2	descr,dev_point		; and skip the device string
					; on the next pass
;
; get the device lock name
;

	$getdviw_s -
		itmlst=dviitmlst, -
		devnam=descr
	check	r0,error		; test for error

	cmpc3	#12,devlck+1,resnam+11	; does the device lock name

	beql	200$			; from getdvi match that 
	brw	150$			; in the resource ? 
200$:	nop				; ok we got a match

; assign a channel to this device, using the descriptor formed
; above

	$assign_s	devnam=descr,-
			chan=chan
	check	r0,error

; set fib block control function

	movl	#fib$m_noread!fib$m_nowrite!fib$m_nolock!fib$m_norecord,-
		fib+fib$l_acctl

; say we want the full file spec returned

	movw	#atr$s_file_spec,atr+atr$w_size
	movw	#atr$c_file_spec,atr+atr$w_type
	movab	file,atr+atr$l_addr

; put fid (from the resource name) into fib block

	movc3	#6,resnam+4,fib+fib$w_fid_num

; zero down the returned file spec string

	movc5	#0,(sp),#0,#100,file

; access file to get the full file spec

	$qiow_s	chan=chan,-
		func=#io$_access,-
		iosb=iosb,-
		p1=fib_d,-		; fib block descriptor
		p5=#atr			; attribute block
	check	r0,error
	movw	iosb,r0			; check for errors from qio
	check	r0,error

	movzwl	file,descr		; put the returned file spec

	movab	file+2,descr+4		; length/address in descr

; report the file name and 3 fid words

	movl	#200,out
	$fao_s	ctrstr=ctr7,outbuf=out,outlen=out,-
		p1=#descr,-		; full file spec descriptor
		p2=resnam+4,-		; 3 fid words from the resource
		p3=resnam+6,-		; name
		p4=resnam+8
	pushaq	out
	calls	#1,g^lib$put_output

; get rid of the channel to the device

	$dassgn_s	chan=chan
	check	r0,error

; exit translate subroutine
400$:	rsb


; routine run in exec mode that returns data about one lock
; held by the target process per call, signals ss$_nomorelock
; when no more locks to return


	.entry	get_lkb,0

; test the stored pointer lkb_fl, if it is zero we need to get the
; pcb for the target process to enable us to get the lock
; queue forward link, we only need to get this on the first
; call only - all other calls to get_lkb will have the lock queue
; pointer set up

	tstl	lkb_fl			; if not zero we do not need to get the pcb
	bneq	234$

	movzwl	ipid,r6			; get the pcb address by offseting from the
	movl	g^sch$gl_pcbvec,r2	; pcb vector list
	movl	(r2)[r6],r2		; pcb address now in r2

; store the lock queue forward link & the address of same
; (so we can check for a pointer back to the queue start = no more locks)

	movl	pcb$l_lockqfl(r2),lkb_fl
	moval	pcb$l_lockqfl(r2),lkb_bl

234$:	nop

; common code now for all calls to get_lkb
; test for pointer back to the queue start (no more locks)

	cmpl	lkb_fl,lkb_bl
	bneq	235$
	movl	#ss$_nomorelock,r0	; return end of queue status
	ret
235$:	nop

; lkb_fl points into the body of the lock block (at lbk$l_ownqfl)
; so we must adjust for the start of the lock block 

	subl2	#lkb$l_ownqfl,lkb_fl	; adjust for start of lkb
	movl	lkb_fl,r3

; store the new pointer for next time we call get_lkb

	movl	lkb$l_ownqfl(r3),lkb_fl

; sanity test, make sure the owner uic in the lock block
; is the requested one, return an error if the match fails

	cmpl	lkb$l_pid(r3),ipid
	beql	236$
	movl	#ss$_abort,r0
	ret
236$:	nop

; save the lock state (granted,waiting,converting)

	cvtbl	lkb$b_state(r3),state

; save the lock id

	movl	lkb$l_lkid(r3),lkid

; save the lock request/granted modes (nl,cw,cr etc)

	movb	lkb$b_grmode(r3),granted_mode
	movb	lkb$b_rqmode(r3),request_mode

; get the resource block address)

	movl	lkb$l_rsb(r3),r0

; save the resource access mode (user,super,exec etc)

	movzbl	rsb$b_rmod(r0),ac_mode

; save the resource name / length

	cvtbl	rsb$b_rsnlen(r0),r1

	movzbl	rsb$b_rsnlen(r0),resnam_length

	movc5	r1,rsb$t_resnam(r0),#^a/ /,#100,resnam
	
	movl	#1,r0			; indicate success

	ret				; return to main loop

lkb_fl:	.blkl	1			; pointer to the next lock block to report on

lkb_bl:	.blkl	1			; address of queue list head (pcb$l_lockqfl)

lkid:	.blkl	1			; lock id 

granted_mode:	.blkb	1		; lock granted mode

request_mode:	.blkb	1		; lock requested mode

resnam:	.blkb	200			; lock resource name (200 bytes = more than enuf)
					; fao control string

ctr1:	.ascid	/Locks taken out by  !XL  !AF   !AF /

resnam_length:	.blkl	1		; resource name length
					; fao control string

ctr2:	.ascid	+!AF (!AC) Lockid !XL (!AF/!AF) Resource !AF  +


; routine called in exec mode to build in dev_list a list
; of all disk devices we can see
;
; the flow is to start with scs$gq_config which has a block
; for each node of a vaxcluster, then step down into the ddb
; list then step down into the first ucb to test if its a disk device
; and store the device name as  node$device unit


	.entry	get_dev,0

; store pointer to dev_list

	movab	dev_list,dev_point

; store pointer to the vaxcluster block

	movl	g^scs$gq_config,r7
10$:	nop

; crude method of appending a $ to the node name (if it has one)
; pad the node name with all $'s

	movc5	#0,(sp),#^a/$/,#16,node

; save the node name

	movzbl	sb$t_nodename(r7),node_length
	movc3	node_length,sb$t_nodename+1(r7),node

; if the node name is not zero (ie its a vaxcluster member)
; then add 1 to the node name length, thus appending a $

	tstl	node_length
	beql	700$
	incl	node_length
700$:	nop

; test if the ddb pointer is zero (no devices on this node ?)

	tstl	sb$l_ddb(r7)
	bneq	160$
	brw	40$
160$:	nop

; save the ddb list head

	movl	sb$l_ddb(r7),r6

; now get the first ucb off the ddb 

60$:	movl	ddb$l_ucb(r6),r8
	bneq	31$
	brw	30$
31$:	nop

; is it a disk ucb ?

	cmpb	ucb$b_devclass(r8),#dc$_disk
	beql	32$
	brw	30$
32$:	nop

; save the device name & length

	movzbl	ddb$b_name_len(r6),device_length
	movc3	device_length,ddb$t_name+1(r6),device

; use fao to generate a device name of the form node$device unit

100$:	movl	#100,out
	$fao_s	ctrstr=dctr,outbuf=out,outlen=out,-
		p1=node_length,-
		p2=#node,-
		p3=device_length,-
		p4=#device,-
		p5=ucb$w_unit(r8)
;	pushaq	out				; we dont want to see the list
;	calls	#1,g^lib$put_output		; on sys$output !

; save the device name in dev_list as  length (long) device string

	movl	out,@dev_point
	addl2	#4,dev_point
	movc3	out,out+8,@dev_point
	addl2	out,dev_point

; go do the next ucb off this ddb , if pointer zero then no more devices

	movl	ucb$l_link(r8),r8
	beql	30$
	brw	100$
30$:	nop

; we are here either because we ran out of ucb's or the ddb did not
; point to a disk class device
; if the pointer to the next ddb is zero then there are no more ddb's
; on this node

	movl	ddb$l_link(r6),r6
	beql	40$
	brw	60$

; get the next sb block (for the next node to do)
; if the flink for this = scs$gq_config then we have completed
; this unguided trip tho system data structures

40$:	movl	sb$l_flink(r7),r7
	cmpl	sb$l_flink(r7),g^scs$gq_config
	beql	ext
	
	brw	10$

ext:	nop
	movl	#1,r0		; indicate success   	

	ret

device:	.blkb	20		; device name (ie   dua)

device_length:	.blkl	1	; device name length

node:	.blkb	16		; node name (=scsnode)

dctr:	.ascid	/!AF!AF!UW/	; fao control string to generate full device name

node_length:	.blkl	1	; node name length

dev_list:	.blkb	100*100	; enuf room for 1,000 bytes of device names !!

dev_point:	.blkl	1	; pointer into dev_list

descr:	.blkl	2		; common or garden descriptor

				; fao control string to tell us the
				; full file spec & 3 fid words)
ctr7:	.ascid	+!AS   (!UW, !UW, !UW)!/ +

state:	.blkl	1		; lock state  (granted etc)

c_str:	.ascii	/Converting/	; ascii strings for lock state
w_str:	.ascii	/Waiting   /
g_str:	.ascii	/Granted   /

a_state:	.blkl	1	; pointer to above ascii string

chan:	.blkw	1		; channel to device found in dev_list

fib_d:	.long	fib$c_length	; fib descriptor block for qio
	.long	fib

fib:	.blkb	fib$c_length	; fib block

atr:	.blkb	100		; attribute block

; fao control to tell us the current image of the target process
ctr3:	.ascid	+ (Current image is !AF)  !/+

file:	.blkb	1000		; string for the full file spec

ac_mode:	.blkl	2	; resource access mode

	.end	start

; please ! no comments about the yuck code, i know
; it looks as if this was written late at night on a dial up terminal
; under the influence of too much beer   ....  it was !