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