XWBTCP ;ISF/EG,ISD/HGW - Control TCP listener ;10/22/14 11:32
;;1.1;RPC BROKER;**1,9,35,64**;Mar 28, 1997;Build 12
;Per VA Directive 6402, this routine should not be modified.
;
EN ; -- entry point for interactive use
N X1,X2,XWBTDBG,XWBIP
S XWBIP=""
S:$G(IO("IP"))]"" XWBIP=IO("IP")
W !,"Enter client address: "_XWBIP_"//" R X1:300 Q:'$T Q:X1="^"
W !," Enter client port: " R X2:300 Q:'$T Q:X2="^"
W ! S XWBTDBG=""
IF X1="" S X1=XWBIP
IF $L(X1),$L(X2) D EN^XWBTCPC(X1,X2,"","1.08")
Q
;
STATSCRN(XWBNEW) ;Port STATUS field screen
;DA: FileMan DA array. See STATCHG tag bellow for detailed descr.
;XWBCUR: Current value of STATUS field
;XWBNEW: New/requested value of STATUS field
; The domain for XWBCUR and XWBNEW is the same as for the
; ACTION variable, described at STATCHG tag bellow.
N C,XWBCUR,RESULT
S C=","
S XWBCUR=$$GET1^DIQ(8994.171,DA_C_DA(1)_C_DA(2)_C,"STATUS","I")
S RESULT=0
I XWBCUR=3,XWBNEW=4 S RESULT=1 ;if stopping a running listener
I XWBCUR=6,XWBNEW=1 S RESULT=1 ;if starting a stopped listener
; the next two cases are most usefull whenever some error occurs
; and the STATUS field is stuck in STARTING or RUNNING state
I XWBCUR=2,XWBNEW=3 S RESULT=1 ;change to RUNNING if it's starting
I XWBCUR=5,XWBNEW=6 S RESULT=1 ;change to STOPPED if it's stopping
Q RESULT
;
;
STATCHG(DA,ACTION) ;STATUS field X-ref SET logic
;DA: FileMan DA array
; DA =IEN of the port
; DA(1) =IEN of the BOX-VOLUME
; DA(2) =IEN of site/domain
;ACTION: Requested value for the STATUS field. Possible values are:
; 1 = START, 2 = STARTING, 3 = RUNNING,
; 4 = STOP, 5 = STOPPING, 6 = STOPPED
N C,ZTCPU,TYPE,XWBPORT,XWBFDA
S C=","
;
I ACTION=1!(ACTION=4) D
. S ZTCPU=$$GET1^DIQ(8994.17,DA(1)_C_DA(2)_C,"BOX-VOLUME PAIR")
. S XWBPORT=$$GET1^DIQ(8994.171,DA_C_DA(1)_C_DA(2)_C,"PORT")
. ;S TYPE=$$GET1^DIQ(8994.171,DA_C_DA(1)_C_DA(2)_C,"TYPE OF LISTENER","I")
. S TYPE=1 ; only start new-style listener, old-style listener is deprecated
. ;UCI is no longer derived from the file, but comes from current
. ;environment. The reason for that is it makes no sense to start
. ;a listener in a UCI where ^XWB can't be reached to change status.
. D GETENV^%ZOSV
. S ZTUCI=$P(Y,U),ZTIO="",ZTREQ="@",ZTDTH=$H ;run it ASAP
. I ACTION=1 D ; -- START listener
. . S ZTDESC="RPC Broker Listener START on "_ZTUCI_"-"_ZTCPU_", port "_XWBPORT
. . S ZTRTN=$S(TYPE=1:"ZISTCP^XWBTCPM1("_XWBPORT_")",1:"EN^XWBTCPL("_XWBPORT_")")
. E D ; -- STOP listener
. . S ZTDESC="RPC Broker Listener STOP on "_ZTUCI_"-"_ZTCPU_", port "_XWBPORT
. . S ZTRTN="STOP^XWBTCP("_XWBPORT_")"
. D EN^DDIOL("Task: "_ZTDESC,"","!?10") ;inform user
. D ^%ZTLOAD ; queue it
. D EN^DDIOL("has been queued as task "_ZTSK,"","!?10") ;inform user
. ; -- change STATUS from START to STARTING or from STOP to STOPPING
. D FDA^DILF(8994.171,DA_C_DA(1)_C_DA(2)_C,1,"R",ACTION+1,"XWBFDA")
. D FILE^DIE("K","XWBFDA")
Q
;
;
STRT(XWBTSKT) ;start TCP Listener. Interactive entry point
N IP,REF,Y,%
S U="^" D HOME^%ZIS
W "Start TCP Listener...",!
X ^%ZOSF("UCI") S REF=Y
S IP=$$CONVERT^XLFIPV("::0") ;get server IP at some point, start with null address
IF $G(XWBTSKT)="" S XWBTSKT=9000 ;default service port is 9000
;
; -- see if 'running flag' for listener is set
I '$$SEMAPHOR^XWBTCPL(XWBTSKT,"LOCK") W "TCP Listener on port "_XWBTSKT_" appears to be running already.",! Q
S %=$$SEMAPHOR^XWBTCPL(XWBTSKT,"UNLOCK")
;
D MARKER(XWBTSKT,1) ;record problem marker
; -- start the listener
J EN^XWBTCPL(XWBTSKT)::5 ;Used in place of TaskMan, Need to start on any node.
I '$T W "Unable to run TCP Listener in background.",! Q
F %=1:1:5 D Q:%=0
. W "Checking if TCP Listener has started...",!
. H 3
. S:'$$MARKER(XWBTSKT,0) %=0
I $$MARKER(XWBTSKT,0) D
. W !,"TCP Listener could not be started!",!
. W "Check if port "_XWBTSKT_" is busy on this CPU.",!
. D MARKER(XWBTSKT,-1) ;clear marker
E W "TCP Listener started successfully."
Q
;
MARKER(PORT,MODE) ;Set/Test/Clear Problem Marker, Mode=0 is a function
N IP,Y,%,REF X ^%ZOSF("UCI") S REF=Y,IP=$$CONVERT^XLFIPV("::0"),%=0
L +^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")
I MODE=1 S ^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")=1
I MODE=0 S:$D(^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")) %=1
I MODE=-1 K ^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")
L -^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")
Q:MODE=0 % Q
;
STRTALL ;XWB LISTENER STARTER option entry point
;here all listener entries in RPC Broker Site Parameters file that
;have CONTROLLED BY LISTENER STARTER set to 1/Yes will be started.
N E,LSTN,LSTNID,LSTNIENS,PORTID,XWBSCR,XWBDA
;XWBDA: Namespaced FileMan DA array
; XWBDA =IEN of the port
; XWBDA(1) =IEN of the BOX-VOLUME
; XWBDA(2) =IEN of site/domain
S E=""
S XWBDA(2)=1 ;hard set IEN of site/domain
; -- screen out RUNNING (STATUS=3) listeners and those that aren't controlled by XWB LISTENER STARTER option.
S XWBSCR="I $P(^(0),U,2)'=3,$P(^(0),U,4)"
; -- get top level listners box-volume
D LIST^DIC(8994.17,",1,",E,E,E,E,E,E,E,E,$NA(LSTN("LSTNR")))
S LSTNID=""
F S LSTNID=$O(LSTN("LSTNR","DILIST",1,LSTNID)) Q:LSTNID="" D
. S XWBDA(1)=LSTN("LSTNR","DILIST",2,LSTNID) ;IEN of each listener
. S LSTNIENS=","_XWBDA(1)_","_XWBDA(2)_","
. D LIST^DIC(8994.171,LSTNIENS,E,"P",E,E,E,E,XWBSCR,E,$NA(LSTN("PORT")))
. S PORTID=0
. F S PORTID=$O(LSTN("PORT","DILIST",PORTID)) Q:PORTID="" D
. . S XWBDA=$P(LSTN("PORT","DILIST",PORTID,0),U,1)
. . D STATCHG(.XWBDA,1) ;use STATUS field X-ref SET logic to queue up start of a listener
Q
;
STOPALL ;XWB LISTENER STOP ALL entry point
;here all listener entries in RPC Broker Site Parameters file that
;have CONTROLLED BY LISTENER STARTER set to 1/Yes will be stopped.
N E,LSTN,LSTNID,LSTNIENS,PORTID,XWBSCR,XWBDA
;XWBDA: Namespaced FileMan DA array
; XWBDA =IEN of the port
; XWBDA(1) =IEN of the BOX-VOLUME
; XWBDA(2) =IEN of site/domain
S E=""
S XWBDA(2)=1 ;hard set IEN of site/domain
; -- screen out STOPPED (STATUS=3) listeners and those that aren't controlled by XWB LISTENER STARTER option.
S XWBSCR="I $P(^(0),U,2)'=6,$P(^(0),U,4)"
; -- get top level listners box-volume
D LIST^DIC(8994.17,",1,",E,E,E,E,E,E,E,E,$NA(LSTN("LSTNR")))
S LSTNID=""
F S LSTNID=$O(LSTN("LSTNR","DILIST",1,LSTNID)) Q:LSTNID="" D
. S XWBDA(1)=LSTN("LSTNR","DILIST",2,LSTNID) ;IEN of each listener
. S LSTNIENS=","_XWBDA(1)_","_XWBDA(2)_","
. D LIST^DIC(8994.171,LSTNIENS,E,"P",E,E,E,E,XWBSCR,E,$NA(LSTN("PORT")))
. S PORTID=0
. F S PORTID=$O(LSTN("PORT","DILIST",PORTID)) Q:PORTID="" D
. . S XWBDA=$P(LSTN("PORT","DILIST",PORTID,0),U,1)
. . D STATCHG(.XWBDA,4) ;use STATUS field X-ref SET logic to queue up stop of a listener
Q
;
RESTART ;Stop and then Start all listeners.
D STOPALL H 15 D STRTALL
Q
;
STOP(XWBTSKT) ;stop TCP Listener. Interactive and TaskMan entry point
N IP,REF,X,DEV,XWBOS,XWBIP,XWBENV
S U="^" D HOME^%ZIS,GETENV^%ZOSV S XWBENV=Y
D EN^DDIOL("Stop TCP Listener...")
X ^%ZOSF("UCI") S REF=Y
S IP=$$CONVERT^XLFIPV("::0") ;get server IP, start with null address
IF $G(XWBTSKT)="" S XWBTSKT=9000 ;default service port is 9000
;
S XWBOS=$S(^%ZOSF("OS")["DSM":"DSM",^("OS")["MSM":"MSM",^("OS")["OpenM":"OpenM",1:"") ;RWF
;
; -- make sure the listener is running
I $$SEMAPHOR^XWBTCPL(XWBTSKT,"LOCK") D Q
. S %=$$SEMAPHOR^XWBTCPL(XWBTSKT,"UNLOCK")
. D EN^DDIOL("TCP Listener does not appear to be running.")
;
S X=$$NODE^XWBTCPM1(XWBTSKT) ;Get node
I $P(X,"^",3)=1 D Q
. D EN^DDIOL("New listener should stop on its own")
;
; -- send the shutdown message to the TCP Listener process
; using loopback address
S XWBIP=$$CONVERT^XLFIPV("::1") ; start with loopback address
D CALL^%ZISTCP(XWBIP,XWBTSKT) I POP D Q
. S %=$$SEMAPHOR^XWBTCPL(XWBTSKT,"UNLOCK")
. D EN^DDIOL("TCP Listener does not appear to be running.")
U IO
;
S X=$T(+2),X=$P(X,";;",2),X=$P(X,";")
IF X="" S X=0
S X=$C($L(X))_X
W "{XWB}00020|"_X_"00011TCPshutdown",!
R X:5
D CLOSE^%ZISTCP
IF X["ack" D EN^DDIOL("TCP Listener has been shutdown.")
ELSE D EN^DDIOL("Shutdown Failed!")
Q
;
DEBUG ;Edit the debug parameter
W !!
D EDITPAR^XPAREDIT("XWBDEBUG")
W !!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXWBTCP 8389 printed Dec 13, 2024@02:37:27 Page 2
XWBTCP ;ISF/EG,ISD/HGW - Control TCP listener ;10/22/14 11:32
+1 ;;1.1;RPC BROKER;**1,9,35,64**;Mar 28, 1997;Build 12
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; -- entry point for interactive use
+1 NEW X1,X2,XWBTDBG,XWBIP
+2 SET XWBIP=""
+3 if $GET(IO("IP"))]""
SET XWBIP=IO("IP")
+4 WRITE !,"Enter client address: "_XWBIP_"//"
READ X1:300
if '$TEST
QUIT
if X1="^"
QUIT
+5 WRITE !," Enter client port: "
READ X2:300
if '$TEST
QUIT
if X2="^"
QUIT
+6 WRITE !
SET XWBTDBG=""
+7 IF X1=""
SET X1=XWBIP
+8 IF $LENGTH(X1)
IF $LENGTH(X2)
DO EN^XWBTCPC(X1,X2,"","1.08")
+9 QUIT
+10 ;
STATSCRN(XWBNEW) ;Port STATUS field screen
+1 ;DA: FileMan DA array. See STATCHG tag bellow for detailed descr.
+2 ;XWBCUR: Current value of STATUS field
+3 ;XWBNEW: New/requested value of STATUS field
+4 ; The domain for XWBCUR and XWBNEW is the same as for the
+5 ; ACTION variable, described at STATCHG tag bellow.
+6 NEW C,XWBCUR,RESULT
+7 SET C=","
+8 SET XWBCUR=$$GET1^DIQ(8994.171,DA_C_DA(1)_C_DA(2)_C,"STATUS","I")
+9 SET RESULT=0
+10 ;if stopping a running listener
IF XWBCUR=3
IF XWBNEW=4
SET RESULT=1
+11 ;if starting a stopped listener
IF XWBCUR=6
IF XWBNEW=1
SET RESULT=1
+12 ; the next two cases are most usefull whenever some error occurs
+13 ; and the STATUS field is stuck in STARTING or RUNNING state
+14 ;change to RUNNING if it's starting
IF XWBCUR=2
IF XWBNEW=3
SET RESULT=1
+15 ;change to STOPPED if it's stopping
IF XWBCUR=5
IF XWBNEW=6
SET RESULT=1
+16 QUIT RESULT
+17 ;
+18 ;
STATCHG(DA,ACTION) ;STATUS field X-ref SET logic
+1 ;DA: FileMan DA array
+2 ; DA =IEN of the port
+3 ; DA(1) =IEN of the BOX-VOLUME
+4 ; DA(2) =IEN of site/domain
+5 ;ACTION: Requested value for the STATUS field. Possible values are:
+6 ; 1 = START, 2 = STARTING, 3 = RUNNING,
+7 ; 4 = STOP, 5 = STOPPING, 6 = STOPPED
+8 NEW C,ZTCPU,TYPE,XWBPORT,XWBFDA
+9 SET C=","
+10 ;
+11 IF ACTION=1!(ACTION=4)
Begin DoDot:1
+12 SET ZTCPU=$$GET1^DIQ(8994.17,DA(1)_C_DA(2)_C,"BOX-VOLUME PAIR")
+13 SET XWBPORT=$$GET1^DIQ(8994.171,DA_C_DA(1)_C_DA(2)_C,"PORT")
+14 ;S TYPE=$$GET1^DIQ(8994.171,DA_C_DA(1)_C_DA(2)_C,"TYPE OF LISTENER","I")
+15 ; only start new-style listener, old-style listener is deprecated
SET TYPE=1
+16 ;UCI is no longer derived from the file, but comes from current
+17 ;environment. The reason for that is it makes no sense to start
+18 ;a listener in a UCI where ^XWB can't be reached to change status.
+19 DO GETENV^%ZOSV
+20 ;run it ASAP
SET ZTUCI=$PIECE(Y,U)
SET ZTIO=""
SET ZTREQ="@"
SET ZTDTH=$HOROLOG
+21 ; -- START listener
IF ACTION=1
Begin DoDot:2
+22 SET ZTDESC="RPC Broker Listener START on "_ZTUCI_"-"_ZTCPU_", port "_XWBPORT
+23 SET ZTRTN=$SELECT(TYPE=1:"ZISTCP^XWBTCPM1("_XWBPORT_")",1:"EN^XWBTCPL("_XWBPORT_")")
End DoDot:2
+24 ; -- STOP listener
IF '$TEST
Begin DoDot:2
+25 SET ZTDESC="RPC Broker Listener STOP on "_ZTUCI_"-"_ZTCPU_", port "_XWBPORT
+26 SET ZTRTN="STOP^XWBTCP("_XWBPORT_")"
End DoDot:2
+27 ;inform user
DO EN^DDIOL("Task: "_ZTDESC,"","!?10")
+28 ; queue it
DO ^%ZTLOAD
+29 ;inform user
DO EN^DDIOL("has been queued as task "_ZTSK,"","!?10")
+30 ; -- change STATUS from START to STARTING or from STOP to STOPPING
+31 DO FDA^DILF(8994.171,DA_C_DA(1)_C_DA(2)_C,1,"R",ACTION+1,"XWBFDA")
+32 DO FILE^DIE("K","XWBFDA")
End DoDot:1
+33 QUIT
+34 ;
+35 ;
STRT(XWBTSKT) ;start TCP Listener. Interactive entry point
+1 NEW IP,REF,Y,%
+2 SET U="^"
DO HOME^%ZIS
+3 WRITE "Start TCP Listener...",!
+4 XECUTE ^%ZOSF("UCI")
SET REF=Y
+5 ;get server IP at some point, start with null address
SET IP=$$CONVERT^XLFIPV("::0")
+6 ;default service port is 9000
IF $GET(XWBTSKT)=""
SET XWBTSKT=9000
+7 ;
+8 ; -- see if 'running flag' for listener is set
+9 IF '$$SEMAPHOR^XWBTCPL(XWBTSKT,"LOCK")
WRITE "TCP Listener on port "_XWBTSKT_" appears to be running already.",!
QUIT
+10 SET %=$$SEMAPHOR^XWBTCPL(XWBTSKT,"UNLOCK")
+11 ;
+12 ;record problem marker
DO MARKER(XWBTSKT,1)
+13 ; -- start the listener
+14 ;Used in place of TaskMan, Need to start on any node.
JOB EN^XWBTCPL(XWBTSKT)::5
+15 IF '$TEST
WRITE "Unable to run TCP Listener in background.",!
QUIT
+16 FOR %=1:1:5
Begin DoDot:1
+17 WRITE "Checking if TCP Listener has started...",!
+18 HANG 3
+19 if '$$MARKER(XWBTSKT,0)
SET %=0
End DoDot:1
if %=0
QUIT
+20 IF $$MARKER(XWBTSKT,0)
Begin DoDot:1
+21 WRITE !,"TCP Listener could not be started!",!
+22 WRITE "Check if port "_XWBTSKT_" is busy on this CPU.",!
+23 ;clear marker
DO MARKER(XWBTSKT,-1)
End DoDot:1
+24 IF '$TEST
WRITE "TCP Listener started successfully."
+25 QUIT
+26 ;
MARKER(PORT,MODE) ;Set/Test/Clear Problem Marker, Mode=0 is a function
+1 NEW IP,Y,%,REF
XECUTE ^%ZOSF("UCI")
SET REF=Y
SET IP=$$CONVERT^XLFIPV("::0")
SET %=0
+2 LOCK +^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")
+3 IF MODE=1
SET ^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")=1
+4 IF MODE=0
if $DATA(^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER"))
SET %=1
+5 IF MODE=-1
KILL ^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")
+6 LOCK -^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")
+7 if MODE=0
QUIT %
QUIT
+8 ;
STRTALL ;XWB LISTENER STARTER option entry point
+1 ;here all listener entries in RPC Broker Site Parameters file that
+2 ;have CONTROLLED BY LISTENER STARTER set to 1/Yes will be started.
+3 NEW E,LSTN,LSTNID,LSTNIENS,PORTID,XWBSCR,XWBDA
+4 ;XWBDA: Namespaced FileMan DA array
+5 ; XWBDA =IEN of the port
+6 ; XWBDA(1) =IEN of the BOX-VOLUME
+7 ; XWBDA(2) =IEN of site/domain
+8 SET E=""
+9 ;hard set IEN of site/domain
SET XWBDA(2)=1
+10 ; -- screen out RUNNING (STATUS=3) listeners and those that aren't controlled by XWB LISTENER STARTER option.
+11 SET XWBSCR="I $P(^(0),U,2)'=3,$P(^(0),U,4)"
+12 ; -- get top level listners box-volume
+13 DO LIST^DIC(8994.17,",1,",E,E,E,E,E,E,E,E,$NAME(LSTN("LSTNR")))
+14 SET LSTNID=""
+15 FOR
SET LSTNID=$ORDER(LSTN("LSTNR","DILIST",1,LSTNID))
if LSTNID=""
QUIT
Begin DoDot:1
+16 ;IEN of each listener
SET XWBDA(1)=LSTN("LSTNR","DILIST",2,LSTNID)
+17 SET LSTNIENS=","_XWBDA(1)_","_XWBDA(2)_","
+18 DO LIST^DIC(8994.171,LSTNIENS,E,"P",E,E,E,E,XWBSCR,E,$NAME(LSTN("PORT")))
+19 SET PORTID=0
+20 FOR
SET PORTID=$ORDER(LSTN("PORT","DILIST",PORTID))
if PORTID=""
QUIT
Begin DoDot:2
+21 SET XWBDA=$PIECE(LSTN("PORT","DILIST",PORTID,0),U,1)
+22 ;use STATUS field X-ref SET logic to queue up start of a listener
DO STATCHG(.XWBDA,1)
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
STOPALL ;XWB LISTENER STOP ALL entry point
+1 ;here all listener entries in RPC Broker Site Parameters file that
+2 ;have CONTROLLED BY LISTENER STARTER set to 1/Yes will be stopped.
+3 NEW E,LSTN,LSTNID,LSTNIENS,PORTID,XWBSCR,XWBDA
+4 ;XWBDA: Namespaced FileMan DA array
+5 ; XWBDA =IEN of the port
+6 ; XWBDA(1) =IEN of the BOX-VOLUME
+7 ; XWBDA(2) =IEN of site/domain
+8 SET E=""
+9 ;hard set IEN of site/domain
SET XWBDA(2)=1
+10 ; -- screen out STOPPED (STATUS=3) listeners and those that aren't controlled by XWB LISTENER STARTER option.
+11 SET XWBSCR="I $P(^(0),U,2)'=6,$P(^(0),U,4)"
+12 ; -- get top level listners box-volume
+13 DO LIST^DIC(8994.17,",1,",E,E,E,E,E,E,E,E,$NAME(LSTN("LSTNR")))
+14 SET LSTNID=""
+15 FOR
SET LSTNID=$ORDER(LSTN("LSTNR","DILIST",1,LSTNID))
if LSTNID=""
QUIT
Begin DoDot:1
+16 ;IEN of each listener
SET XWBDA(1)=LSTN("LSTNR","DILIST",2,LSTNID)
+17 SET LSTNIENS=","_XWBDA(1)_","_XWBDA(2)_","
+18 DO LIST^DIC(8994.171,LSTNIENS,E,"P",E,E,E,E,XWBSCR,E,$NAME(LSTN("PORT")))
+19 SET PORTID=0
+20 FOR
SET PORTID=$ORDER(LSTN("PORT","DILIST",PORTID))
if PORTID=""
QUIT
Begin DoDot:2
+21 SET XWBDA=$PIECE(LSTN("PORT","DILIST",PORTID,0),U,1)
+22 ;use STATUS field X-ref SET logic to queue up stop of a listener
DO STATCHG(.XWBDA,4)
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
RESTART ;Stop and then Start all listeners.
+1 DO STOPALL
HANG 15
DO STRTALL
+2 QUIT
+3 ;
STOP(XWBTSKT) ;stop TCP Listener. Interactive and TaskMan entry point
+1 NEW IP,REF,X,DEV,XWBOS,XWBIP,XWBENV
+2 SET U="^"
DO HOME^%ZIS
DO GETENV^%ZOSV
SET XWBENV=Y
+3 DO EN^DDIOL("Stop TCP Listener...")
+4 XECUTE ^%ZOSF("UCI")
SET REF=Y
+5 ;get server IP, start with null address
SET IP=$$CONVERT^XLFIPV("::0")
+6 ;default service port is 9000
IF $GET(XWBTSKT)=""
SET XWBTSKT=9000
+7 ;
+8 ;RWF
SET XWBOS=$SELECT(^%ZOSF("OS")["DSM":"DSM",^("OS")["MSM":"MSM",^("OS")["OpenM":"OpenM",1:"")
+9 ;
+10 ; -- make sure the listener is running
+11 IF $$SEMAPHOR^XWBTCPL(XWBTSKT,"LOCK")
Begin DoDot:1
+12 SET %=$$SEMAPHOR^XWBTCPL(XWBTSKT,"UNLOCK")
+13 DO EN^DDIOL("TCP Listener does not appear to be running.")
End DoDot:1
QUIT
+14 ;
+15 ;Get node
SET X=$$NODE^XWBTCPM1(XWBTSKT)
+16 IF $PIECE(X,"^",3)=1
Begin DoDot:1
+17 DO EN^DDIOL("New listener should stop on its own")
End DoDot:1
QUIT
+18 ;
+19 ; -- send the shutdown message to the TCP Listener process
+20 ; using loopback address
+21 ; start with loopback address
SET XWBIP=$$CONVERT^XLFIPV("::1")
+22 DO CALL^%ZISTCP(XWBIP,XWBTSKT)
IF POP
Begin DoDot:1
+23 SET %=$$SEMAPHOR^XWBTCPL(XWBTSKT,"UNLOCK")
+24 DO EN^DDIOL("TCP Listener does not appear to be running.")
End DoDot:1
QUIT
+25 USE IO
+26 ;
+27 SET X=$TEXT(+2)
SET X=$PIECE(X,";;",2)
SET X=$PIECE(X,";")
+28 IF X=""
SET X=0
+29 SET X=$CHAR($LENGTH(X))_X
+30 WRITE "{XWB}00020|"_X_"00011TCPshutdown",!
+31 READ X:5
+32 DO CLOSE^%ZISTCP
+33 IF X["ack"
DO EN^DDIOL("TCP Listener has been shutdown.")
+34 IF '$TEST
DO EN^DDIOL("Shutdown Failed!")
+35 QUIT
+36 ;
DEBUG ;Edit the debug parameter
+1 WRITE !!
+2 DO EDITPAR^XPAREDIT("XWBDEBUG")
+3 WRITE !!
+4 QUIT
