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

Last change on this file since 832 was 645, checked in by Sam Habiel, 15 years ago

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