Subject: Re: Tracking RMS locking Date: Sat, 12 May 2001 11:52:30 -0400 From: David A Froble Organization: tsoft-inc.com To: Everhart@gce.com This one might be a bit easier to build. You get so used to a particular environment, and you tend to forget that the rest of the world doesn't have that environment. Dave -- David Froble Tel: 724-529-0450 Dave Froble Enterprises, Inc. Fax: 724-529-0596 DFE Ultralights, Inc. E-Mail: davef@tsoft-inc.com T-Soft, Inc. 170 Grimplin Road Vanderbilt, PA 15486 --------------------------------------------------------------------- 2 !******************************************************************** ! ! Program: RMS_LOCKS.BAS ! Function: Watch RMS Locks ! Version: 1.00 ! Created: 10-May-2001 ! Author(s): David Froble ! Dave Froble Enterprises, Inc. ! ! Purpose/description: ! ! This program will scan the lock database selecting ! RMS created locks. It will build data structures ! for filenames, opens, locks, and blocked locks. ! ! A user can select to see the entire data structure, ! files, opens, and locks, or just blocked locks. ! !******************************************************************** ! ! Copyright 2001 by Dave Froble Enterprises, Inc. ! ! This program is the sole property of Dave Froble ! Enterprises, Inc. and may not be copied in whole ! or in part without the express written permission ! of Dave Froble Enterprises, Inc. ! !******************************************************************** ! ! Modification history: ! !******************************************************************** OPTION SIZE = ( INTEGER WORD , REAL DOUBLE ) %INCLUDE "$SSDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB" %INCLUDE "$JPIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB" %INCLUDE "$LKIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB" %INCLUDE "$LCKDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB" EXTERNAL LONG FUNCTION SYS$CMEXEC ! External SS EXTERNAL LONG FUNCTION SYS$GETLKI ! External SS EXTERNAL LONG FUNCTION SYS$GETLKIW ! External SS EXTERNAL LONG FUNCTION SYS$GETMSG ! External SS EXTERNAL LONG FUNCTION LIB$GETJPI ! External RTL EXTERNAL LONG FUNCTION LIB$FID_TO_NAME ! External RTL DECLARE LONG REC%, ! Longwords & LONG BKT%, & LONG CONTEXT%, & LONG LOCK.ID%, & LONG PARENT.ID%, & LONG PID%, & LONG STAT%, & LONG TEMP% ! Record for GETLKI item list RECORD ITEM_LIST WORD BUFLEN% WORD ITEM% LONG BUFADR% LONG RETADR% END RECORD DIM ITEM_LIST I(6) ! Buffer for LKI$_STATE RECORD LOCK_STATE BYTE REQUEST% BYTE GRANT% BYTE QUEUE% END RECORD DECLARE LOCK_STATE LOCK.STATE ! Buffers for return data MAP (B) STRING RESNAM.BUFF$=31, & STRING BUFF$=512 ! Blocked lock info RECORD BLOCKER LONG BLOCKER.ID% LONG PID% LONG MSTCSID% STRING REQ.MODE$=1 STRING GRANT.MODE$=1 STRING QUEUE$=1 LONG LKID% LONG REQ.CSID% END RECORD MAP (BLK) BLOCKER BLK MAP (BLK) STRING BLK$=23 ! Return data lengths DECLARE LONG RETDAT%(6) ! Re-define return length longword MAP (R) LONG RETDAT% MAP (R) WORD RETLEN%, & WORD FLAGS% ! Re-define integer values MAP (F) STRING FID$=8 MAP (F) LONG RECNUM%, & LONG BKTNUM% MAP (F) WORD FID1%, & WORD FID2%, & WORD FID3% ! I/O status block MAP (I) LONG IOSB%, & LONG IOSB2% MAP (L) LONG LKI_NUM_ARG%, & LONG LKI_EFN_VAL%, & LONG LKI_ID_ADR%, & LONG LKI_BUFLEN_ADR%, & LONG LKI_IOSB_ADR%, & LONG LKI_AST_ADR%, & LONG LKI_AST_PRM%, & LONG LKI_NULL_ARG% !************************************************** ! Lock Storage Structures !************************************************** RECORD FILE_HDR ! One rec per file WORD FILE.ID1% WORD FILE.ID2% WORD FILE.ID3% STRING FILE.NAME$=60 STRING DEV$=16 WORD PTR% END RECORD DIM FILE_HDR FILE.HDR(200) RECORD FILE_DTL ! One rec per open LONG LOCK.ID% LONG PID% WORD LINK% WORD FILE.PTR% WORD PTR% STRING PROC.NAME$=15 STRING IMAGE.NAME$=60 STRING USER.NAME$=12 STRING STATE$=1 END RECORD DIM FILE_DTL FILE.OPN(999) RECORD LOCK_DTL ! One rec per sublock LONG LOCK.ID% LONG PARENT.ID% LONG REC% LONG BKT% WORD LINK% WORD OPEN.PTR% STRING STATE.REQ$=2 STRING STATE.GRANT$=2 STRING STATE.QUEUE$=1 END RECORD DIM LOCK_DTL LOCK.DTL(9999) RECORD BLOCK_LIST LONG LOCK.ID% LONG BLOCKER.ID% END RECORD DIM BLOCK_LIST BLK.DTL(99) 200 !************************************************** ! Program Initialization !************************************************** GOSUB 4990 PRINT #KB% ! Display banner PRINT #KB%, P8$; " "; DATE4$(0%); " "; TIME$(0%) !************************************************** ! Load Item List !************************************************** Load_Item_List: FOR Z% = 0% TO 6% I(Z%)::BUFLEN% = 0% I(Z%)::ITEM% = 0% I(Z%)::RETADR% = LOC(RETDAT%(Z%)) NEXT Z% I(0%)::BUFLEN% = 31% I(0%)::ITEM% = LKI$_RESNAM I(0%)::BUFADR% = LOC(RESNAM.BUFF$) I(1%)::BUFLEN% = 4% I(1%)::ITEM% = LKI$_LOCKID I(1%)::BUFADR% = LOC(LOCK.ID%) I(2%)::BUFLEN% = 4% I(2%)::ITEM% = LKI$_PID I(2%)::BUFADR% = LOC(PID%) I(3%)::BUFLEN% = 4% I(3%)::ITEM% = LKI$_PARENT I(3%)::BUFADR% = LOC(PARENT.ID%) I(4%)::BUFLEN% = 3% I(4%)::ITEM% = LKI$_STATE I(4%)::BUFADR% = LOC(LOCK.STATE::REQUEST%) I(5%)::BUFLEN% = 512% I(5%)::ITEM% = LKI$_BLOCKING I(5%)::BUFADR% = LOC(BUFF$) LKI_NUM_ARG% = 7% ! $GETLKI arg list LKI_EFN_VAL% = 0% LKI_ID_ADR% = LOC(CONTEXT%) LKI_BUFLEN_ADR% = LOC(I(0%)::BUFLEN%) LKI_IOSB_ADR% = LOC(IOSB%) LKI_AST_ADR% = 0% LKI_AST_PRM% = 0% LKI_NULL_ARG% = 0% 1000 !************************************************************ ! Main Processing !************************************************************ PRINT #KB% PRINT #KB%, "1-full, 2-all, -blocked locks, \ to exit> "; I0$ = INKEY$( KB% , WAIT 255% ) GOTO 4950 IF I0$="\" GOTO 1000 UNLESS I0$="1" OR I0$="2" OR I0$="" PRINT #KB% CONTEXT% = 0% ! Lock ID context F.CNT% = 0% ! File list counter O.CNT% = 0% ! Open list counter L.CNT% = 0% ! Lock list counter B.CNT% = 0% ! Blocked lock counter 1100 !************************************************** ! Get All RMS Locks !************************************************** STAT% = SYS$CMEXEC( LOC(SYS$GETLKIW) BY VALUE , LKI_NUM_ARG% ) IF ( STAT% AND SS$_NORMAL ) = 0% THEN GOTO 1200 IF STAT% = SS$_NOMORELOCK E$ = FNVMSERR$( STAT% ) PRINT #KB%, E$ PRINT #KB%, STAT%, IOSB% GOTO 4900 END IF RETDAT% = RETDAT%(0%) GOTO 1100 UNLESS LEFT(RESNAM.BUFF$,4%) = "RMS$" !************************************************** ! Store File Information !************************************************** Process_File_Open: FID$ = MID(RESNAM.BUFF$,5%,6%) ! File ID GOTO File_Hdr_Found IF FID1% = FILE.HDR(F.IDX%)::FILE.ID1% & AND FID2% = FILE.HDR(F.IDX%)::FILE.ID2% & AND FID3% = FILE.HDR(F.IDX%)::FILE.ID3% & FOR F.IDX% = 1% TO F.CNT% DEV$ = EDIT$(RIGHT(RESNAM.BUFF$,12%),133%) ! Device name FILE.NAME$ = "" ! Get filename STAT% = LIB$FID_TO_NAME( DEV$ , FID1% , FILE.NAME$ , , , ) IF STAT% AND SS$_NORMAL = 0% THEN E$ = FNVMSERR$( STAT% ) PRINT #KB%, "Unable to get filename for:"; FID1%; FID2%; FID3% PRINT #KB%, E$ GOTO 4900 END IF GOTO 1100 IF FILE.NAME$ = "" ! No filename, skip F.CNT% = F.CNT% + 1% ! Add file hdr rec F.IDX% = F.CNT% FILE.HDR(F.IDX%)::FILE.ID1% = FID1% FILE.HDR(F.IDX%)::FILE.ID2% = FID2% FILE.HDR(F.IDX%)::FILE.ID3% = FID3% FILE.HDR(F.IDX%)::FILE.NAME$ = FILE.NAME$ FILE.HDR(F.IDX%)::DEV$ = DEV$ FILE.HDR(F.IDX%)::PTR% = 0% File_Hdr_Found: ! Add 'OPEN' record O.CNT% = O.CNT% + 1% FILE.OPN(O.CNT%)::LINK% = 0% FILE.OPN(O.CNT%)::PID% = PID% FILE.OPN(O.CNT%)::LOCK.ID% = LOCK.ID% FILE.OPN(O.CNT%)::PTR% = 0% FILE.OPN(O.CNT%)::FILE.PTR% = F.IDX% STAT% = LIB$GETJPI( JPI$_PRCNAM , PID% , , , Z$ , ) IF STAT% AND SS$_NORMAL = 0% ! Get process name THEN E$ = FNVMSERR$( STAT% ) PRINT #KB%, "Unable to get process name for:"; PID% PRINT #KB%, E$ GOTO 4900 END IF FILE.OPN(O.CNT%)::PROC.NAME$ = Z$ STAT% = LIB$GETJPI( JPI$_IMAGNAME , PID% , , , Z$ , ) IF STAT% AND SS$_NORMAL = 0% ! Get image name THEN E$ = FNVMSERR$( STAT% ) PRINT #KB%, "Unable to get image name for:"; PID% PRINT #KB%, E$ GOTO 4900 END IF FILE.OPN(O.CNT%)::IMAGE.NAME$ = Z$ STAT% = LIB$GETJPI( JPI$_USERNAME , PID% , , , Z$ , ) IF STAT% AND SS$_NORMAL = 0% ! Get user name THEN E$ = FNVMSERR$( STAT% ) PRINT #KB%, "Unable to get user name for:"; PID% PRINT #KB%, E$ GOTO 4900 END IF FILE.OPN(O.CNT%)::USER.NAME$ = Z$ SELECT LOCK.STATE::QUEUE% ! Set lock state CASE = LKI$C_GRANTED FILE.OPN(O.CNT%)::STATE$ = "G" CASE = LKI$C_CONVERT FILE.OPN(O.CNT%)::STATE$ = "C" CASE = LKI$C_WAITING FILE.OPN(O.CNT%)::STATE$ = "W" END SELECT IF FILE.HDR(F.IDX%)::PTR% = 0% ! If first 'open' THEN FILE.HDR(F.IDX%)::PTR% = O.CNT% ! then begin 'list' GOTO 1100 END IF LINK% = FILE.HDR(F.IDX%)::PTR% ! Start with pointer WHILE LINK% > 0% ! Scan thru 'list' IDX% = LINK% ! Remember curr open LINK% = FILE.OPN(IDX%)::LINK% ! Get link to next open NEXT FILE.OPN(IDX%)::LINK% = O.CNT% ! @ EOL connect new open GOTO 1100 1200 !************************************************** ! Scan Lock Database Again for Record Locks !************************************************** CONTEXT% = 0% ! Lock ID context 1210 STAT% = SYS$CMEXEC( LOC(SYS$GETLKIW) BY VALUE , LKI_NUM_ARG% ) IF ( STAT% AND SS$_NORMAL ) = 0% THEN GOTO 1300 IF STAT% = SS$_NOMORELOCK E$ = FNVMSERR$( STAT% ) PRINT #KB%, E$ PRINT #KB%, STAT%, IOSB% GOTO 4900 END IF FOR IDX% = 1% TO O.CNT% ! Find parent lock GOTO Parent_Found IF FILE.OPN(IDX%)::LOCK.ID% = PARENT.ID% NEXT IDX% GOTO 1210 Parent_Found: RETDAT% = RETDAT%(0%) FID$ = RESNAM.BUFF$ SELECT RETLEN% CASE = 4% BKT% = RECNUM% REC% = 0% CASE = 8% BKT% = BKTNUM% REC% = RECNUM% END SELECT L.CNT% = L.CNT% + 1% ! Add new lock record LOCK.DTL(L.CNT%)::LINK% = 0% LOCK.DTL(L.CNT%)::OPEN.PTR% = IDX% LOCK.DTL(L.CNT%)::LOCK.ID% = LOCK.ID% LOCK.DTL(L.CNT%)::PARENT.ID% = PARENT.ID% LOCK.DTL(L.CNT%)::REC% = REC% LOCK.DTL(L.CNT%)::BKT% = BKT% SELECT LOCK.STATE::REQUEST% ! Set lock state req CASE = LCKI$K_NLMODE LOCK.DTL(L.CNT%)::STATE.REQ$ = "NL" CASE = LCK$K_CRMODE LOCK.DTL(L.CNT%)::STATE.REQ$ = "CR" CASE = LCK$K_CWMODE LOCK.DTL(L.CNT%)::STATE.REQ$ = "CW" CASE = LCK$K_PRMODE LOCK.DTL(L.CNT%)::STATE.REQ$ = "PR" CASE = LCK$K_PWMODE LOCK.DTL(L.CNT%)::STATE.REQ$ = "PW" CASE = LCK$K_EXMODE LOCK.DTL(L.CNT%)::STATE.REQ$ = "EX" END SELECT SELECT LOCK.STATE::GRANT% ! Set lock state req CASE = LCK$K_NLMODE LOCK.DTL(L.CNT%)::STATE.GRANT$ = "NL" CASE = LCK$K_CRMODE LOCK.DTL(L.CNT%)::STATE.GRANT$ = "CR" CASE = LCK$K_CWMODE LOCK.DTL(L.CNT%)::STATE.GRANT$ = "CW" CASE = LCK$K_PRMODE LOCK.DTL(L.CNT%)::STATE.GRANT$ = "PR" CASE = LCK$K_PWMODE LOCK.DTL(L.CNT%)::STATE.GRANT$ = "PW" CASE = LCK$K_EXMODE LOCK.DTL(L.CNT%)::STATE.GRANT$ = "EX" END SELECT SELECT LOCK.STATE::QUEUE% ! Set lock queue CASE = LKI$C_GRANTED LOCK.DTL(L.CNT%)::STATE.QUEUE$ = "G" CASE = LKI$C_CONVERT LOCK.DTL(L.CNT%)::STATE.QUEUE$ = "C" CASE = LKI$C_WAITING LOCK.DTL(L.CNT%)::STATE.QUEUE$ = "W" END SELECT IF FILE.OPN(IDX%)::PTR% = 0% ! Start new list THEN FILE.OPN(IDX%)::PTR% = L.CNT% ELSE LINK% = FILE.OPN(IDX%)::PTR% ! Traverse list WHILE LINK% > 0% ! Seek last in list Z% = LINK% ! Rem last lock LINK% = LOCK.DTL(Z%)::LINK% ! Get next lock NEXT LOCK.DTL(Z%)::LINK% = L.CNT% ! Add lock to EOL END IF RETDAT% = RETDAT%(5%) ! Process blocked locks SIZ% = FLAGS% AND 32767% ! Size of data / lock NUM.BLK% = RETLEN% / SIZ% ! # of blocked locks GOTO 1210 IF NUM.BLK% = 0% ! No blocked locks FOR Z% = 1% TO NUM.BLK% ! Loop thru data BLK$ = MID( BUFF$ , (Z%-1%)*SIZ%+1% , SIZ% ) B.CNT% = B.CNT% + 1% ! Add to blocked list BLK.DTL(B.CNT%)::LOCK.ID% = LOCK.ID% BLK.DTL(B.CNT%)::BLOCKER.ID% = BLK::BLOCKER.ID% NEXT Z% GOTO 1210 1300 !************************************************** ! Display the Selected Data !************************************************** GOSUB Dpy_All_Locks IF I0$="1" OR I0$="2" GOSUB Dpy_Blocked_Locks IF I0$="1" OR I0$="" GOTO 1000 !************************************************** ! Display All RMS Locks !************************************************** Dpy_All_Locks: FOR IDX% = 1% TO F.CNT% PRINT #KB% PRINT #KB%, FILE.HDR(IDX%)::FILE.NAME$ LINK% = FILE.HDR(IDX%)::PTR% WHILE LINK% > 0% PRINT #KB% PRINT #KB%, "Open on:"; TAB(10%); "PID :"; FILE.OPN(LINK%)::PID% PRINT #KB%, TAB(10%); "Process: "; FILE.OPN(LINK%)::PROC.NAME$ PRINT #KB%, TAB(10%); "User : "; FILE.OPN(LINK%)::USER.NAME$ PRINT #KB%, TAB(10%); "State : "; FILE.OPN(LINK%)::STATE$ PRINT #KB%, TAB(10%); "Image : "; FILE.OPN(LINK%)::IMAGE.NAME$ LINK2% = FILE.OPN(LINK%)::PTR% WHILE LINK2% > 0% PRINT #KB%, TAB(15%); "Lock"; TAB(20%); "Bucket: "; LOCK.DTL(LINK2%)::BKT% IF LOCK.DTL(LINK2%)::REC% <> 0% THEN PRINT #KB%, TAB(20%); "Record: "; LOCK.DTL(LINK2%)::REC% END IF PRINT #KB%, TAB(20%); "Req : "; LOCK.DTL(LINK2%)::STATE.REQ$ PRINT #KB%, TAB(20%); "Grant : "; LOCK.DTL(LINK2%)::STATE.GRANT$ PRINT #KB%, TAB(20%); "Queue : "; LOCK.DTL(LINK2%)::STATE.QUEUE$ PRINT #KB%, TAB(20%); "ID :"; LOCK.DTL(LINK2%)::LOCK.ID% LINK2% = LOCK.DTL(LINK2%)::LINK% NEXT LINK% = FILE.OPN(LINK%)::LINK% NEXT NEXT IDX% RETURN !************************************************** ! Display Blocked Locks !************************************************** Dpy_Blocked_Locks: PRINT #KB% PRINT #KB%, "There are"; B.CNT%; "blocked locks" FOR IDX% = 1% TO B.CNT% ! Loop thru blocked locks Get_Blocked: FOR LCK% = 1% TO L.CNT% ! Loop thru locks GOTO Dpy_Blocked IF BLK.DTL(IDX%)::LOCK.ID% = LOCK.DTL(LCK%)::LOCK.ID% NEXT LCK% PRINT #KB%, "Lock ID"; BLK.DTL(IDX%)::LOCK.ID%; "was not found" GOTO Get_Blocker Dpy_Blocked: OPEN.PTR% = LOCK.DTL(LCK%)::OPEN.PTR% FILE.PTR% = FILE.OPN(OPEN.PTR%)::FILE.PTR% PRINT #KB% PRINT #KB%, EDIT$(FILE.HDR(FILE.PTR%)::FILE.NAME$,128%); " bucket"; LOCK.DTL(LCK%)::BKT%; IF LOCK.DTL(LCK%)::REC% <> 0% THEN PRINT #KB%, "record"; LOCK.DTL(LCK%)::REC%; END IF PRINT #KB%, "is blocked" PRINT #KB%, TAB(5%); "PID :"; FILE.OPN(OPEN.PTR%)::PID% PRINT #KB%, TAB(5%); "Process: "; FILE.OPN(OPEN.PTR%)::PROC.NAME$ PRINT #KB%, TAB(5%); "User : "; FILE.OPN(OPEN.PTR%)::USER.NAME$ PRINT #KB%, TAB(5%); "Image : "; FILE.OPN(OPEN.PTR%)::IMAGE.NAME$ Get_Blocker: FOR LCK% = 1% TO L.CNT% ! Loop thru locks GOTO Dpy_Blocker IF BLK.DTL(IDX%)::BLOCKER.ID% = LOCK.DTL(LCK%)::LOCK.ID% NEXT LCK% PRINT #KB%, "Blocker not found for:"; BLK.DTL(IDX%)::BLOCKER.ID% ITERATE Dpy_Blocker: OPEN.PTR% = LOCK.DTL(LCK%)::OPEN.PTR% PRINT #KB% PRINT #KB%, TAB(10%); "Lock is being blocked by:" PRINT #KB%, TAB(15%); "PID :"; FILE.OPN(OPEN.PTR%)::PID% PRINT #KB%, TAB(15%); "Process: "; FILE.OPN(OPEN.PTR%)::PROC.NAME$ PRINT #KB%, TAB(15%); "User : "; FILE.OPN(OPEN.PTR%)::USER.NAME$ PRINT #KB%, TAB(15%); "Image : "; FILE.OPN(OPEN.PTR%)::IMAGE.NAME$ NEXT IDX% RETURN 4900 !************************************************************ ! Exit Point !************************************************************ PRINT #KB% PRINT #KB%, "Type to exit ...."; LINPUT #KB%, I0$ 4950 PRINT #KB% PRINT #KB%, "End of "; P8$ PRINT #KB% GOTO 32760 !************************************************************ ! Subroutines !************************************************************ 4990 !************************************************** ! Program Initialization !************************************************** P9$ = "RMS_LOCKS" ! Program name P8$ = "Watch RMS Locks V 1.00" ! Function name ON ERROR GOTO 32000 ! Enable error trapping KB% = 99% ! Keyboard channel OPEN "TT:" AS FILE KB% ! Open keyboard channel Z% = CTRLC ! ^C trap E1$ = " not a valid " ! Std error text E2$ = "Unable to " ! Std error text DI0$ = STRING$(4%,0%) ! DI zero string RETURN ! 20000 DEF* FNVMSERR$( LONG TEMP% ) ! Return VMS error text Z$ = SPACE$(80%) ! Build a buffer CALL SYS$GETMSG( TEMP% BY VALUE , , Z$ , 1% BY VALUE , ) FNVMSERR$ = EDIT$(Z$,128%) ! Get VMS message FNEND 32000 !******************** ERROR TRAPS ******************** RESUME 4950 IF ERL=1000 ! Trap ^Z 32700 PRINT ! Final error trap PRINT "Unforseen error detected in <"; P9$; ">" ON ERROR GOTO 0 32760 32766 CHAIN U1$ UNLESS U1$="" 32767 END