RMS record locking

[Chris Sharman]

>Thanks for the suggestions, what I really need is the process id of the process
>that actually has the file locked.

Here's what I have: ugly & without warranty of any kind.
It actually looks for record locks - a much commoner problem than file locks.
If you really want file locks, hopefully this will give you an indication how
to do it.
Non VMS folks switch off now.

Build a protected shareable image as indicated, install /open/head/share/prot
(necessary to mess with RMS's exec mode locks).
After encountering rms$_tmo, rms$_rnl, or rms$_ok_rrl, call the getblock
routine from within the application with the following arguments:

getblock(%immed rab.rab$w_isi, %ref rlen, %stdescr buff)

rab$w_isi is the isi for the offending record stream, passed by value.
rlen is a 2 element array of words, by reference.
buff is a buffer to receive lock information, by descriptor.

It uses $getlkiw with the lki$_locks item code to fill in rlen & buff: read the
details in the system service manual. The PID & other details are all there.

It works for me on Alpha OpenVMS 7.1. It would need work to work on VAX.
I've no idea whether it will work with the ODS-5 changes (7.2).

Good luck,
Chris

ss_getblock.opt:

! link/share/prot/nosysshr ss_getblock/opt/sysexe=selective_search
ss_getblock
alpha$loadable_images:rmsdef.stb/selective_search
gsmatch=lequal,1,0
symbol_vector = ( getblock = procedure )

ss_getblock.mar:

	.TITLE	SS_GetBlock Get RMS record blocker system service
	.IDENT	/V1.0/
 
;++
; FUNCTIONAL DESCRIPTION:
; 
;	This module declares a system service to find the RMS record lock we've
;	just tried to get, and use $getlki to find who's holding it
; 
; AUTHOR:   Chris  , CREATION-DATE:  8-JUL-1999
; 
; MODIFIED BY: 
; 
;--
;

	.library	"sys$share:lib"

	$impdef
	$plvdef

	$lckdef
	$lkidef
	$rmsdef
	$ssdef

	.dsabl	GLOBAL

	.external	pio$gw_iioimpa,-
			irb$w_rfa_id, irb$l_rfa_vbn, irb$l_ifab_lnk,-
			ifb$l_sfsb_ptr,-
			sfsb$l_lock_id

; Alpha
	.psect	exec_disp,long,pic,nowrt,noexe
ecount = 0
etable:
	.macro	ess	name,narg=0
	ecount = ecount + 1
	.address	name
	.endm

	ess	getblock,2

	.psect	user_services,page,vec,pic,nowrt,exe

	.long	plv$c_typ_cmod, 0		; vector type change mode dispatcher
	.long	0, ecount			; k, e routine count
	.address 0, etable, 0			; k, e routine list, rundown
	.long	0, 0, 0, 0			; resv; rms; k, e flags

	.psect	exec_routines,quad,pic,nowrt,exe

einsfarg:
	movzwl	#ss$_insfarg, r0
	ret

eaccvio:
	movzwl	#ss$_accvio, r0
	ret

rms_isi:
	movl	#rms$_isi, r0
	ret

	.entry	getblock, ^m<r2,r3,r4,r5,r6>

	cmpb	(ap), #3 ; Alpha only - check we have 3 (or more) arguments
	.branch_unlikely
	blssu	einsfarg

; Args: rab$w_isi (immed), lki rlen (ref), lki buffer descriptor

	movl	8(ap), r3 ; rlen
	ifnowrt	#4, (r3), eaccvio	; probe lki rlen

	movl	12(ap), r5
	ifnord	#8, (r5), eaccvio	; probe lki buffer descriptor
	movzwl	(r5), r4
	movl	4(r5), r5
	ifnowrt	r4, (r5), eaccvio	; probe lki buffer

	movzwl	4(ap), r2 ; isi
	.branch_unlikely
	bleq	rms_isi

	moval	g^pio$gw_iioimpa, r1
	cmpw	r2, imp$w_num_ifabs(r1)
	.branch_unlikely
	bgtru	rms_isi			; validate isi

; init local storage (on stack)

iosb = 0
lksb = iosb + 8
itmlst = lksb + 8
resnam = itmlst + 16
resdsc = resnam + 8
space = resdsc + 8

	subl	#space, sp
	movl	sp, r6
	movl	r4, itmlst(r6)
	movw	#lki$_locks, itmlst+2(r6)
	movl	r5, itmlst+4(r6)
	movl	r3, itmlst+8(r6)
	clrl	itmlst+12(r6)
	movl	#8, resdsc(r6)
	movab	resnam(r6), resdsc+4(r6)

	movl	imp$l_irabtbl(r1), r3
	movzwl	imp$w_entperseg(r1), r0
	cmpl	r2, r0			; isi in this segment ?
	bleq	2$
	mnegl	r0, r4
	decl	r0
1$:	movl	(r3), r3
	acbl	r0, r4, r2, 1$
2$:	movl	(r3)[r2], r3		; irab

; now we go into non-user readable area
; the exec data up to here _is_ user readable

	movzwl	irb$w_rfa_id(r3), resnam(r6)
	movl	irb$l_rfa_vbn(r3), resnam+4(r6)
	movl	irb$l_ifab_lnk(r3), r3
	movl	ifb$l_sfsb_ptr(r3), r3
; got the file lkid, and the rfa

	$enqw_s	lkmode = #lck$k_nlmode, -
		lksb   = lksb(r6), -
		flags  = #lck$m_noqueue!lck$m_system!lck$m_expedite, -
		resnam = resdsc(r6), -
		parid  = sfsb$l_lock_id(r3)
	blbc	r0, 9$
	movzwl	lksb(r6), r0
	blbc	r0, 9$

; we've now got an exec mode system/rms lock - we must release it

	$getlkiw_s -
        	lkidadr = lksb+4(r6), -
        	itmlst = itmlst(r6), -
        	iosb   = iosb(r6)
	movl	r0, r2
	$deq_s	lkid   = lksb+4(r6)

; released OK

	blbc	r2, 8$
	movl	iosb(r6), r2
	blbc	r2, 8$
9$:	addl	#space, sp
	ret
8$:	movl	r2, r0
	brb	9$

	.END

_______________________________________________________________________
Chris.Sharman@CCAgroup.co.uk		http://www.ccastat.demon.co.uk/
CCA Stationery Ltd, Eastway, Fulwood, Preston, Lancashire, PR2 9WS.
= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Subscribe: "subscribe powerh-l" in message body to majordomo@lists.swau.edu
Unsubscribe: "unsubscribe powerh-l" in message to majordomo@lists.swau.edu
This list is closed, thus to post to the list, you must be a subscriber.