- 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 Feb 18, 2025@23:36:29 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