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

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

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