[1209] | 1 | BMXMON ; 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 | ;
|
---|
| 23 | STRT(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] | 62 | RESTART ;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] | 70 | STRTALL ;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] | 84 | STOPALL ;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 | ;
|
---|
| 95 | STOP(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 | ;
|
---|
| 130 | MON(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 | ;
|
---|
| 179 | XINETD ;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...
|
---|
| 194 | GTMLNX ;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] | 207 | SESSION(BMXWIN) ;EP
|
---|
[1087] | 208 | ;Start session monitor
|
---|
| 209 | ;BMXWIN = 1: Enable integrated security
|
---|
[645] | 210 | SESSRES ;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 | ;
|
---|
| 231 | SESSMAIN ;
|
---|
| 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 | ;
|
---|
| 262 | SNDERR ;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 | ;
|
---|
| 272 | WRITE(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] | 279 | SND ; -- 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] | 303 | TIMEOUT ;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 | ;
|
---|
| 310 | SEMAPHOR(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 | ;
|
---|
| 320 | CHPRN(N) ;Change process name to N.
|
---|
| 321 | D SETNM^%ZOSV($E(N,1,15))
|
---|
| 322 | Q
|
---|
| 323 | ;
|
---|
[645] | 324 | MARKER(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 | ;
|
---|
| 333 | ETRAP ; -- 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 | ;
|
---|
| 367 | MENU ;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
|
---|