- 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 Feb 19, 2025@00:03:52 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