XULMUI1 ;IRMFO-ALB/CJM/SWO/RGG - KERNEL LOCK MANAGER ;11/29/2012
;;8.0;KERNEL;**608**;JUL 10, 1995;Build 84
;;Per VA Directive 6402, this routine should not be modified
;
; ******************************************************************
; * *
; * The Kernel Lock Manager is based on the VistA Lock Manager *
; * developed by Tommy Martin. *
; * *
; ******************************************************************
;
;
;
INIT ; Build list for displaying a single lock = XULMLOCK
N OWNER,LOCK,PID
K @VALMAR
S VALMCNT=0
D ADD("Node: "_XULMNODE),CNTRL^VALM10(VALMCNT,1,5,IOINHI,IOINORM)
D ADD("Lock: "_XULMLOCK),CNTRL^VALM10(VALMCNT,1,5,IOINHI,IOINORM)
D ADD("Full Reference: "_@LOCKS@(XULMLOCK,XULMNODE)),CNTRL^VALM10(VALMCNT,1,15,IOINHI,IOINORM)
S PID=@LOCKS@(XULMLOCK,XULMNODE,"PID")
D ADD("Process ID (decimal): "_PID),CNTRL^VALM10(VALMCNT,1,21,IOINHI,IOINORM)
D ADD("Process ID (hex): "_$$HEX^XULMU(PID)),CNTRL^VALM10(VALMCNT,1,17,IOINHI,IOINORM)
S OWNER=@LOCKS@(XULMLOCK,XULMNODE,"OWNER")
I $P(OWNER,"^",2)="{?}" S $P(OWNER,"^",2)="unavailable"
D ADD("User Name: "_$$LJ($P(OWNER,"^",2),40)_" DUZ: "_$S(+OWNER:$P(OWNER,"^"),1:"")),CNTRL^VALM10(VALMCNT,1,10,IOINHI,IOINORM),CNTRL^VALM10(VALMCNT,55,4,IOINHI,IOINORM)
D TASK(@LOCKS@(XULMLOCK,XULMNODE,"TASK"))
D TEMPLATE($G(@LOCKS@(XULMLOCK,XULMNODE,"TEMPLATE")))
D FILES(XULMLOCK)
I @IDX@("PID",PID)<2 D
.D ADD(" "),ADD("Other locks held by process: none"),CNTRL^VALM10(VALMCNT,1,28,IOINHI,IOINORM),ADD(" ")
E D
.D ADD(" "),ADD("Other locks held by process:"),CNTRL^VALM10(VALMCNT,1,28,IOINHI,IOINORM)
.S LOCK=""
.F S LOCK=$O(@IDX@("PID",PID,LOCK)) Q:LOCK="" I LOCK'=XULMLOCK D ADD(" "_LOCK)
Q
FILES(XULMLOCK) ;
N FILES,FILE,VARS,TEMPLATE
S TEMPLATE=$G(@LOCKS@(XULMLOCK,XULMNODE,"TEMPLATE"))
I 'TEMPLATE D ADD("File References: unavailable"),CNTRL^VALM10(VALMCNT,1,16,IOINHI,IOINORM) QUIT
D ADD("File References:"),CNTRL^VALM10(VALMCNT,1,16,IOINHI,IOINORM)
S FILE=0
M VARS=@LOCKS@(XULMLOCK,XULMNODE,"VARIABLES"),FILES=@LOCKS@(XULMLOCK,XULMNODE,"FILES")
D GETREFS^XULMLD(@LOCKS@(XULMLOCK,XULMNODE,"TEMPLATE"),.FILES,.VARS)
F S FILE=$O(FILES(FILE)) Q:'FILE D
.N LABEL,I
.S LABEL=$P($G(^DIC(FILE,0)),"^")
.Q:'$L(LABEL)
.S LABEL=" "_LABEL_" FILE RECORD:"
.D ADD(LABEL),CNTRL^VALM10(VALMCNT,4,($L(LABEL)-3),IOINHI,IOINORM)
.S I=0
.F S I=$O(FILES(FILE,I)) Q:'I D
..S LABEL=$P(FILES(FILE,I),":")_":"
..D ADD(" "_LABEL_" "_$P(FILES(FILE,I),":",2,5))
..D CNTRL^VALM10(VALMCNT,7,$L(LABEL),IOINHI,IOINORM)
Q
;
TEMPLATE(TEMPLATE,OFFSET) ;
S OFFSET=$$RJ("",+$G(OFFSET))
I 'TEMPLATE D ADD(OFFSET_"Lock Usage: unavailable"),CNTRL^VALM10(VALMCNT,$L(OFFSET)+1,11,IOINHI,IOINORM) Q
D ADD(OFFSET_"Lock Usage:"),CNTRL^VALM10(VALMCNT,1+$L(OFFSET),11,IOINHI,IOINORM)
N NODE,SUB,FILE
S SUB=0
F S SUB=$O(^XLM(8993,TEMPLATE,4,SUB)) Q:'SUB D ADD(OFFSET_$G(^XLM(8993,TEMPLATE,4,SUB,0)))
Q
;
TASK(TASK) ;
N NODE
I 'TASK D ADD("Task Information: unavailable"),CNTRL^VALM10(VALMCNT,1,17,IOINHI,IOINORM) Q
S NODE=$G(^%ZTSK(TASK,0))
D ADD("Task Information:"),CNTRL^VALM10(VALMCNT,1,17,IOINHI,IOINORM)
D ADD(" Task#: "_$$LJ(TASK,30)),CNTRL^VALM10(VALMCNT,5,6,IOINHI,IOINORM)
D ADD(" Started: "_$$HTE^XLFDT($P(NODE,"^",5))),CNTRL^VALM10(VALMCNT,5,8,IOINHI,IOINORM)
D ADD(" Option: "_$P(NODE,"^",9)),CNTRL^VALM10(VALMCNT,5,7,IOINHI,IOINORM)
D ADD(" Description: "_$G(^%ZTSK(TASK,.03))),CNTRL^VALM10(VALMCNT,5,13,IOINHI,IOINORM)
Q
;
KILLPROC ;
N PID,RETURN,ERROR
D FULL^VALM1
S RETURN=0
S PID=$G(@LOCKS@(XULMLOCK,XULMNODE,"PID"))
I PID=$J D PAUSE^XULMU("You cannot kill your own process!") Q
I $G(@LOCKS@(XULMLOCK,XULMNODE,"SYSTEM")) W !,"You selected a system lock! Releasing a systems lock can have a",!,"widespread affect!"
I '$$ASKYESNO^XULMU("Are you sure you want to terminate this process","NO") S VALMBCK="R" Q
;
;
S XUPARMS("KILL")=1
I $$SAMENODE^XULMU(XULMNODE) D
.S RETURN=$$KILLPROC^XULMRPC(.RETURN,PID)
E D
.N $ETRAP,$ESTACK S $ETRAP="G ERROR2^XULM"
.N IP,PORT
.S IP=$G(XUPARMS("NODES",XULMNODE,"IP ADDRESS"))
.S PORT=$G(XUPARMS("NODES",XULMNODE,"PORT"))
.S RETURN=0
.I (IP="")!(PORT="") D Q
..S RETURN=-1
..W !,"Unable to execute the KILL RPC!"
..W !,"The XULM LOCK MANAGER PARAMETERS file is missing the IP address/port"
..D PAUSE^XULMU("for "_XULMNODE_".")
.S RETURN=$$KILLRPC^XULM(XUPARMS("NODES",XULMNODE,"IP ADDRESS"),XUPARMS("NODES",XULMNODE,"PORT"),XUPARMS("LOGIN"),PID,.ERROR)
;
S VALMBCK="Q"
I RETURN>0 D
.;clean task from TaskMan
.K:@LOCKS@(XULMLOCK,XULMNODE,"TASK") ^%ZTSCH("TASK",@LOCKS@(XULMLOCK,XULMNODE,"TASK"))
.;
.;log the process termination event
.N LOG,DATA
.S DATA(.01)=$$NOW^XLFDT,DATA(.02)=$G(DUZ)
.S LOG=$$ADD^XULMU(8993.2,,.DATA) I LOG M ^XLM(8993.2,LOG,1)=@VALMAR
.;
.;check that the lock really is gone
.L +@XULMLOCK:2
.I $T D
..L -@XULMLOCK
..I $$ASKYESNO^XULMU("Process TERMINATED! Do you want to quit Lock Manager","YES") S XULMEXIT=1
.E D
..S XUPARMS("KILL")=0
..W !,"The RPC to terminate the process was executed."
..D PAUSE^XULMU("However, it appears there may still be a lock blocking access.")
.;
I RETURN=0 D
.L +@XULMLOCK:0
.I $T D
..L -@XULMLOCK
..I $$ASKYESNO^XULMU("The lock was released! Do you want to quit Lock Manager","YES") S XULMEXIT=1
.E D
..N CNT
..S VALMBCK="R"
..S XUPARMS("KILL")=0
..I $D(ERROR) W !,ERROR,!,$G(ERROR(1))
..W !,"The RPC to terminate the process was called, but its return value"
..D PAUSE^XULMU("indicates failure!")
Q
;
;
HELP ; -- help code
N COUNT,LINE
D CLEAR^VALM1
F COUNT=1:1:24 S LINE=$P($T(HELPTEXT+COUNT),";;",2) Q:LINE="END" W !,LINE
D PAUSE^XULMU
D RE^VALM4
Q
;
EXIT ; -- exit code
S VALMBCK="R"
Q
ADD(LINE) ;
S @VALMAR@($$I,0)=LINE
S:$G(XUENTRY) @VALMAR@("IDX1",VALMCNT)=XUENTRY
Q
;
LJ(STRING,LEN) ;
Q $$LJ^XLFSTR(STRING,LEN)
RJ(STRING,LEN) ;
Q $$RJ^XLFSTR(STRING,LEN)
;
I() ;
S VALMCNT=VALMCNT+1
Q VALMCNT
;
;
HELPTEXT ;
;; ** USE EXTREME CAUTION **
;;
;;You can terminate a process and release all of its locks by selecting the
;;KILL action. Do NOT do so unless you are sure that the process is not for
;;an active user.
;;
;;Additionally, you need to exercise extreme caution if terminating a
;;system process, such as MailMan or TaskManager, because doing so could
;;impact multiple users.
;;
;;If you do terminate the process, an entry will be made in the
;;XULM LOCK MANAGER LOG file.
;;
HLPEND ;;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXULMUI1 6787 printed Nov 22, 2024@17:20:11 Page 2
XULMUI1 ;IRMFO-ALB/CJM/SWO/RGG - KERNEL LOCK MANAGER ;11/29/2012
+1 ;;8.0;KERNEL;**608**;JUL 10, 1995;Build 84
+2 ;;Per VA Directive 6402, this routine should not be modified
+3 ;
+4 ; ******************************************************************
+5 ; * *
+6 ; * The Kernel Lock Manager is based on the VistA Lock Manager *
+7 ; * developed by Tommy Martin. *
+8 ; * *
+9 ; ******************************************************************
+10 ;
+11 ;
+12 ;
INIT ; Build list for displaying a single lock = XULMLOCK
+1 NEW OWNER,LOCK,PID
+2 KILL @VALMAR
+3 SET VALMCNT=0
+4 DO ADD("Node: "_XULMNODE)
DO CNTRL^VALM10(VALMCNT,1,5,IOINHI,IOINORM)
+5 DO ADD("Lock: "_XULMLOCK)
DO CNTRL^VALM10(VALMCNT,1,5,IOINHI,IOINORM)
+6 DO ADD("Full Reference: "_@LOCKS@(XULMLOCK,XULMNODE))
DO CNTRL^VALM10(VALMCNT,1,15,IOINHI,IOINORM)
+7 SET PID=@LOCKS@(XULMLOCK,XULMNODE,"PID")
+8 DO ADD("Process ID (decimal): "_PID)
DO CNTRL^VALM10(VALMCNT,1,21,IOINHI,IOINORM)
+9 DO ADD("Process ID (hex): "_$$HEX^XULMU(PID))
DO CNTRL^VALM10(VALMCNT,1,17,IOINHI,IOINORM)
+10 SET OWNER=@LOCKS@(XULMLOCK,XULMNODE,"OWNER")
+11 IF $PIECE(OWNER,"^",2)="{?}"
SET $PIECE(OWNER,"^",2)="unavailable"
+12 DO ADD("User Name: "_$$LJ($PIECE(OWNER,"^",2),40)_" DUZ: "_$SELECT(+OWNER:$PIECE(OWNER,"^"),1:""))
DO CNTRL^VALM10(VALMCNT,1,10,IOINHI,IOINORM)
DO CNTRL^VALM10(VALMCNT,55,4,IOINHI,IOINORM)
+13 DO TASK(@LOCKS@(XULMLOCK,XULMNODE,"TASK"))
+14 DO TEMPLATE($GET(@LOCKS@(XULMLOCK,XULMNODE,"TEMPLATE")))
+15 DO FILES(XULMLOCK)
+16 IF @IDX@("PID",PID)<2
Begin DoDot:1
+17 DO ADD(" ")
DO ADD("Other locks held by process: none")
DO CNTRL^VALM10(VALMCNT,1,28,IOINHI,IOINORM)
DO ADD(" ")
End DoDot:1
+18 IF '$TEST
Begin DoDot:1
+19 DO ADD(" ")
DO ADD("Other locks held by process:")
DO CNTRL^VALM10(VALMCNT,1,28,IOINHI,IOINORM)
+20 SET LOCK=""
+21 FOR
SET LOCK=$ORDER(@IDX@("PID",PID,LOCK))
if LOCK=""
QUIT
IF LOCK'=XULMLOCK
DO ADD(" "_LOCK)
End DoDot:1
+22 QUIT
FILES(XULMLOCK) ;
+1 NEW FILES,FILE,VARS,TEMPLATE
+2 SET TEMPLATE=$GET(@LOCKS@(XULMLOCK,XULMNODE,"TEMPLATE"))
+3 IF 'TEMPLATE
DO ADD("File References: unavailable")
DO CNTRL^VALM10(VALMCNT,1,16,IOINHI,IOINORM)
QUIT
+4 DO ADD("File References:")
DO CNTRL^VALM10(VALMCNT,1,16,IOINHI,IOINORM)
+5 SET FILE=0
+6 MERGE VARS=@LOCKS@(XULMLOCK,XULMNODE,"VARIABLES"),FILES=@LOCKS@(XULMLOCK,XULMNODE,"FILES")
+7 DO GETREFS^XULMLD(@LOCKS@(XULMLOCK,XULMNODE,"TEMPLATE"),.FILES,.VARS)
+8 FOR
SET FILE=$ORDER(FILES(FILE))
if 'FILE
QUIT
Begin DoDot:1
+9 NEW LABEL,I
+10 SET LABEL=$PIECE($GET(^DIC(FILE,0)),"^")
+11 if '$LENGTH(LABEL)
QUIT
+12 SET LABEL=" "_LABEL_" FILE RECORD:"
+13 DO ADD(LABEL)
DO CNTRL^VALM10(VALMCNT,4,($LENGTH(LABEL)-3),IOINHI,IOINORM)
+14 SET I=0
+15 FOR
SET I=$ORDER(FILES(FILE,I))
if 'I
QUIT
Begin DoDot:2
+16 SET LABEL=$PIECE(FILES(FILE,I),":")_":"
+17 DO ADD(" "_LABEL_" "_$PIECE(FILES(FILE,I),":",2,5))
+18 DO CNTRL^VALM10(VALMCNT,7,$LENGTH(LABEL),IOINHI,IOINORM)
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
TEMPLATE(TEMPLATE,OFFSET) ;
+1 SET OFFSET=$$RJ("",+$GET(OFFSET))
+2 IF 'TEMPLATE
DO ADD(OFFSET_"Lock Usage: unavailable")
DO CNTRL^VALM10(VALMCNT,$LENGTH(OFFSET)+1,11,IOINHI,IOINORM)
QUIT
+3 DO ADD(OFFSET_"Lock Usage:")
DO CNTRL^VALM10(VALMCNT,1+$LENGTH(OFFSET),11,IOINHI,IOINORM)
+4 NEW NODE,SUB,FILE
+5 SET SUB=0
+6 FOR
SET SUB=$ORDER(^XLM(8993,TEMPLATE,4,SUB))
if 'SUB
QUIT
DO ADD(OFFSET_$GET(^XLM(8993,TEMPLATE,4,SUB,0)))
+7 QUIT
+8 ;
TASK(TASK) ;
+1 NEW NODE
+2 IF 'TASK
DO ADD("Task Information: unavailable")
DO CNTRL^VALM10(VALMCNT,1,17,IOINHI,IOINORM)
QUIT
+3 SET NODE=$GET(^%ZTSK(TASK,0))
+4 DO ADD("Task Information:")
DO CNTRL^VALM10(VALMCNT,1,17,IOINHI,IOINORM)
+5 DO ADD(" Task#: "_$$LJ(TASK,30))
DO CNTRL^VALM10(VALMCNT,5,6,IOINHI,IOINORM)
+6 DO ADD(" Started: "_$$HTE^XLFDT($PIECE(NODE,"^",5)))
DO CNTRL^VALM10(VALMCNT,5,8,IOINHI,IOINORM)
+7 DO ADD(" Option: "_$PIECE(NODE,"^",9))
DO CNTRL^VALM10(VALMCNT,5,7,IOINHI,IOINORM)
+8 DO ADD(" Description: "_$GET(^%ZTSK(TASK,.03)))
DO CNTRL^VALM10(VALMCNT,5,13,IOINHI,IOINORM)
+9 QUIT
+10 ;
KILLPROC ;
+1 NEW PID,RETURN,ERROR
+2 DO FULL^VALM1
+3 SET RETURN=0
+4 SET PID=$GET(@LOCKS@(XULMLOCK,XULMNODE,"PID"))
+5 IF PID=$JOB
DO PAUSE^XULMU("You cannot kill your own process!")
QUIT
+6 IF $GET(@LOCKS@(XULMLOCK,XULMNODE,"SYSTEM"))
WRITE !,"You selected a system lock! Releasing a systems lock can have a",!,"widespread affect!"
+7 IF '$$ASKYESNO^XULMU("Are you sure you want to terminate this process","NO")
SET VALMBCK="R"
QUIT
+8 ;
+9 ;
+10 SET XUPARMS("KILL")=1
+11 IF $$SAMENODE^XULMU(XULMNODE)
Begin DoDot:1
+12 SET RETURN=$$KILLPROC^XULMRPC(.RETURN,PID)
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 NEW $ETRAP,$ESTACK
SET $ETRAP="G ERROR2^XULM"
+15 NEW IP,PORT
+16 SET IP=$GET(XUPARMS("NODES",XULMNODE,"IP ADDRESS"))
+17 SET PORT=$GET(XUPARMS("NODES",XULMNODE,"PORT"))
+18 SET RETURN=0
+19 IF (IP="")!(PORT="")
Begin DoDot:2
+20 SET RETURN=-1
+21 WRITE !,"Unable to execute the KILL RPC!"
+22 WRITE !,"The XULM LOCK MANAGER PARAMETERS file is missing the IP address/port"
+23 DO PAUSE^XULMU("for "_XULMNODE_".")
End DoDot:2
QUIT
+24 SET RETURN=$$KILLRPC^XULM(XUPARMS("NODES",XULMNODE,"IP ADDRESS"),XUPARMS("NODES",XULMNODE,"PORT"),XUPARMS("LOGIN"),PID,.ERROR)
End DoDot:1
+25 ;
+26 SET VALMBCK="Q"
+27 IF RETURN>0
Begin DoDot:1
+28 ;clean task from TaskMan
+29 if @LOCKS@(XULMLOCK,XULMNODE,"TASK")
KILL ^%ZTSCH("TASK",@LOCKS@(XULMLOCK,XULMNODE,"TASK"))
+30 ;
+31 ;log the process termination event
+32 NEW LOG,DATA
+33 SET DATA(.01)=$$NOW^XLFDT
SET DATA(.02)=$GET(DUZ)
+34 SET LOG=$$ADD^XULMU(8993.2,,.DATA)
IF LOG
MERGE ^XLM(8993.2,LOG,1)=@VALMAR
+35 ;
+36 ;check that the lock really is gone
+37 LOCK +@XULMLOCK:2
+38 IF $TEST
Begin DoDot:2
+39 LOCK -@XULMLOCK
+40 IF $$ASKYESNO^XULMU("Process TERMINATED! Do you want to quit Lock Manager","YES")
SET XULMEXIT=1
End DoDot:2
+41 IF '$TEST
Begin DoDot:2
+42 SET XUPARMS("KILL")=0
+43 WRITE !,"The RPC to terminate the process was executed."
+44 DO PAUSE^XULMU("However, it appears there may still be a lock blocking access.")
End DoDot:2
+45 ;
End DoDot:1
+46 IF RETURN=0
Begin DoDot:1
+47 LOCK +@XULMLOCK:0
+48 IF $TEST
Begin DoDot:2
+49 LOCK -@XULMLOCK
+50 IF $$ASKYESNO^XULMU("The lock was released! Do you want to quit Lock Manager","YES")
SET XULMEXIT=1
End DoDot:2
+51 IF '$TEST
Begin DoDot:2
+52 NEW CNT
+53 SET VALMBCK="R"
+54 SET XUPARMS("KILL")=0
+55 IF $DATA(ERROR)
WRITE !,ERROR,!,$GET(ERROR(1))
+56 WRITE !,"The RPC to terminate the process was called, but its return value"
+57 DO PAUSE^XULMU("indicates failure!")
End DoDot:2
End DoDot:1
+58 QUIT
+59 ;
+60 ;
HELP ; -- help code
+1 NEW COUNT,LINE
+2 DO CLEAR^VALM1
+3 FOR COUNT=1:1:24
SET LINE=$PIECE($TEXT(HELPTEXT+COUNT),";;",2)
if LINE="END"
QUIT
WRITE !,LINE
+4 DO PAUSE^XULMU
+5 DO RE^VALM4
+6 QUIT
+7 ;
EXIT ; -- exit code
+1 SET VALMBCK="R"
+2 QUIT
ADD(LINE) ;
+1 SET @VALMAR@($$I,0)=LINE
+2 if $GET(XUENTRY)
SET @VALMAR@("IDX1",VALMCNT)=XUENTRY
+3 QUIT
+4 ;
LJ(STRING,LEN) ;
+1 QUIT $$LJ^XLFSTR(STRING,LEN)
RJ(STRING,LEN) ;
+1 QUIT $$RJ^XLFSTR(STRING,LEN)
+2 ;
I() ;
+1 SET VALMCNT=VALMCNT+1
+2 QUIT VALMCNT
+3 ;
+4 ;
HELPTEXT ;
+1 ;; ** USE EXTREME CAUTION **
+2 ;;
+3 ;;You can terminate a process and release all of its locks by selecting the
+4 ;;KILL action. Do NOT do so unless you are sure that the process is not for
+5 ;;an active user.
+6 ;;
+7 ;;Additionally, you need to exercise extreme caution if terminating a
+8 ;;system process, such as MailMan or TaskManager, because doing so could
+9 ;;impact multiple users.
+10 ;;
+11 ;;If you do terminate the process, an entry will be made in the
+12 ;;XULM LOCK MANAGER LOG file.
+13 ;;
HLPEND ;;END
