1 | BMXMON ; IHS/OIT/HMW - BMXNet MONITOR ; 5/9/11 10:16am
|
---|
2 | ;;4.1000;BMX;;Apr 17, 2011
|
---|
3 | ;
|
---|
4 | ; Changes for *1000 by WV/SMH (Feb 2 2011) to support GT.M
|
---|
5 | ; - XINETD entry point for GT.M
|
---|
6 | ; - Replacement of all W *-3 to W !
|
---|
7 | ; - Addition of logging capabilities for analysis using XWBDLOG
|
---|
8 | ; - In SESSRES
|
---|
9 | ; -- Broker Timeout set from Kernel System Parameter Broker Timeout Field
|
---|
10 | ; -- Process Name now gets Set to show in %SS or ZSY
|
---|
11 | ; - Error Handling does not log Network Errors to the Error Trap.
|
---|
12 | ; - Major refactoring to Writing to the TCP Network Stream.
|
---|
13 | ; --> All writes are buffered up to 32767 characters (max string on Cache)
|
---|
14 | ; --> Then sent...
|
---|
15 | ; --> See EP's WRITE and WBF
|
---|
16 | ; --> This avoids the side effects of the Nagle Algorithm on the Linux TCP Stack
|
---|
17 | ; - BMXERR renamed to BMXERROR in EP ETRAP so that it can be sent via SNDERR.
|
---|
18 | ; --> This reduces the need for custom error trap handling which is very difficult to do
|
---|
19 | ; --> in Mumps for new programmers. Mumps errors now are thrown on the client.
|
---|
20 | ;
|
---|
21 | ;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace
|
---|
22 | ;
|
---|
23 | STRT(BMXPORT,NS,IS,VB) ;EP
|
---|
24 | ;Interactive monitor start
|
---|
25 | ;Optional NS = namespace. If undefined, start in current ns
|
---|
26 | ;Optional IS = Integrated Security. Default is 1
|
---|
27 | ;Optional VB = Verbose. Default is 1
|
---|
28 | ;
|
---|
29 | N Y,BMXNS,BMXWIN
|
---|
30 | ;
|
---|
31 | ;Verbose
|
---|
32 | S BMXVB=$G(VB,1)
|
---|
33 | ;
|
---|
34 | ;Check if port already running
|
---|
35 | I '$$SEMAPHOR(BMXPORT,"LOCK") W:BMXVB "BMXNet Monitor on port "_BMXPORT_" appears to be running already.",! Q
|
---|
36 | S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
|
---|
37 | ;
|
---|
38 | D MARKER(BMXPORT,1) ;record problem marker
|
---|
39 | ; -- start the monitor
|
---|
40 | ;
|
---|
41 | ;Namespace
|
---|
42 | X ^%ZOSF("UCI")
|
---|
43 | S BMXNS=$G(NS,$P(Y,","))
|
---|
44 | ;
|
---|
45 | ;Integrated security
|
---|
46 | S BMXWIN=$G(IS,1)
|
---|
47 | ;
|
---|
48 | ;J DEBUG^%Serenji("MON^BMXMON("_BMXPORT_","_BMXNS_","_BMXWIN_")")
|
---|
49 | J MON^BMXMON(BMXPORT,BMXNS,BMXWIN)::5 I '$T W:BMXVB "Unable to run BMXNet Monitor in background.",! Q ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
50 | F %=1:1:5 D Q:%=0
|
---|
51 | . W:BMXVB "Checking if BMXNet Monitor has started...",!
|
---|
52 | . H 1
|
---|
53 | . S:'$$MARKER(BMXPORT,0) %=0
|
---|
54 | I $$MARKER(BMXPORT,0) D
|
---|
55 | . W:BMXVB !,"BMXNet Monitor could not be started!",!
|
---|
56 | . W:BMXVB "Check if port "_BMXPORT_" is busy on this CPU.",!
|
---|
57 | . D MARKER(BMXPORT,-1) ;clear marker
|
---|
58 | E W:BMXVB "BMXNet Monitor started successfully."
|
---|
59 | ;
|
---|
60 | Q
|
---|
61 | ;
|
---|
62 | RESTART ;EP
|
---|
63 | ;Stop and Start all monitors in BMX MONITOR file
|
---|
64 | ;Called by option BMX MONITOR START
|
---|
65 | ;
|
---|
66 | D STOPALL
|
---|
67 | D STRTALL
|
---|
68 | Q
|
---|
69 | ;
|
---|
70 | STRTALL ;EP
|
---|
71 | ;Start all monitors in BMX MONITOR file
|
---|
72 | ;
|
---|
73 | N BMXIEN
|
---|
74 | S BMXIEN=0 F S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN D
|
---|
75 | . S BMXNOD=$G(^BMXMON(BMXIEN,0))
|
---|
76 | . Q:'+BMXNOD
|
---|
77 | . Q:'+$P(BMXNOD,U,2)
|
---|
78 | . S BMXWIN=$P(BMXNOD,U,3)
|
---|
79 | . S BMXNS=$P(BMXNOD,U,4)
|
---|
80 | . D STRT($P(BMXNOD,U),BMXNS,BMXWIN,0)
|
---|
81 | . Q
|
---|
82 | Q
|
---|
83 | ;
|
---|
84 | STOPALL ;EP
|
---|
85 | ;Stop all monitors in BMXNET MONITOR file
|
---|
86 | ;
|
---|
87 | N BMXIEN,BMXPORT
|
---|
88 | S BMXIEN=0 F S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN D
|
---|
89 | . S BMXNOD=$G(^BMXMON(BMXIEN,0))
|
---|
90 | . Q:'+BMXNOD
|
---|
91 | . S BMXPORT=+BMXNOD
|
---|
92 | . D STOP(BMXPORT,0)
|
---|
93 | Q
|
---|
94 | ;
|
---|
95 | STOP(BMXPORT,VB) ;EP Stop monitor on BMXPORT
|
---|
96 | ;Open a channel to monitor on BMXPORT and send shutdown request
|
---|
97 | ;Optional VB = Verbose. Default is 1
|
---|
98 | ;
|
---|
99 | N IP,REF,X,DEV
|
---|
100 | S U="^" D HOME^%ZIS
|
---|
101 | ;
|
---|
102 | ;Verbose
|
---|
103 | S BMXVB=$G(VB,1)
|
---|
104 | ;
|
---|
105 | D:BMXVB EN^DDIOL("Stop BMXNet Monitor...")
|
---|
106 | X ^%ZOSF("UCI") S REF=Y
|
---|
107 | S IP="0.0.0.0" ;get server IP
|
---|
108 | IF $G(BMXPORT)="" S BMXPORT=9200
|
---|
109 | ; -- make sure the listener is running
|
---|
110 | I $$SEMAPHOR(BMXPORT,"LOCK") D Q
|
---|
111 | . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
|
---|
112 | . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
|
---|
113 | ; -- send the shutdown message to the TCP Listener process
|
---|
114 | D CALL^%ZISTCP("127.0.0.1",BMXPORT) I POP D Q
|
---|
115 | . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
|
---|
116 | . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
|
---|
117 | U IO
|
---|
118 | S X=$T(+2),X=$P(X,";;",2),X=$P(X,";")
|
---|
119 | IF X="" S X=0
|
---|
120 | S X=$C($L(X))_X
|
---|
121 | W "{BMX}00011TCPshutdown",!
|
---|
122 | R X#3:5 ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
123 | D CLOSE^%ZISTCP
|
---|
124 | I X="ack" D:BMXVB EN^DDIOL("BMXNet Monitor has been shutdown.")
|
---|
125 | E D:BMXVB EN^DDIOL("Shutdown Failed!")
|
---|
126 | ;change process name
|
---|
127 | D CHPRN($J)
|
---|
128 | Q
|
---|
129 | ;
|
---|
130 | MON(BMXPORT,NS,IS) ;Monitor port for connection & shutdown requests
|
---|
131 | ;NS = Namespace to Start monitor
|
---|
132 | ;IS = 1: Enable integrated security
|
---|
133 | ;
|
---|
134 | N BMXDEV,BMXQUIT,BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
|
---|
135 | S BMXQUIT=0,BMXDTIME=999999
|
---|
136 | ;
|
---|
137 | ;Set lock
|
---|
138 | Q:'$$SEMAPHOR(BMXPORT,"LOCK")
|
---|
139 | ;Clear problem marker
|
---|
140 | D MARKER(BMXPORT,-1)
|
---|
141 | ;H 1
|
---|
142 | ;
|
---|
143 | ;Namespace
|
---|
144 | X ^%ZOSF("UCI")
|
---|
145 | I $G(NS)="" S BMXNS=$P(Y,",")
|
---|
146 | E S BMXNS=NS
|
---|
147 | ;
|
---|
148 | ;Integrated security
|
---|
149 | S BMXWIN=$G(IS,1)
|
---|
150 | ;
|
---|
151 | ;Open server port;
|
---|
152 | S BMXDEV="|TCP|"_BMXPORT
|
---|
153 | C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
154 | O BMXDEV:(:BMXPORT:"S"):5 I '$T Q ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
155 | ;
|
---|
156 | ;S BMXDTIME(1)=BMXDTIME ; TODO: Set timeouts
|
---|
157 | S BMXDTIME(1)=.5 ;HMW 20050120
|
---|
158 | U BMXDEV
|
---|
159 | F D Q:BMXQUIT
|
---|
160 | . R BMXACT#5:BMXDTIME ;Read first 5 chars from TCP buffer, timeout=BMXDTIME ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
161 | . I BMXACT'="{BMX}" S BMXQUIT=1 Q
|
---|
162 | . R BMXACT#5:BMXDTIME ;Read next 5 chars - message length ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
163 | . S BMXLEN=+BMXACT
|
---|
164 | . R BMXACT#BMXLEN:BMXDTIME ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
165 | . I $P(BMXACT,"^")="TCPconnect" D Q
|
---|
166 | . . N BMXNSJ,X,Y,ZCHILD,%
|
---|
167 | . . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace
|
---|
168 | . . S BMXNSJ=$P(BMXNSJ,",")
|
---|
169 | . . I BMXNSJ="" S BMXNSJ=BMXNS
|
---|
170 | . . S X=BMXNSJ
|
---|
171 | . . X ^%ZOSF("UCICHECK") I Y=0 S BMXNSJ=BMXNS
|
---|
172 | . . S STATUS=$S(Y'=0:"CONNECTION OK",1:"CONNECTION FAILED, INVALID NAMESPACE") ; SET CONNECTION STATUS BASED ON NAMESPACE VALIDITY
|
---|
173 | . . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
174 | . . X ("S ZCHILD="_$C(36,90)_"CHILD")
|
---|
175 | . . I ZCHILD S ^BMXTMP("CONNECT STATUS",ZCHILD)=STATUS
|
---|
176 | . . Q
|
---|
177 | . I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",!
|
---|
178 | S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag'
|
---|
179 | Q
|
---|
180 | ;
|
---|
181 | XINETD ;PEP Directly from xinetd or inetd for GT.M
|
---|
182 | ;
|
---|
183 | N XWBDEBUG S XWBDEBUG=$$GET^XPAR("SYS","XWBDEBUG") ; 0 1 2 or 3; depending on the level of verbosity desired.
|
---|
184 | D:XWBDEBUG LOGSTART^XWBDLOG("XINETD^BMXMON") ; Start Log only if logging
|
---|
185 | ;
|
---|
186 | N BMXDEV
|
---|
187 | S U="^",$ETRAP="D ^%ZTER H" ;Set up the error trap
|
---|
188 | S $ZT="" ;Clear old trap
|
---|
189 | ;
|
---|
190 | ; GT.M specific error and device code; get remove ip address
|
---|
191 | S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")
|
---|
192 | S BMXDEV=$P X "U BMXDEV:(nowrap:nodelimiter:ioerror=""^%ZTER H"")"
|
---|
193 | S %="",@("%=$ZTRNLNM(""REMOTE_HOST"")") S:$L(%) IO("GTM-IP")=%
|
---|
194 | ;
|
---|
195 | ; Read message type
|
---|
196 | N BMXACT,BMXDTIME
|
---|
197 | S BMXDTIME=10 ; change in 2.2 instead of 9999999 - initial conn timout
|
---|
198 | R BMXACT#5:BMXDTIME
|
---|
199 | ;
|
---|
200 | D LOG("Read: "_BMXACT)
|
---|
201 | ;
|
---|
202 | Q:BMXACT'="{BMX}" ; Not a BMX message - quit.
|
---|
203 | ; Fall through to below...
|
---|
204 | GTMLNX ;EP from XWBTCPM for GT.M
|
---|
205 | ; not implementing NS and integrated authentication
|
---|
206 | ; Vars: Read timeout, msg len, msg, windows auth, Namespace
|
---|
207 | N BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
|
---|
208 | S BMXNSJ="",BMXWIN=0 ; No NS on GT.M, no Windows Authentication
|
---|
209 | S BMXDTIME(1)=.5,BMXDTIME=180 ; sign on timeout
|
---|
210 | R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
|
---|
211 | ;
|
---|
212 | D LOG("Read: "_BMXACT)
|
---|
213 | ;
|
---|
214 | S BMXLEN=+BMXACT
|
---|
215 | R BMXACT#BMXLEN:BMXDTIME
|
---|
216 | ;
|
---|
217 | D LOG("Read: "_BMXACT)
|
---|
218 | ;
|
---|
219 | I $P(BMXACT,"^")="TCPconnect" S ^BMXTMP("CONNECT STATUS",$JOB)="CONNECTION OK" G SESSRES ; <--WARNING: A GOTO
|
---|
220 | I $P(BMXACT,"^")="TCPshutdown" W "ack",! Q
|
---|
221 | QUIT ; Should't hit this quit, but just in case
|
---|
222 | ;
|
---|
223 | SESSION(BMXWIN) ;EP
|
---|
224 | ;Start session monitor
|
---|
225 | ;BMXWIN = 1: Enable integrated security
|
---|
226 | SESSRES ;EP - reentry point from trap
|
---|
227 | ; new in 2.2: Use kernel rpc timeout instead of 9999999
|
---|
228 | S BMXDTIME(1)=.5,BMXDTIME=$$BAT^XUPARAM
|
---|
229 | ;
|
---|
230 | ; Change Process Name (new in 2.2 and 2.3)
|
---|
231 | ; (GT.M doesn't store the IP in $P, but Cache does. We get GT.M
|
---|
232 | ; remote process IP from linux env var $REMOTE_HOST)
|
---|
233 | D:+$G(IO("GTM-IP")) CHPRN("BMX:ip"_$P(IO("GTM-IP"),".",3,4)) ; GT.M
|
---|
234 | D:+$P CHPRN("BMX:ip_"_$P($P,".",3,4)) ; Cache
|
---|
235 | ;
|
---|
236 | ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
237 | N $ESTACK S $ETRAP="D ETRAP^BMXMON"
|
---|
238 | S DIQUIET=1,U="^" D DT^DICRW
|
---|
239 | D UNREGALL^BMXMEVN ;Unregister all events for this session
|
---|
240 | U $P D SESSMAIN
|
---|
241 | ;Turn off the error trap for the exit
|
---|
242 | S $ETRAP=""
|
---|
243 | I $G(DUZ) D LOGOUT^XUSRB
|
---|
244 | K BMXR,BMXARY
|
---|
245 | C $P ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
246 | Q
|
---|
247 | ;
|
---|
248 | SESSMAIN ; MAIN LOOP!!!!!!
|
---|
249 | N BMXTBUF ; BMX Read Buffer
|
---|
250 | N BMXWBUF S BMXWBUF="" ; BMX Write Buffer
|
---|
251 | D SETUP^BMXMSEC(.RET) ;Setup required system vars
|
---|
252 | S U="^"
|
---|
253 | U $P
|
---|
254 | F D Q:BMXTBUF="#BYE#"
|
---|
255 | . R BMXTBUF#11:BMXDTIME IF '$T D TIMEOUT S BMXTBUF="#BYE#" Q ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
256 | . ;
|
---|
257 | . D LOG("Read: "_BMXTBUF)
|
---|
258 | . ;
|
---|
259 | . I BMXTBUF="#BYE#" QUIT ;**QUITTING HERE**
|
---|
260 | . S BMXHTYPE=$S($E(BMXTBUF,1,5)="{BMX}":1,1:0) ;check HDR
|
---|
261 | . I 'BMXHTYPE S BMXTBUF="#BYE#" D QUIT ;;***QUITTING HERE***
|
---|
262 | . . D SNDERR
|
---|
263 | . . D WRITE(BMXTBUF_$C(4)),WBF
|
---|
264 | . S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11)
|
---|
265 | . R BMXTBUF#4:BMXDTIME(1)
|
---|
266 | . ;
|
---|
267 | . D LOG("Read: "_BMXTBUF)
|
---|
268 | . ;
|
---|
269 | . S BMXTBUF=L_BMXTBUF ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
270 | . S BMXPLEN=BMXTBUF
|
---|
271 | . R BMXTBUF#BMXPLEN:BMXDTIME(1) ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
272 | . ;
|
---|
273 | . D LOG("Read: "_BMXTBUF)
|
---|
274 | . ;
|
---|
275 | . I $P(BMXTBUF,U)="TCPconnect" D QUIT ;;***QUIT HERE***
|
---|
276 | . . D SNDERR
|
---|
277 | . . D WRITE("accept"_$C(4)),WBF ;Ack
|
---|
278 | . IF BMXHTYPE D
|
---|
279 | . . K BMXR,BMXARY
|
---|
280 | . . IF BMXTBUF="#BYE#" D QUIT
|
---|
281 | . . . D SNDERR
|
---|
282 | . . . D WRITE("#BYE#"_$C(4))
|
---|
283 | . . . D WBF
|
---|
284 | . . S BMXTLEN=BMXTLEN-15
|
---|
285 | . . D CALLP^BMXMBRK(.BMXR,BMXTBUF)
|
---|
286 | . . S BMXPTYPE=$S('$D(BMXPTYPE):1,BMXPTYPE<1:1,BMXPTYPE>6:1,1:BMXPTYPE)
|
---|
287 | . IF BMXTBUF="#BYE#" Q
|
---|
288 | . U $P
|
---|
289 | . D SNDERR ;Clears SNDERR parameters
|
---|
290 | . D SND
|
---|
291 | . D WRITE($C(4)) ;send eot
|
---|
292 | . D WBF ; Flush Buffer
|
---|
293 | D UNREGALL^BMXMEVN ;Unregister all events for this session
|
---|
294 | Q ;End Of Main
|
---|
295 | ;
|
---|
296 | SNDERR ;send error information
|
---|
297 | ;BMXSEC is the security packet, BMXERROR is application packet
|
---|
298 | N X
|
---|
299 | S X=$E($G(BMXSEC),1,255)
|
---|
300 | D WRITE($C($L(X))_X)
|
---|
301 | S X=$E($G(BMXERROR),1,255)
|
---|
302 | D WRITE($C($L(X))_X)
|
---|
303 | S BMXERROR="",BMXSEC="" ;clears parameters
|
---|
304 | Q
|
---|
305 | ;
|
---|
306 | WRITE(BMXSTR) ;Write a data string to the output buffer
|
---|
307 | F Q:'$L(BMXSTR) D
|
---|
308 | . I $L(BMXWBUF)+$L(BMXSTR)>32767 D WBF ; Maximum String Length on Cache
|
---|
309 | . S BMXWBUF=BMXWBUF_$E(BMXSTR,1,255),BMXSTR=$E(BMXSTR,256,999999)
|
---|
310 | QUIT
|
---|
311 | ;
|
---|
312 | WBF ;Write Buffer to Network Stream then flush
|
---|
313 | Q:'$L(BMXWBUF)
|
---|
314 | I $G(XWBDEBUG)>2,$L(BMXWBUF) D LOG^XWBDLOG("wrt ("_$L(BMXWBUF)_"): "_BMXWBUF)
|
---|
315 | W BMXWBUF,!
|
---|
316 | S BMXWBUF=""
|
---|
317 | QUIT
|
---|
318 |
|
---|
319 | SND ; -- send data for all, Let WRITE sort it out
|
---|
320 | N I,T
|
---|
321 | ;
|
---|
322 | ; -- error or abort occurred, send null
|
---|
323 | IF $L(BMXSEC)>0 D WRITE("") QUIT
|
---|
324 | ;
|
---|
325 | ; -- single value
|
---|
326 | IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) QUIT
|
---|
327 | ;
|
---|
328 | ; -- table delimited by CR+LF
|
---|
329 | IF BMXPTYPE=2 D QUIT
|
---|
330 | . S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)),WRITE($C(13,10))
|
---|
331 | ;
|
---|
332 | ; -- word processing
|
---|
333 | IF BMXPTYPE=3 D QUIT
|
---|
334 | . S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)),WRITE($C(13,10)):BMXWRAP
|
---|
335 | ;
|
---|
336 | ; -- global array
|
---|
337 | IF BMXPTYPE=4 D QUIT
|
---|
338 | . S I=$G(BMXR) Q:I="" S T=$E(I,1,$L(I)-1) D:$D(@I)>10 WRITE(@I)
|
---|
339 | . F S I=$Q(@I) Q:I=""!(I'[T) D WRITE(@I),WRITE($C(13,10)):(BMXWRAP&(@I'=$C(13,10)))
|
---|
340 | . IF $D(@BMXR) K @BMXR
|
---|
341 | ;
|
---|
342 | ; -- global instance
|
---|
343 | IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) QUIT
|
---|
344 | ;
|
---|
345 | ; -- variable length records only good upto 255 char)
|
---|
346 | IF BMXPTYPE=6 S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE($C($L(BMXR(I)))),WRITE(BMXR(I))
|
---|
347 | QUIT
|
---|
348 | ;
|
---|
349 | TIMEOUT ;Do this on MAIN loop timeout
|
---|
350 | I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)),WBF QUIT
|
---|
351 | ;Sign-on timeout
|
---|
352 | S BMXR(0)=0,BMXR(1)=1,BMXR(2)="",BMXR(3)="TIME-OUT",BMXPTYPE=2
|
---|
353 | D SNDERR,SND,WRITE($C(4)),WBF QUIT
|
---|
354 | ;
|
---|
355 | SEMAPHOR(BMXTSKT,BMXACT) ;Lock/Unlock BMXMON semaphore
|
---|
356 | N RESULT
|
---|
357 | S U="^",RESULT=1
|
---|
358 | D GETENV^%ZOSV ;get Y=UCI^VOL^NODE^BOXLOOKUP of current system
|
---|
359 | I BMXACT="LOCK" D
|
---|
360 | . L +^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT):1
|
---|
361 | . S RESULT=$T
|
---|
362 | E L -^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT)
|
---|
363 | Q RESULT
|
---|
364 | ;
|
---|
365 | CHPRN(N) ;Change process name to N.
|
---|
366 | D SETNM^%ZOSV($E(N,1,15))
|
---|
367 | Q
|
---|
368 | ;
|
---|
369 | CKSTAT(OUT,IN) ; EP - RPC: BMX CONNECT STATUS ; CONFIRMS THAT THAT A VALID PROCESS HAS BEEN SPAWNED BY BMXMON
|
---|
370 | N PORT,STATUS,JOBID
|
---|
371 | S PORT=+$P($P,"|",3)
|
---|
372 | S JOBID=$P($J,":",1)
|
---|
373 | I $G(^BMXTMP("CONNECT STATUS",JOBID))="" HANG 1 ;Wait for job to spawn ZCHILD to be set in MON^
|
---|
374 | I $G(^BMXTMP("CONNECT STATUS",JOBID))="" HANG 1
|
---|
375 | I $G(^BMXTMP("CONNECT STATUS",JOBID))="" HANG 1
|
---|
376 | S STATUS=$G(^BMXTMP("CONNECT STATUS",JOBID))
|
---|
377 | K ^BMXTMP("CONNECT STATUS",JOBID)
|
---|
378 | I STATUS="" S STATUS="CONNECTION STATUS UNKNOWN"
|
---|
379 | S OUT=PORT_"|"_STATUS_"|"_JOBID
|
---|
380 | Q
|
---|
381 | ;
|
---|
382 | MARKER(BMXPORT,BMXMODE) ;Set/Test/Clear Problem Marker, BMXMODE=0 is a function
|
---|
383 | N IP,Y,%,REF X ^%ZOSF("UCI") S REF=Y,IP="0.0.0.0",%=0
|
---|
384 | L +^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"):1
|
---|
385 | I BMXMODE=1 S ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")=1
|
---|
386 | I BMXMODE=0 S:$D(^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")) %=1
|
---|
387 | I BMXMODE=-1 K ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
|
---|
388 | L -^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
|
---|
389 | Q:BMXMODE=0 % Q
|
---|
390 | ;
|
---|
391 | ETRAP ; -- on trapped error, send error info to client
|
---|
392 | ; Error Trap Vars: Code, Error, Last Global Reference
|
---|
393 | N BMXERC,BMXERROR,BMXLGR
|
---|
394 | ;
|
---|
395 | ;Change trapping during trap.
|
---|
396 | S $ETRAP="D ^%ZTER HALT" ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
397 | ;
|
---|
398 | ; If the error is simply that we can't write to the TCP device
|
---|
399 | ; clear and log out
|
---|
400 | ; GT.M Error Code.
|
---|
401 | I $ECODE=",Z150376602," S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
|
---|
402 | ; Cache Error Codes:
|
---|
403 | I ($EC["READ")!($EC["WRITE")!($EC["SYSTEM-F") S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
|
---|
404 | ;
|
---|
405 | ; Otherwise, log error and send to client
|
---|
406 | S BMXERC=$$EC^%ZOSV
|
---|
407 | S BMXERROR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="
|
---|
408 | S BMXLGR=$$LGR^%ZOSV_$C(4)
|
---|
409 | S BMXERROR=BMXERROR_BMXLGR
|
---|
410 | ;
|
---|
411 | D ^%ZTER ;%ZTER clears $ZE and $ECODE
|
---|
412 | ;
|
---|
413 | U $P
|
---|
414 | ;
|
---|
415 | D SNDERR,WRITE(BMXERROR),WBF
|
---|
416 | ;
|
---|
417 | S $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99," ;IHS/OIT/HMW SAC Exemption Applied For
|
---|
418 | QUIT
|
---|
419 | ;
|
---|
420 | LOG(STR) ; EP - Log stuff in Broker log only if XWBDLOG is defined
|
---|
421 | D:XWBDEBUG LOG^XWBDLOG(STR)
|
---|
422 | QUIT
|
---|
423 | ;
|
---|
424 | MENU ;EP - ENTRY ACTION FROM BMXMENU OPTION
|
---|
425 | ;
|
---|
426 | N BMX,BMXVER
|
---|
427 | ;VERSION
|
---|
428 | D
|
---|
429 | . S BMXN="BMXNET ADO.NET DATA PROVIDER" I $D(^DIC(9.4,"B",BMXN)) Q
|
---|
430 | . S BMXN="BMXNET RPMS .NET UTILITIES" I $D(^DIC(9.4,"B",BMXN)) Q
|
---|
431 | . S BMXN=""
|
---|
432 | . Q
|
---|
433 | ;
|
---|
434 | S BMXVER=""
|
---|
435 | I BMXN]"",$D(^DIC(9.4,"B",BMXN)) D
|
---|
436 | . S BMX=$O(^DIC(9.4,"B",BMXN,0))
|
---|
437 | . I $D(^DIC(9.4,BMX,"VERSION")) S BMXVER=$P(^DIC(9.4,BMX,"VERSION"),"^")
|
---|
438 | . E S BMXVER="VERSION NOT FOUND"
|
---|
439 | S:BMXVER="" BMXVER="VERSION NOT FOUND"
|
---|
440 | ;
|
---|
441 | ;LOCATION
|
---|
442 | N BMXLOC
|
---|
443 | S BMXLOC=""
|
---|
444 | I $G(DUZ(2)),$D(^DIC(4,DUZ(2),0)) S BMXLOC=$P(^DIC(4,DUZ(2),0),"^")
|
---|
445 | S:BMXLOC="" BMXLOC="LOCATION NOT FOUND"
|
---|
446 | ;
|
---|
447 | ;WRITE
|
---|
448 | W !
|
---|
449 | W !,"BMXNet Version: ",BMXVER
|
---|
450 | W !,"Location: ",BMXLOC
|
---|
451 | Q
|
---|