source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXMON.m@ 1132

Last change on this file since 1132 was 1087, checked in by Sam Habiel, 14 years ago

BMX updated to v2.3. No actual routine changes from 2.21
File size: 13.0 KB
RevLine 
[1087]1BMXMON ; IHS/OIT/HMW - BMXNet MONITOR ; 7/20/2009 ; 12/7/10 3:20pm
2 ;;2.3;BMX;;Jan 25, 2011
3 ;
4 ;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace
5 ; 7/20/2009: Release of patch to support GT.M WV/SMH
6 ; Changes:
7 ; Addition of XINETD and GTMLNX entry points for support of GT.M
8 ; Changes of W *-3 (which only works on Cache) to W !
9 ; 9/7/2010: Minor bug fixes and enhancements
[931]10 ; In GTMLNX: Set process name
11 ; In GTMLNX: Time out based now on the Kernel Broker Timeout field
12 ; in kernel system parameters file
[1087]13 ; 12/12/2010: Minor bug fixes
14 ; ETRAP nows screens errors before logging them. If it is a network
15 ; write error, it's not logged to the Error Trap
16 ; Set Process Name crashed on Cache due to undefined IO("GT.M").
17 ; Now this is surrounded by $Get to prevent this error.
18 ;
19STRT(BMXPORT,NS,IS,VB) ;EP
20 ;Interactive monitor start
21 ;Optional NS = namespace. If undefined, start in current ns
22 ;Optional IS = Integrated Security. Default is 1
23 ;Optional VB = Verbose. Default is 1
24 ;
25 N Y,BMXNS,BMXWIN
26 ;
27 ;Verbose
28 S BMXVB=$G(VB,1)
29 ;
30 ;Check if port already running
31 I '$$SEMAPHOR(BMXPORT,"LOCK") W:BMXVB "BMXNet Monitor on port "_BMXPORT_" appears to be running already.",! Q
32 S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
33 ;
34 D MARKER(BMXPORT,1) ;record problem marker
35 ; -- start the monitor
36 ;
37 ;Namespace
38 X ^%ZOSF("UCI")
39 S BMXNS=$G(NS,$P(Y,","))
40 ;
41 ;Integrated security
42 S BMXWIN=$G(IS,1)
43 ;
44 ;J DEBUG^%Serenji("MON^BMXMON("_BMXPORT_","_BMXNS_","_BMXWIN_")")
45 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
46 F %=1:1:5 D Q:%=0
47 . W:BMXVB "Checking if BMXNet Monitor has started...",!
48 . H 1
49 . S:'$$MARKER(BMXPORT,0) %=0
50 I $$MARKER(BMXPORT,0) D
51 . W:BMXVB !,"BMXNet Monitor could not be started!",!
52 . W:BMXVB "Check if port "_BMXPORT_" is busy on this CPU.",!
53 . D MARKER(BMXPORT,-1) ;clear marker
54 E W:BMXVB "BMXNet Monitor started successfully."
55 ;
56 Q
57 ;
[645]58RESTART ;EP
[1087]59 ;Stop and Start all monitors in BMX MONITOR file
60 ;Called by option BMX MONITOR START
61 ;
62 D STOPALL
63 D STRTALL
64 Q
65 ;
[645]66STRTALL ;EP
[1087]67 ;Start all monitors in BMX MONITOR file
68 ;
69 N BMXIEN
70 S BMXIEN=0 F S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN D
71 . S BMXNOD=$G(^BMXMON(BMXIEN,0))
72 . Q:'+BMXNOD
73 . Q:'+$P(BMXNOD,U,2)
74 . S BMXWIN=$P(BMXNOD,U,3)
75 . S BMXNS=$P(BMXNOD,U,4)
76 . D STRT($P(BMXNOD,U),BMXNS,BMXWIN,0)
77 . Q
78 Q
79 ;
[645]80STOPALL ;EP
[1087]81 ;Stop all monitors in BMXNET MONITOR file
82 ;
83 N BMXIEN,BMXPORT
84 S BMXIEN=0 F S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN D
85 . S BMXNOD=$G(^BMXMON(BMXIEN,0))
86 . Q:'+BMXNOD
87 . S BMXPORT=+BMXNOD
88 . D STOP(BMXPORT,0)
89 Q
90 ;
91STOP(BMXPORT,VB) ;EP Stop monitor on BMXPORT
92 ;Open a channel to monitor on BMXPORT and send shutdown request
93 ;Optional VB = Verbose. Default is 1
94 ;
95 N IP,REF,X,DEV
96 S U="^" D HOME^%ZIS
97 ;
98 ;Verbose
99 S BMXVB=$G(VB,1)
100 ;
101 D:BMXVB EN^DDIOL("Stop BMXNet Monitor...")
102 X ^%ZOSF("UCI") S REF=Y
103 S IP="0.0.0.0" ;get server IP
104 IF $G(BMXPORT)="" S BMXPORT=9200
105 ; -- make sure the listener is running
106 I $$SEMAPHOR(BMXPORT,"LOCK") D Q
107 . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
108 . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
109 ; -- send the shutdown message to the TCP Listener process
110 D CALL^%ZISTCP("127.0.0.1",BMXPORT) I POP D Q
111 . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
112 . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
113 U IO
114 S X=$T(+2),X=$P(X,";;",2),X=$P(X,";")
115 IF X="" S X=0
116 S X=$C($L(X))_X
117 W "{BMX}00011TCPshutdown",!
118 R X#3:5
119 D CLOSE^%ZISTCP
120 I X="ack" D:BMXVB EN^DDIOL("BMXNet Monitor has been shutdown.")
121 E D:BMXVB EN^DDIOL("Shutdown Failed!")
122 ;change process name
123 D CHPRN($J)
124 Q
125 ;
126MON(BMXPORT,NS,IS) ;Monitor port for connection & shutdown requests
127 ;NS = Namespace to Start monitor
128 ;IS = 1: Enable integrated security
129 ;
130 N BMXDEV,BMXQUIT,BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
131 S BMXQUIT=0,BMXDTIME=999999
132 ;
133 ;Set lock
134 Q:'$$SEMAPHOR(BMXPORT,"LOCK")
135 ;Clear problem marker
136 D MARKER(BMXPORT,-1)
137 ;H 1
138 ;
139 ;Namespace
140 X ^%ZOSF("UCI")
141 S BMXNS=$G(NS,$P(Y,","))
142 ;
143 ;Integrated security
144 S BMXWIN=$G(IS,1)
145 ;
146 ;Open server port;
147 S BMXDEV="|TCP|"_BMXPORT
148 C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For
149 O BMXDEV:(:BMXPORT:"S"):5 I '$T Q ;IHS/OIT/HMW SAC Exemption Applied For
150 ;
151 ;S BMXDTIME(1)=BMXDTIME ; TODO: Set timeouts
152 S BMXDTIME(1)=.5 ;HMW 20050120
153 U BMXDEV
154 F D Q:BMXQUIT
155 . R BMXACT#5:BMXDTIME ;Read first 5 chars from TCP buffer, timeout=BMXDTIME
156 . I BMXACT'="{BMX}" S BMXQUIT=1 Q
157 . R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
158 . S BMXLEN=+BMXACT
159 . R BMXACT#BMXLEN:BMXDTIME
160 . I $P(BMXACT,"^")="TCPconnect" D Q
161 . . ;IHS/OIT/HMW added validity check for namespace
162 . . N BMXNSJ,X,Y
163 . . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace
164 . . S BMXNSJ=$P(BMXNSJ,",")
165 . . ;if passed in namespace is invalid, new job will start in listener namespace
166 . . I BMXNSJ]"" S X=BMXNSJ X ^%ZOSF("UCICHECK") S:Y=0 BMXNSJ=BMXNS
167 . . ;Job another MONITOR using concurrent connection
168 . . ;J DEBUG^%Serenji("SESSION^BMXMON("_BMXWIN_")"):(:5:BMXDEV:BMXDEV):5
169 . . ;J SESSION^BMXMON(BMXWIN)[$P(BMXNS,",")]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
170 . . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
171 . I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",!
172 S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag'
173 Q
174 ;
175XINETD ;PEP Directly from xinetd or inetd for GT.M
176 N BMXDEV
177 S U="^",$ETRAP="D ^%ZTER H" ;Set up the error trap
178 S $ZT="" ;Clear old trap
179 ; GT.M specific error and device code
180 S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")
181 S BMXDEV=$P X "U BMXDEV:(nowrap:nodelimiter:ioerror=""TRAP"")"
182 S %="",@("%=$ZTRNLNM(""REMOTE_HOST"")") S:$L(%) IO("GTM-IP")=%
183 I %["::ffff:" S IO("GTM-IP")=$P(%,"::ffff:",2) ; IPv6 support
184 ; Read message type
185 N BMXACT,BMXDTIME
186 S BMXDTIME=10 ; change in 2.2 instead of 9999999 - initial conn timout
187 R BMXACT#5:BMXDTIME
188 Q:BMXACT'="{BMX}" ; Not a BMX message - quit.
189 ; Fall through to below...
190GTMLNX ;EP from XWBTCPM for GT.M
191 ; not implementing NS and integrated authentication
192 ; Vars: Read timeout, msg len, msg, windows auth, Namespace
193 N BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
194 S BMXNSJ="",BMXWIN=0 ; No NS on GT.M, no Windows Authentication
195 S BMXDTIME(1)=.5,BMXDTIME=180 ; sign on timeout like XWBTCPM
196 R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
197 S BMXLEN=+BMXACT
198 R BMXACT#BMXLEN:BMXDTIME
199 I $P(BMXACT,"^")="TCPconnect" G SESSRES
200 I $P(BMXACT,"^")="TCPshutdown" W "ack",! Q
201 Q ; Should't hit this quit, but just in case
202 ;
[645]203SESSION(BMXWIN) ;EP
[1087]204 ;Start session monitor
205 ;BMXWIN = 1: Enable integrated security
[645]206SESSRES ;EP - reentry point from trap
[1087]207 ;IHS/OIT/HMW SAC Exemption Applied For
208 S BMXDTIME(1)=.5,BMXDTIME=$$BAT^XUPARAM ; new in 2.2: Use kernel rpc timeout instead of 9999999
209 ;
210 ; Change Process Name (new in 2.2 and 2.3)
211 ; (GT.M doesn't store the IP in $P, but Cache does. We get GT.M
212 ; remote process IP from linux env var $REMOTE_HOST)
213 D:+$G(IO("GTM-IP")) CHPRN("BMX:ip"_$P(IO("GTM-IP"),".",3,4)) ; GT.M
214 D:+$P CHPRN("BMX:ip_"_$P($P,".",3,4)) ; Cache
215 ;
216 N $ESTACK S $ETRAP="D ETRAP^BMXMON"
217 S DIQUIET=1,U="^" D DT^DICRW
218 D UNREGALL^BMXMEVN ;Unregister all events for this session
219 U $P D SESSMAIN
220 ;Turn off the error trap for the exit
221 S $ETRAP=""
222 I $G(DUZ) D LOGOUT^XUSRB
223 K BMXR,BMXARY
224 C $P ;IHS/OIT/HMW SAC Exemption Applied For
225 Q
226 ;
227SESSMAIN ;
228 N BMXTBUF
229 D SETUP^BMXMSEC(.RET) ;Setup required system vars
230 S U="^"
231 U $P
232 F D Q:BMXTBUF="#BYE#"
233 . R BMXTBUF#11:BMXDTIME IF '$T D TIMEOUT S BMXTBUF="#BYE#" Q
234 . I BMXTBUF["XQKEY" S HWMP=1
235 . I BMXTBUF="#BYE#" Q
236 . S BMXHTYPE=$S($E(BMXTBUF,1,5)="{BMX}":1,1:0) ;check HDR
237 . I 'BMXHTYPE S BMXTBUF="#BYE#" D SNDERR W BMXTBUF,$C(4),! Q
238 . S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11)
239 . R BMXTBUF#4:BMXDTIME(1) S BMXTBUF=L_BMXTBUF
240 . S BMXPLEN=BMXTBUF
241 . R BMXTBUF#BMXPLEN:BMXDTIME(1)
242 . I $P(BMXTBUF,U)="TCPconnect" D Q
243 . . D SNDERR W "accept",$C(4),! ;Ack
244 . IF BMXHTYPE D
245 . . K BMXR,BMXARY
246 . . IF BMXTBUF="#BYE#" D SNDERR W "#BYE#",$C(4),! Q
247 . . S BMXTLEN=BMXTLEN-15
248 . . D CALLP^BMXMBRK(.BMXR,BMXTBUF)
249 . . S BMXPTYPE=$S('$D(BMXPTYPE):1,BMXPTYPE<1:1,BMXPTYPE>6:1,1:BMXPTYPE)
250 . IF BMXTBUF="#BYE#" Q
251 . U $P
252 . D SNDERR ;Clears SNDERR parameters
253 . D SND
254 . D WRITE($C(4)) W ! ;send eot and flush buffer
255 D UNREGALL^BMXMEVN ;Unregister all events for this session
256 Q ;End Of Main
257 ;
258SNDERR ;send error information
259 ;BMXSEC is the security packet, BMXERROR is application packet
260 N X
261 S X=$E($G(BMXSEC),1,255)
262 W $C($L(X))_X W !
263 S X=$E($G(BMXERROR),1,255)
264 W $C($L(X))_X W !
265 S BMXERROR="",BMXSEC="" ;clears parameters
266 Q
267 ;
268WRITE(BMXSTR) ;Write a data string
269 ;
270 I $L(BMXSTR)<511 W ! W BMXSTR Q
271 ;Handle a long string
272 W ! ;Flush the buffer
273 F Q:'$L(BMXSTR) W $E(BMXSTR,1,510),! S BMXSTR=$E(BMXSTR,511,99999)
274 Q
[645]275SND ; -- send data for all, Let WRITE sort it out
[1087]276 N I,T
277 ;
278 ; -- error or abort occurred, send null
279 IF $L(BMXSEC)>0 D WRITE("") Q
280 ; -- single value
281 IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) Q
282 ; -- table delimited by CR+LF
283 IF BMXPTYPE=2 D Q
284 . S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)),WRITE($C(13,10))
285 ; -- word processing
286 IF BMXPTYPE=3 D Q
287 . S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)) D:BMXWRAP WRITE($C(13,10))
288 ; -- global array
289 IF BMXPTYPE=4 D Q
290 . S I=$G(BMXR) Q:I="" S T=$E(I,1,$L(I)-1) D:$D(@I)>10 WRITE(@I)
291 . F S I=$Q(@I) Q:I=""!(I'[T) W ! W @I W:BMXWRAP&(@I'=$C(13,10)) $C(13,10)
292 . IF $D(@BMXR) K @BMXR
293 ; -- global instance
294 IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) Q
295 ; -- variable length records only good upto 255 char)
296 IF BMXPTYPE=6 S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE($C($L(BMXR(I)))),WRITE(BMXR(I))
297 Q
298 ;
[645]299TIMEOUT ;Do this on MAIN loop timeout
[1087]300 I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)) Q
301 ;Sign-on timeout
302 S BMXR(0)=0,BMXR(1)=1,BMXR(2)="",BMXR(3)="TIME-OUT",BMXPTYPE=2
303 D SNDERR,SND,WRITE($C(4))
304 Q
305 ;
306SEMAPHOR(BMXTSKT,BMXACT) ;Lock/Unlock BMXMON semaphore
307 N RESULT
308 S U="^",RESULT=1
309 D GETENV^%ZOSV ;get Y=UCI^VOL^NODE^BOXLOOKUP of current system
310 I BMXACT="LOCK" D
311 . L +^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT):1
312 . S RESULT=$T
313 E L -^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT)
314 Q RESULT
315 ;
316CHPRN(N) ;Change process name to N.
317 D SETNM^%ZOSV($E(N,1,15))
318 Q
319 ;
[645]320MARKER(BMXPORT,BMXMODE) ;Set/Test/Clear Problem Marker, BMXMODE=0 is a function
[1087]321 N IP,Y,%,REF X ^%ZOSF("UCI") S REF=Y,IP="0.0.0.0",%=0
322 L +^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"):1
323 I BMXMODE=1 S ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")=1
324 I BMXMODE=0 S:$D(^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")) %=1
325 I BMXMODE=-1 K ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
326 L -^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
327 Q:BMXMODE=0 % Q
328 ;
329ETRAP ; -- on trapped error, send error info to client
330 ; Error Trap Vars: Code, Error, Last Global Reference
331 N BMXERC,BMXERR,BMXLGR
332 ;
333 ; Change trapping during trap.
334 N $ETRAP S $ETRAP="D ^%ZTER HALT"
335 ;
336 ; If the error is simply that we can't write to the TCP device
337 ; clear and log out
338 ; GT.M Error Code.
339 I $ECODE=",Z150376602," S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
340 ; Cache Error Codes:
341 I ($EC["READ")!($EC["WRITE")!($EC["SYSTEM-F") S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
342 ;
343 ; Otherwise, log the error and send it to the client
344 S BMXERC=$$EC^%ZOSV
345 S BMXERR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="
346 S BMXLGR=$$LGR^%ZOSV_$C(4)
347 S BMXERR=BMXERR_BMXLGR
348 ;
349 D ^%ZTER ;%ZTER clears $ZE and $ECODE
350 ;
351 U $P
352 ;
353 D SNDERR,WRITE(BMXERR) W !
354 ;
355 S $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99,"
356 QUIT
357 ;
358MENU ;EP - ENTRY ACTION FROM BMXMENU OPTION
359 ;
360 N BMX,BMXVER
361 ;VERSION
362 D
363 . S BMXN="BMXNET ADO.NET DATA PROVIDER" I $D(^DIC(9.4,"B",BMXN)) Q
364 . S BMXN="BMXNET RPMS .NET UTILITIES" I $D(^DIC(9.4,"B",BMXN)) Q
365 . S BMXN=""
366 . Q
367 ;
368 S BMXVER=""
369 I BMXN]"",$D(^DIC(9.4,"B",BMXN)) D
370 . S BMX=$O(^DIC(9.4,"B",BMXN,0))
371 . I $D(^DIC(9.4,BMX,"VERSION")) S BMXVER=$P(^DIC(9.4,BMX,"VERSION"),"^")
372 . E S BMXVER="VERSION NOT FOUND"
373 S:BMXVER="" BMXVER="VERSION NOT FOUND"
374 ;
375 ;LOCATION
376 N BMXLOC
377 S BMXLOC=""
378 I $G(DUZ(2)),$D(^DIC(4,DUZ(2),0)) S BMXLOC=$P(^DIC(4,DUZ(2),0),"^")
379 S:BMXLOC="" BMXLOC="LOCATION NOT FOUND"
380 ;
381 ;WRITE
382 W !
383 W !,"BMXNet Version: ",BMXVER
384 W !,"Location: ",BMXLOC
385 Q
Note: See TracBrowser for help on using the repository browser.