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