.title vmslocks ;++ ; ; This program will list all F11B$a file locks for a specified file. This ; is usefull to display all processes that have a file open on a cluster. ; ; The program requires CMKRNL priv since the F11BXQP locks are taken at kernel ; mode and we must do the same. ; ; To get the lock information, we must build a resource name like XQP ; does. The current file resource name looks like: ; ; F11B$a + device lock name (from $GETDVI) + file id ; ; 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 kernel 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 ; ; This program is a modified version of RMSLOCKS.MAR found in the DECUS France ; server. RMSLOCKS as been given by Bernard OURGHANLIAN (DEC). Modifications ; made by Francois FOUCHET. ; ; ** USE AT YOUR OWN RISKS ** ;-- .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 !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 res_len ; length .address res_addr ; pointer to the string res_addr: ; resource name string .ascii /F11B$a/ ; prefix used by XQP devlock:.blkb 12 ; Device lock name (12 chars) fid1: .word 0 ; File number fid2: .word 0 ; File number extension res_len = . - res_addr ; resource len devlck: .blkb 16 ; 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 vmslocks,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 ;+ ; Copy usefull part of device lock name ;- movq devlck+1,devlock movl devlck+9,devlock+8 ;+ ; 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$: movw fib_block+4,fid1 movb fib_block+9,fid2 ;+ ; Enq the lock from kernel mode on our XQP resource name. ;- $cmkrnl_s routin = enq_lock check movl lock_sb+4,lkidx ; save the lock ID ;+ ; Now call GETJPI from kernel mode since we need information on ; an kernel mode lock (the one that we use finished ENQing). ;- $cmkrnl_s routin=kernel_getlki check ;+ ; DEQ the kernel mode lock on our resource since we no longer need it ;- $cmkrnl_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 CHKRNL... ;- ;+ ; Enq a lock in kernel mode ;- enq_lock: .word 0 $enqw_s lkmode = #lck$k_nlmode, - lksb = lock_sb, - acmode = #psl$c_kernel, - resnam = resource, - flags = #lck$m_system ret ;+ ; DEQ the lock in kernel mode ;- deq_lock: .word 0 $deq_s lkid=lkidx ret ;+ ; Get the lock information in kernel mode ;- kernel_getlki: .word 0 $getlkiw_s lkidadr=lkidx,- itmlst=lkiitmlst ret .end vmslocks