source: FOIAVistA/trunk/r/RPC_BROKER-XWB/XWBTCP.m@ 1582

Last change on this file since 1582 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.7 KB
Line 
1XWBTCP ;ISC-SF/EG - Control TCP listener ;07/08/2004 16:11
2 ;;1.1;RPC BROKER;**1,9,35**;Mar 28, 1997
3 ;
4EN ; -- entry point for interactive use
5 N X1,X2,XWBTDBG,XWBIP
6 S XWBIP=""
7 S:$G(IO("IP"))]"" XWBIP=IO("IP")
8 W !,"Enter client address: "_XWBIP_"//" R X1:300 Q:'$T Q:X1="^"
9 W !," Enter client port: " R X2:300 Q:'$T Q:X2="^"
10 W ! S XWBTDBG=""
11 IF X1="" S X1=XWBIP
12 IF $L(X1),$L(X2) D EN^XWBTCPC(X1,X2,"","1.08")
13 Q
14 ;
15STATSCRN(XWBNEW) ;Port STATUS field screen
16 ;DA: FileMan DA array. See STATCHG tag bellow for detailed descr.
17 ;XWBCUR: Current value of STATUS field
18 ;XWBNEW: New/requested value of STATUS field
19 ; The domain for XWBCUR and XWBNEW is the same as for the
20 ; ACTION variable, described at STATCHG tag bellow.
21 N C,XWBCUR,RESULT
22 S C=","
23 S XWBCUR=$$GET1^DIQ(8994.171,DA_C_DA(1)_C_DA(2)_C,"STATUS","I")
24 S RESULT=0
25 I XWBCUR=3,XWBNEW=4 S RESULT=1 ;if stopping a running listener
26 I XWBCUR=6,XWBNEW=1 S RESULT=1 ;if starting a stopped listener
27 ; the next two cases are most usefull whenever some error occurs
28 ; and the STATUS field is stuck in STARTING or RUNNING state
29 I XWBCUR=2,XWBNEW=3 S RESULT=1 ;change to RUNNING if it's starting
30 I XWBCUR=5,XWBNEW=6 S RESULT=1 ;change to STOPPED if it's stopping
31 Q RESULT
32 ;
33 ;
34STATCHG(DA,ACTION) ;STATUS field X-ref SET logic
35 ;DA: FileMan DA array
36 ; DA =IEN of the port
37 ; DA(1) =IEN of the BOX-VOLUME
38 ; DA(2) =IEN of site/domain
39 ;ACTION: Requested value for the STATUS field. Possible values are:
40 ; 1 = START, 2 = STARTING, 3 = RUNNING,
41 ; 4 = STOP, 5 = STOPPING, 6 = STOPPED
42 N C,ZTCPU,TYPE,XWBPORT,XWBFDA
43 S C=","
44 ;
45 I ACTION=1!(ACTION=4) D
46 . S ZTCPU=$$GET1^DIQ(8994.17,DA(1)_C_DA(2)_C,"BOX-VOLUME PAIR")
47 . S XWBPORT=$$GET1^DIQ(8994.171,DA_C_DA(1)_C_DA(2)_C,"PORT")
48 . S TYPE=$$GET1^DIQ(8994.171,DA_C_DA(1)_C_DA(2)_C,"TYPE OF LISTENER","I")
49 . ;UCI is no longer derived from the file, but comes from current
50 . ;environment. The reason for that is it makes no sense to start
51 . ;a listener in a UCI where ^XWB can't be reached to change status.
52 . D GETENV^%ZOSV
53 . S ZTUCI=$P(Y,U),ZTIO="",ZTREQ="@",ZTDTH=$H ;run it ASAP
54 . I ACTION=1 D ; -- START listener
55 . . S ZTDESC="RPC Broker Listener START on "_ZTUCI_"-"_ZTCPU_", port "_XWBPORT
56 . . S ZTRTN=$S(TYPE=1:"ZISTCP^XWBTCPM1("_XWBPORT_")",1:"EN^XWBTCPL("_XWBPORT_")")
57 . E D ; -- STOP listener
58 . . S ZTDESC="RPC Broker Listener STOP on "_ZTUCI_"-"_ZTCPU_", port "_XWBPORT
59 . . S ZTRTN="STOP^XWBTCP("_XWBPORT_")"
60 . D EN^DDIOL("Task: "_ZTDESC,"","!?10") ;inform user
61 . D ^%ZTLOAD ; queue it
62 . D EN^DDIOL("has been queued as task "_ZTSK,"","!?10") ;inform user
63 . ; -- change STATUS from START to STARTING or from STOP to STOPPING
64 . D FDA^DILF(8994.171,DA_C_DA(1)_C_DA(2)_C,1,"R",ACTION+1,"XWBFDA")
65 . D FILE^DIE("K","XWBFDA")
66 Q
67 ;
68 ;
69STRT(XWBTSKT) ;start TCP Listener. Interactive entry point
70 N IP,REF,Y,%
71 S U="^" D HOME^%ZIS
72 W "Start TCP Listener...",!
73 X ^%ZOSF("UCI") S REF=Y
74 S IP="0.0.0.0" ;get server IP at some point
75 IF $G(XWBTSKT)="" S XWBTSKT=9000 ;default service port is 9000
76 ;
77 ; -- see if 'running flag' for listener is set
78 I '$$SEMAPHOR^XWBTCPL(XWBTSKT,"LOCK") W "TCP Listener on port "_XWBTSKT_" appears to be running already.",! Q
79 S %=$$SEMAPHOR^XWBTCPL(XWBTSKT,"UNLOCK")
80 ;
81 D MARKER(XWBTSKT,1) ;record problem marker
82 ; -- start the listener
83 J EN^XWBTCPL(XWBTSKT)::5 ;Used in place of TaskMan, Need to start on any node.
84 I '$T W "Unable to run TCP Listener in background.",! Q
85 F %=1:1:5 D Q:%=0
86 . W "Checking if TCP Listener has started...",!
87 . H 3
88 . S:'$$MARKER(XWBTSKT,0) %=0
89 I $$MARKER(XWBTSKT,0) D
90 . W !,"TCP Listener could not be started!",!
91 . W "Check if port "_XWBTSKT_" is busy on this CPU.",!
92 . D MARKER(XWBTSKT,-1) ;clear marker
93 E W "TCP Listener started successfully."
94 Q
95 ;
96MARKER(PORT,MODE) ;Set/Test/Clear Problem Marker, Mode=0 is a function
97 N IP,Y,%,REF X ^%ZOSF("UCI") S REF=Y,IP="0.0.0.0",%=0
98 L +^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")
99 I MODE=1 S ^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")=1
100 I MODE=0 S:$D(^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")) %=1
101 I MODE=-1 K ^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")
102 L -^XWB(IP,REF,XWBTSKT,"PROBLEM MARKER")
103 Q:MODE=0 % Q
104 ;
105STRTALL ;XWB LISTENER STARTER option entry point
106 ;here all listener entries in RPC Broker Site Parameters file that
107 ;have CONTROLLED BY LISTENER STARTER set to 1/Yes will be started.
108 N E,LSTN,LSTNID,LSTNIENS,PORTID,XWBSCR,XWBDA
109 ;XWBDA: Namespaced FileMan DA array
110 ; XWBDA =IEN of the port
111 ; XWBDA(1) =IEN of the BOX-VOLUME
112 ; XWBDA(2) =IEN of site/domain
113 S E=""
114 S XWBDA(2)=1 ;hard set IEN of site/domain
115 ; -- screen out RUNNING (STATUS=3) listeners and those that aren't controlled by XWB LISTENER STARTER option.
116 S XWBSCR="I $P(^(0),U,2)'=3,$P(^(0),U,4)"
117 ; -- get top level listners box-volume
118 D LIST^DIC(8994.17,",1,",E,E,E,E,E,E,E,E,$NA(LSTN("LSTNR")))
119 S LSTNID=""
120 F S LSTNID=$O(LSTN("LSTNR","DILIST",1,LSTNID)) Q:LSTNID="" D
121 . S XWBDA(1)=LSTN("LSTNR","DILIST",2,LSTNID) ;IEN of each listener
122 . S LSTNIENS=","_XWBDA(1)_","_XWBDA(2)_","
123 . D LIST^DIC(8994.171,LSTNIENS,E,"P",E,E,E,E,XWBSCR,E,$NA(LSTN("PORT")))
124 . S PORTID=0
125 . F S PORTID=$O(LSTN("PORT","DILIST",PORTID)) Q:PORTID="" D
126 . . S XWBDA=$P(LSTN("PORT","DILIST",PORTID,0),U,1)
127 . . D STATCHG(.XWBDA,1) ;use STATUS field X-ref SET logic to queue up start of a listener
128 Q
129 ;
130STOPALL ;XWB LISTENER STOP ALL entry point
131 ;here all listener entries in RPC Broker Site Parameters file that
132 ;have CONTROLLED BY LISTENER STARTER set to 1/Yes will be stopped.
133 N E,LSTN,LSTNID,LSTNIENS,PORTID,XWBSCR,XWBDA
134 ;XWBDA: Namespaced FileMan DA array
135 ; XWBDA =IEN of the port
136 ; XWBDA(1) =IEN of the BOX-VOLUME
137 ; XWBDA(2) =IEN of site/domain
138 S E=""
139 S XWBDA(2)=1 ;hard set IEN of site/domain
140 ; -- screen out STOPPED (STATUS=3) listeners and those that aren't controlled by XWB LISTENER STARTER option.
141 S XWBSCR="I $P(^(0),U,2)'=6,$P(^(0),U,4)"
142 ; -- get top level listners box-volume
143 D LIST^DIC(8994.17,",1,",E,E,E,E,E,E,E,E,$NA(LSTN("LSTNR")))
144 S LSTNID=""
145 F S LSTNID=$O(LSTN("LSTNR","DILIST",1,LSTNID)) Q:LSTNID="" D
146 . S XWBDA(1)=LSTN("LSTNR","DILIST",2,LSTNID) ;IEN of each listener
147 . S LSTNIENS=","_XWBDA(1)_","_XWBDA(2)_","
148 . D LIST^DIC(8994.171,LSTNIENS,E,"P",E,E,E,E,XWBSCR,E,$NA(LSTN("PORT")))
149 . S PORTID=0
150 . F S PORTID=$O(LSTN("PORT","DILIST",PORTID)) Q:PORTID="" D
151 . . S XWBDA=$P(LSTN("PORT","DILIST",PORTID,0),U,1)
152 . . D STATCHG(.XWBDA,4) ;use STATUS field X-ref SET logic to queue up stop of a listener
153 Q
154 ;
155RESTART ;Stop and then Start all listeners.
156 D STOPALL H 15 D STRTALL
157 Q
158 ;
159STOP(XWBTSKT) ;stop TCP Listener. Interactive and TaskMan entry point
160 N IP,REF,X,DEV,XWBOS,XWBIP,XWBENV
161 S U="^" D HOME^%ZIS,GETENV^%ZOSV S XWBENV=Y
162 D EN^DDIOL("Stop TCP Listener...")
163 X ^%ZOSF("UCI") S REF=Y
164 S IP="0.0.0.0" ;get server IP
165 IF $G(XWBTSKT)="" S XWBTSKT=9000 ;default service port is 9000
166 ;
167 S XWBOS=$S(^%ZOSF("OS")["DSM":"DSM",^("OS")["MSM":"MSM",^("OS")["OpenM":"OpenM",1:"") ;RWF
168 ;
169 ; -- make sure the listener is running
170 I $$SEMAPHOR^XWBTCPL(XWBTSKT,"LOCK") D Q
171 . S %=$$SEMAPHOR^XWBTCPL(XWBTSKT,"UNLOCK")
172 . D EN^DDIOL("TCP Listener does not appear to be running.")
173 ;
174 S X=$$NODE^XWBTCPM1(XWBTSKT) ;Get node
175 I $P(X,"^",3)=1 D Q
176 . D EN^DDIOL("New listener should stop on its own")
177 ;
178 ; -- send the shutdown message to the TCP Listener process
179 ; using loopback address
180 S XWBIP="127.0.0.1"
181 D CALL^%ZISTCP("127.0.0.1",XWBTSKT) I POP D Q
182 . S %=$$SEMAPHOR^XWBTCPL(XWBTSKT,"UNLOCK")
183 . D EN^DDIOL("TCP Listener does not appear to be running.")
184 U IO
185 ;
186 S X=$T(+2),X=$P(X,";;",2),X=$P(X,";")
187 IF X="" S X=0
188 S X=$C($L(X))_X
189 W "{XWB}00020|"_X_"00011TCPshutdown",!
190 R X:5
191 D CLOSE^%ZISTCP
192 IF X["ack" D EN^DDIOL("TCP Listener has been shutdown.")
193 ELSE D EN^DDIOL("Shutdown Failed!")
194 Q
195 ;
196DEBUG ;Edit the debug parameter
197 W !!
198 D EDITPAR^XPAREDIT("XWBDEBUG")
199 W !!
200 Q
Note: See TracBrowser for help on using the repository browser.