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

Last change on this file since 1724 was 1209, checked in by Sam Habiel, 13 years ago

BMXMON fix; updated all routines to v 2.31
File size: 13.5 KB
RevLine 
[1209]1BMXMON ; IHS/OIT/HMW,VW/SMH - BMXNet MONITOR ; 7/20/2009 ; 7/25/11 9:32am
2 ;;2.31;BMX;;Jul 25, 2011
[1087]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.
[1209]18 ; 6/25/2011: Fix to error trapping introduced by last patch.
19 ; Having N $ETRAP before setting $ETRAP as the backup trap causes
20 ; an infinite loop because of the restoration of the old trap
21 ; which lead it there in the first place. Removing N $ETRAP.
[1087]22 ;
23STRT(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 ;
[645]62RESTART ;EP
[1087]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 ;
[645]70STRTALL ;EP
[1087]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 ;
[645]84STOPALL ;EP
[1087]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 ;
95STOP(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
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 ;
130MON(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 S BMXNS=$G(NS,$P(Y,","))
146 ;
147 ;Integrated security
148 S BMXWIN=$G(IS,1)
149 ;
150 ;Open server port;
151 S BMXDEV="|TCP|"_BMXPORT
152 C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For
153 O BMXDEV:(:BMXPORT:"S"):5 I '$T Q ;IHS/OIT/HMW SAC Exemption Applied For
154 ;
155 ;S BMXDTIME(1)=BMXDTIME ; TODO: Set timeouts
156 S BMXDTIME(1)=.5 ;HMW 20050120
157 U BMXDEV
158 F D Q:BMXQUIT
159 . R BMXACT#5:BMXDTIME ;Read first 5 chars from TCP buffer, timeout=BMXDTIME
160 . I BMXACT'="{BMX}" S BMXQUIT=1 Q
161 . R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
162 . S BMXLEN=+BMXACT
163 . R BMXACT#BMXLEN:BMXDTIME
164 . I $P(BMXACT,"^")="TCPconnect" D Q
165 . . ;IHS/OIT/HMW added validity check for namespace
166 . . N BMXNSJ,X,Y
167 . . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace
168 . . S BMXNSJ=$P(BMXNSJ,",")
169 . . ;if passed in namespace is invalid, new job will start in listener namespace
170 . . I BMXNSJ]"" S X=BMXNSJ X ^%ZOSF("UCICHECK") S:Y=0 BMXNSJ=BMXNS
171 . . ;Job another MONITOR using concurrent connection
172 . . ;J DEBUG^%Serenji("SESSION^BMXMON("_BMXWIN_")"):(:5:BMXDEV:BMXDEV):5
173 . . ;J SESSION^BMXMON(BMXWIN)[$P(BMXNS,",")]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
174 . . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
175 . I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",!
176 S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag'
177 Q
178 ;
179XINETD ;PEP Directly from xinetd or inetd for GT.M
180 N BMXDEV
181 S U="^",$ETRAP="D ^%ZTER H" ;Set up the error trap
182 S $ZT="" ;Clear old trap
183 ; GT.M specific error and device code
184 S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")
185 S BMXDEV=$P X "U BMXDEV:(nowrap:nodelimiter:ioerror=""TRAP"")"
186 S %="",@("%=$ZTRNLNM(""REMOTE_HOST"")") S:$L(%) IO("GTM-IP")=%
187 I %["::ffff:" S IO("GTM-IP")=$P(%,"::ffff:",2) ; IPv6 support
188 ; Read message type
189 N BMXACT,BMXDTIME
190 S BMXDTIME=10 ; change in 2.2 instead of 9999999 - initial conn timout
191 R BMXACT#5:BMXDTIME
192 Q:BMXACT'="{BMX}" ; Not a BMX message - quit.
193 ; Fall through to below...
194GTMLNX ;EP from XWBTCPM for GT.M
195 ; not implementing NS and integrated authentication
196 ; Vars: Read timeout, msg len, msg, windows auth, Namespace
197 N BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
198 S BMXNSJ="",BMXWIN=0 ; No NS on GT.M, no Windows Authentication
199 S BMXDTIME(1)=.5,BMXDTIME=180 ; sign on timeout like XWBTCPM
200 R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
201 S BMXLEN=+BMXACT
202 R BMXACT#BMXLEN:BMXDTIME
203 I $P(BMXACT,"^")="TCPconnect" G SESSRES
204 I $P(BMXACT,"^")="TCPshutdown" W "ack",! Q
205 Q ; Should't hit this quit, but just in case
206 ;
[645]207SESSION(BMXWIN) ;EP
[1087]208 ;Start session monitor
209 ;BMXWIN = 1: Enable integrated security
[645]210SESSRES ;EP - reentry point from trap
[1087]211 ;IHS/OIT/HMW SAC Exemption Applied For
212 S BMXDTIME(1)=.5,BMXDTIME=$$BAT^XUPARAM ; new in 2.2: Use kernel rpc timeout instead of 9999999
213 ;
214 ; Change Process Name (new in 2.2 and 2.3)
215 ; (GT.M doesn't store the IP in $P, but Cache does. We get GT.M
216 ; remote process IP from linux env var $REMOTE_HOST)
217 D:+$G(IO("GTM-IP")) CHPRN("BMX:ip"_$P(IO("GTM-IP"),".",3,4)) ; GT.M
218 D:+$P CHPRN("BMX:ip_"_$P($P,".",3,4)) ; Cache
219 ;
220 N $ESTACK S $ETRAP="D ETRAP^BMXMON"
221 S DIQUIET=1,U="^" D DT^DICRW
222 D UNREGALL^BMXMEVN ;Unregister all events for this session
223 U $P D SESSMAIN
224 ;Turn off the error trap for the exit
225 S $ETRAP=""
226 I $G(DUZ) D LOGOUT^XUSRB
227 K BMXR,BMXARY
228 C $P ;IHS/OIT/HMW SAC Exemption Applied For
229 Q
230 ;
231SESSMAIN ;
232 N BMXTBUF
233 D SETUP^BMXMSEC(.RET) ;Setup required system vars
234 S U="^"
235 U $P
236 F D Q:BMXTBUF="#BYE#"
237 . R BMXTBUF#11:BMXDTIME IF '$T D TIMEOUT S BMXTBUF="#BYE#" Q
238 . I BMXTBUF["XQKEY" S HWMP=1
239 . I BMXTBUF="#BYE#" Q
240 . S BMXHTYPE=$S($E(BMXTBUF,1,5)="{BMX}":1,1:0) ;check HDR
241 . I 'BMXHTYPE S BMXTBUF="#BYE#" D SNDERR W BMXTBUF,$C(4),! Q
242 . S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11)
243 . R BMXTBUF#4:BMXDTIME(1) S BMXTBUF=L_BMXTBUF
244 . S BMXPLEN=BMXTBUF
245 . R BMXTBUF#BMXPLEN:BMXDTIME(1)
246 . I $P(BMXTBUF,U)="TCPconnect" D Q
247 . . D SNDERR W "accept",$C(4),! ;Ack
248 . IF BMXHTYPE D
249 . . K BMXR,BMXARY
250 . . IF BMXTBUF="#BYE#" D SNDERR W "#BYE#",$C(4),! Q
251 . . S BMXTLEN=BMXTLEN-15
252 . . D CALLP^BMXMBRK(.BMXR,BMXTBUF)
253 . . S BMXPTYPE=$S('$D(BMXPTYPE):1,BMXPTYPE<1:1,BMXPTYPE>6:1,1:BMXPTYPE)
254 . IF BMXTBUF="#BYE#" Q
255 . U $P
256 . D SNDERR ;Clears SNDERR parameters
257 . D SND
258 . D WRITE($C(4)) W ! ;send eot and flush buffer
259 D UNREGALL^BMXMEVN ;Unregister all events for this session
260 Q ;End Of Main
261 ;
262SNDERR ;send error information
263 ;BMXSEC is the security packet, BMXERROR is application packet
264 N X
265 S X=$E($G(BMXSEC),1,255)
266 W $C($L(X))_X W !
267 S X=$E($G(BMXERROR),1,255)
268 W $C($L(X))_X W !
269 S BMXERROR="",BMXSEC="" ;clears parameters
270 Q
271 ;
272WRITE(BMXSTR) ;Write a data string
273 ;
274 I $L(BMXSTR)<511 W ! W BMXSTR Q
275 ;Handle a long string
276 W ! ;Flush the buffer
277 F Q:'$L(BMXSTR) W $E(BMXSTR,1,510),! S BMXSTR=$E(BMXSTR,511,99999)
278 Q
[645]279SND ; -- send data for all, Let WRITE sort it out
[1087]280 N I,T
281 ;
282 ; -- error or abort occurred, send null
283 IF $L(BMXSEC)>0 D WRITE("") Q
284 ; -- single value
285 IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) Q
286 ; -- table delimited by CR+LF
287 IF BMXPTYPE=2 D Q
288 . S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)),WRITE($C(13,10))
289 ; -- word processing
290 IF BMXPTYPE=3 D Q
291 . S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)) D:BMXWRAP WRITE($C(13,10))
292 ; -- global array
293 IF BMXPTYPE=4 D Q
294 . S I=$G(BMXR) Q:I="" S T=$E(I,1,$L(I)-1) D:$D(@I)>10 WRITE(@I)
295 . F S I=$Q(@I) Q:I=""!(I'[T) W ! W @I W:BMXWRAP&(@I'=$C(13,10)) $C(13,10)
296 . IF $D(@BMXR) K @BMXR
297 ; -- global instance
298 IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) Q
299 ; -- variable length records only good upto 255 char)
300 IF BMXPTYPE=6 S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE($C($L(BMXR(I)))),WRITE(BMXR(I))
301 Q
302 ;
[645]303TIMEOUT ;Do this on MAIN loop timeout
[1087]304 I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)) Q
305 ;Sign-on timeout
306 S BMXR(0)=0,BMXR(1)=1,BMXR(2)="",BMXR(3)="TIME-OUT",BMXPTYPE=2
307 D SNDERR,SND,WRITE($C(4))
308 Q
309 ;
310SEMAPHOR(BMXTSKT,BMXACT) ;Lock/Unlock BMXMON semaphore
311 N RESULT
312 S U="^",RESULT=1
313 D GETENV^%ZOSV ;get Y=UCI^VOL^NODE^BOXLOOKUP of current system
314 I BMXACT="LOCK" D
315 . L +^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT):1
316 . S RESULT=$T
317 E L -^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT)
318 Q RESULT
319 ;
320CHPRN(N) ;Change process name to N.
321 D SETNM^%ZOSV($E(N,1,15))
322 Q
323 ;
[645]324MARKER(BMXPORT,BMXMODE) ;Set/Test/Clear Problem Marker, BMXMODE=0 is a function
[1087]325 N IP,Y,%,REF X ^%ZOSF("UCI") S REF=Y,IP="0.0.0.0",%=0
326 L +^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"):1
327 I BMXMODE=1 S ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")=1
328 I BMXMODE=0 S:$D(^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")) %=1
329 I BMXMODE=-1 K ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
330 L -^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
331 Q:BMXMODE=0 % Q
332 ;
333ETRAP ; -- on trapped error, send error info to client
334 ; Error Trap Vars: Code, Error, Last Global Reference
335 N BMXERC,BMXERR,BMXLGR
336 ;
337 ; Change trapping during trap.
[1209]338 ; V:2.31: Removed N $ETRAP as it caused an infinite loop
339 ; when combined with the penultimate line of this trap.
340 ; N $ETRAP causes it to revert back to the old trap which
341 ; is this EP when a quit happens to pop the $STACK.
[1087]342 ;
[1209]343 S $ETRAP="D ^%ZTER HALT"
344 ;
[1087]345 ; If the error is simply that we can't write to the TCP device
346 ; clear and log out
347 ; GT.M Error Code.
348 I $ECODE=",Z150376602," S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
349 ; Cache Error Codes:
350 I ($EC["READ")!($EC["WRITE")!($EC["SYSTEM-F") S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
351 ;
352 ; Otherwise, log the error and send it to the client
353 S BMXERC=$$EC^%ZOSV
354 S BMXERR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="
355 S BMXLGR=$$LGR^%ZOSV_$C(4)
356 S BMXERR=BMXERR_BMXLGR
357 ;
358 D ^%ZTER ;%ZTER clears $ZE and $ECODE
359 ;
360 U $P
361 ;
362 D SNDERR,WRITE(BMXERR) W !
363 ;
364 S $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99,"
365 QUIT
366 ;
367MENU ;EP - ENTRY ACTION FROM BMXMENU OPTION
368 ;
369 N BMX,BMXVER
370 ;VERSION
371 D
372 . S BMXN="BMXNET ADO.NET DATA PROVIDER" I $D(^DIC(9.4,"B",BMXN)) Q
373 . S BMXN="BMXNET RPMS .NET UTILITIES" I $D(^DIC(9.4,"B",BMXN)) Q
374 . S BMXN=""
375 . Q
376 ;
377 S BMXVER=""
378 I BMXN]"",$D(^DIC(9.4,"B",BMXN)) D
379 . S BMX=$O(^DIC(9.4,"B",BMXN,0))
380 . I $D(^DIC(9.4,BMX,"VERSION")) S BMXVER=$P(^DIC(9.4,BMX,"VERSION"),"^")
381 . E S BMXVER="VERSION NOT FOUND"
382 S:BMXVER="" BMXVER="VERSION NOT FOUND"
383 ;
384 ;LOCATION
385 N BMXLOC
386 S BMXLOC=""
387 I $G(DUZ(2)),$D(^DIC(4,DUZ(2),0)) S BMXLOC=$P(^DIC(4,DUZ(2),0),"^")
388 S:BMXLOC="" BMXLOC="LOCATION NOT FOUND"
389 ;
390 ;WRITE
391 W !
392 W !,"BMXNet Version: ",BMXVER
393 W !,"Location: ",BMXLOC
394 Q
Note: See TracBrowser for help on using the repository browser.