BMXMON ; IHS/OIT/HMW - BMXNet MONITOR ; 04 Jun 2010 3:10 PM
;;4.0;BMX;**2**;OCT 27, 2011;Build 2
;
;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace
;
STRT(BMXPORT,NS,IS,VB) ;EP
;Interactive monitor start
;Optional NS = namespace. If undefined, start in current ns
;Optional IS = Integrated Security. Default is 1
;Optional VB = Verbose. Default is 1
;
N Y,BMXNS,BMXWIN
;
;Verbose
S BMXVB=$G(VB,1)
;
;Check if port already running
I '$$SEMAPHOR(BMXPORT,"LOCK") W:BMXVB "BMXNet Monitor on port "_BMXPORT_" appears to be running already.",! Q
S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
;
D MARKER(BMXPORT,1) ;record problem marker
; -- start the monitor
;
;Namespace
X ^%ZOSF("UCI")
S BMXNS=$G(NS,$P(Y,","))
;
;Integrated security
S BMXWIN=$G(IS,1)
;
;J DEBUG^%Serenji("MON^BMXMON("_BMXPORT_","_BMXNS_","_BMXWIN_")")
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
F %=1:1:5 D Q:%=0
. W:BMXVB "Checking if BMXNet Monitor has started...",!
. H 1
. S:'$$MARKER(BMXPORT,0) %=0
I $$MARKER(BMXPORT,0) D
. W:BMXVB !,"BMXNet Monitor could not be started!",!
. W:BMXVB "Check if port "_BMXPORT_" is busy on this CPU.",!
. D MARKER(BMXPORT,-1) ;clear marker
E W:BMXVB "BMXNet Monitor started successfully."
;
Q
;
RESTART ;EP
;Stop and Start all monitors in BMX MONITOR file
;Called by option BMX MONITOR START
;
D STOPALL
D STRTALL
Q
;
STRTALL ;EP
;Start all monitors in BMX MONITOR file
;
N BMXIEN
S BMXIEN=0 F S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN D
. S BMXNOD=$G(^BMXMON(BMXIEN,0))
. Q:'+BMXNOD
. Q:'+$P(BMXNOD,U,2)
. S BMXWIN=$P(BMXNOD,U,3)
. S BMXNS=$P(BMXNOD,U,4)
. D STRT($P(BMXNOD,U),BMXNS,BMXWIN,0)
. Q
Q
;
STOPALL ;EP
;Stop all monitors in BMXNET MONITOR file
;
N BMXIEN,BMXPORT
S BMXIEN=0 F S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN D
. S BMXNOD=$G(^BMXMON(BMXIEN,0))
. Q:'+BMXNOD
. S BMXPORT=+BMXNOD
. D STOP(BMXPORT,0)
Q
;
STOP(BMXPORT,VB) ;EP Stop monitor on BMXPORT
;Open a channel to monitor on BMXPORT and send shutdown request
;Optional VB = Verbose. Default is 1
;
N IP,REF,X,DEV
S U="^" D HOME^%ZIS
;
;Verbose
S BMXVB=$G(VB,1)
;
D:BMXVB EN^DDIOL("Stop BMXNet Monitor...")
X ^%ZOSF("UCI") S REF=Y
S IP="0.0.0.0" ;get server IP
IF $G(BMXPORT)="" S BMXPORT=9200
; -- make sure the listener is running
I $$SEMAPHOR(BMXPORT,"LOCK") D Q
. S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
. D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
; -- send the shutdown message to the TCP Listener process
D CALL^%ZISTCP("127.0.0.1",BMXPORT) I POP D Q
. S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
. D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
U IO
S X=$T(+2),X=$P(X,";;",2),X=$P(X,";")
IF X="" S X=0
S X=$C($L(X))_X
W "{BMX}00011TCPshutdown",!
R X#3:5 ;IHS/OIT/HMW SAC Exemption Applied For
D CLOSE^%ZISTCP
I X="ack" D:BMXVB EN^DDIOL("BMXNet Monitor has been shutdown.")
E D:BMXVB EN^DDIOL("Shutdown Failed!")
;change process name
D CHPRN($J)
Q
;
MON(BMXPORT,NS,IS) ;Monitor port for connection & shutdown requests
;NS = Namespace to Start monitor
;IS = 1: Enable integrated security
;
N BMXDEV,BMXQUIT,BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
S BMXQUIT=0,BMXDTIME=999999
;
;Set lock
Q:'$$SEMAPHOR(BMXPORT,"LOCK")
;Clear problem marker
D MARKER(BMXPORT,-1)
;H 1
;
;Namespace
X ^%ZOSF("UCI")
I $G(NS)="" S BMXNS=$P(Y,",")
E S BMXNS=NS
;
;Integrated security
S BMXWIN=$G(IS,1)
;
;Open server port;
S BMXDEV="|TCP|"_BMXPORT
RELOAD C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For ; IHS/OIT/GIS 10/4/2011
O BMXDEV:(:BMXPORT:"S"):5 I '$T Q ;IHS/OIT/HMW SAC Exemption Applied For
;
;S BMXDTIME(1)=BMXDTIME ; TODO: Set timeouts
S BMXDTIME(1)=.5 ;HMW 20050120
U BMXDEV
F D Q:BMXQUIT
. R BMXACT#5:BMXDTIME ;Read first 5 chars from TCP buffer, timeout=BMXDTIME ;IHS/OIT/HMW SAC Exemption Applied For
. I BMXACT="" S BMXQUIT=1 Q ; LISTENER TIMED OUT AFTER 999999 SECONDS (10 DAYS) ; IHS/OIT/GIS 10/4/2011
. I BMXACT'="{BMX}" S BMXQUIT=2 Q ; PRIMARY MESSSAGE IS INVALID. NEED TO CLEAN OUT TCP BUFFER AND START OVER ; IHS/OIT/GIS 10/4/2011
. R BMXACT#5:BMXDTIME ;Read next 5 chars - message length ;IHS/OIT/HMW SAC Exemption Applied For
. S BMXLEN=+BMXACT
. R BMXACT#BMXLEN:BMXDTIME ;IHS/OIT/HMW SAC Exemption Applied For
. I $P(BMXACT,"^")="TCPconnect" D Q
. . N BMXNSJ,X,Y,ZCHILD,%
. . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace
. . S BMXNSJ=$P(BMXNSJ,",")
. . I BMXNSJ="" S BMXNSJ=BMXNS
. . S X=BMXNSJ
. . X ^%ZOSF("UCICHECK") I Y=0 S BMXNSJ=BMXNS
. . S STATUS=$S(Y'=0:"CONNECTION OK",1:"CONNECTION FAILED, INVALID NAMESPACE") ; SET CONNECTION STATUS BASED ON NAMESPACE VALIDITY
. . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
. . X ("S ZCHILD="_$C(36,90)_"CHILD")
. . I ZCHILD S ^BMXTMP("CONNECT STATUS",ZCHILD)=STATUS
. . Q
. I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",!
I BMXQUIT=2 S BMXQUIT=0 G RELOAD ; PRIMARY MSG IS INVALID. CLEAR TCP BUFFER AND START ITERATING AGAIN. ; IHS/OIT/GIS 10/4/2011
S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag'
Q
;
SESSION(BMXWIN) ;EP
;Start session monitor
;BMXWIN = 1: Enable integrated security
SESSRES ;EP - reentry point from trap
;IHS/OIT/HMW SAC Exemption Applied For
N $ESTACK S $ETRAP="D ETRAP^BMXMON"
S DIQUIET=1,U="^" D DT^DICRW
D UNREGALL^BMXMEVN ;Unregister all events for this session
U $P D SESSMAIN
;Turn off the error trap for the exit
S $ETRAP=""
I $G(DUZ) D LOGOUT^XUSRB
K BMXR,BMXARY
C $P ;IHS/OIT/HMW SAC Exemption Applied For
Q
;
SESSMAIN ;
N BMXTBUF
D SETUP^BMXMSEC(.RET) ;Setup required system vars
S U="^"
U $P
F D Q:BMXTBUF="#BYE#"
. R BMXTBUF#11:BMXDTIME IF '$T D TIMEOUT S BMXTBUF="#BYE#" Q ;IHS/OIT/HMW SAC Exemption Applied For
. I BMXTBUF["XQKEY" S HWMP=1
. I BMXTBUF="#BYE#" Q
. S BMXHTYPE=$S($E(BMXTBUF,1,5)="{BMX}":1,1:0) ;check HDR
. I 'BMXHTYPE S BMXTBUF="#BYE#" D SNDERR W BMXTBUF,$C(4),! Q
. S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11)
. R BMXTBUF#4:BMXDTIME(1) S BMXTBUF=L_BMXTBUF ;IHS/OIT/HMW SAC Exemption Applied For
. S BMXPLEN=BMXTBUF
. R BMXTBUF#BMXPLEN:BMXDTIME(1) ;IHS/OIT/HMW SAC Exemption Applied For
. I $P(BMXTBUF,U)="TCPconnect" D Q
. . D SNDERR W "accept",$C(4),! ;Ack
. IF BMXHTYPE D
. . K BMXR,BMXARY
. . IF BMXTBUF="#BYE#" D SNDERR W "#BYE#",$C(4),! Q
. . S BMXTLEN=BMXTLEN-15
. . D CALLP^BMXMBRK(.BMXR,BMXTBUF)
. . S BMXPTYPE=$S('$D(BMXPTYPE):1,BMXPTYPE<1:1,BMXPTYPE>6:1,1:BMXPTYPE)
. IF BMXTBUF="#BYE#" Q
. U $P
. D SNDERR ;Clears SNDERR parameters
. D SND
. D WRITE($C(4)) W *-3 ;send eot and flush buffer
D UNREGALL^BMXMEVN ;Unregister all events for this session
Q ;End Of Main
;
;
SNDERR ;send error information
;BMXSEC is the security packet, BMXERROR is application packet
N X
S X=$E($G(BMXSEC),1,255)
W $C($L(X))_X W *-3
S X=$E($G(BMXERROR),1,255)
W $C($L(X))_X W *-3
S BMXERROR="",BMXSEC="" ;clears parameters
Q
;
WRITE(BMXSTR) ;Write a data string
;
I $L(BMXSTR)<511 W *-3 W BMXSTR Q
;Handle a long string
W *-3 ;Flush the buffer
F Q:'$L(BMXSTR) W $E(BMXSTR,1,510),*-3 S BMXSTR=$E(BMXSTR,511,99999)
Q
SND ; -- send data for all, Let WRITE sort it out
N I,T
;
; -- error or abort occurred, send null
IF $L(BMXSEC)>0 D WRITE("") Q
; -- single value
IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) Q
; -- table delimited by CR+LF
IF BMXPTYPE=2 D Q
. S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)),WRITE($C(13,10))
; -- word processing
IF BMXPTYPE=3 D Q
. S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)) D:BMXWRAP WRITE($C(13,10))
; -- global array
IF BMXPTYPE=4 D Q
. S I=$G(BMXR) Q:I="" S T=$E(I,1,$L(I)-1) D:$D(@I)>10 WRITE(@I)
. F S I=$Q(@I) Q:I=""!(I'[T) W *-3 W @I W:BMXWRAP&(@I'=$C(13,10)) $C(13,10)
. IF $D(@BMXR) K @BMXR
; -- global instance
IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) Q
; -- variable length records only good upto 255 char)
IF BMXPTYPE=6 S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE($C($L(BMXR(I)))),WRITE(BMXR(I))
Q
;
TIMEOUT ;Do this on MAIN loop timeout
I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)) Q
;Sign-on timeout
S BMXR(0)=0,BMXR(1)=1,BMXR(2)="",BMXR(3)="TIME-OUT",BMXPTYPE=2
D SNDERR,SND,WRITE($C(4))
Q
;
SEMAPHOR(BMXTSKT,BMXACT) ;Lock/Unlock BMXMON semaphore
N RESULT
S U="^",RESULT=1
D GETENV^%ZOSV ;get Y=UCI^VOL^NODE^BOXLOOKUP of current system
I BMXACT="LOCK" D
. L +^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT):1
. S RESULT=$T
E L -^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT)
Q RESULT
;
CHPRN(N) ;Change process name to N.
D SETNM^%ZOSV($E(N,1,15))
Q
;
CKSTAT(OUT,IN) ; EP - RPC: BMX CONNECT STATUS ; CONFIRMS THAT THAT A VALID PROCESS HAS BEEN SPAWNED BY BMXMON
N PORT,STATUS,JOBID
S PORT=+$P($P,"|",3)
S JOBID=$P($J,":",1)
I $G(^BMXTMP("CONNECT STATUS",JOBID))="" HANG 1 ;Wait for job to spawn ZCHILD to be set in MON^
I $G(^BMXTMP("CONNECT STATUS",JOBID))="" HANG 1
I $G(^BMXTMP("CONNECT STATUS",JOBID))="" HANG 1
S STATUS=$G(^BMXTMP("CONNECT STATUS",JOBID))
K ^BMXTMP("CONNECT STATUS",JOBID)
I STATUS="" S STATUS="CONNECTION STATUS UNKNOWN"
S OUT=PORT_"|"_STATUS_"|"_JOBID
Q
;
MARKER(BMXPORT,BMXMODE) ;Set/Test/Clear Problem Marker, BMXMODE=0 is a function
N IP,Y,%,REF X ^%ZOSF("UCI") S REF=Y,IP="0.0.0.0",%=0
L +^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"):1
I BMXMODE=1 S ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")=1
I BMXMODE=0 S:$D(^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")) %=1
I BMXMODE=-1 K ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
L -^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
Q:BMXMODE=0 % Q
;
ETRAP ; -- on trapped error, send error info to client
N BMXERC,BMXERR,BMXLGR
;Change trapping during trap.
S $ETRAP="D ^%ZTER HALT" ;IHS/OIT/HMW SAC Exemption Applied For
S BMXERC=$$EC^%ZOSV
S BMXERR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="
S BMXLGR=$$LGR^%ZOSV_$C(4)
S BMXERR=BMXERR_BMXLGR
D ^%ZTER ;%ZTER clears $ZE and $ECODE
I (BMXERC["READ")!(BMXERC["WRITE")!(BMXERC["SYSTEM-F") D:$G(DUZ) LOGOUT^XUSRB G ^XUSCLEAN
U $P
D SNDERR,WRITE(BMXERR) W *-3
S $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99," ;IHS/OIT/HMW SAC Exemption Applied For
Q
;
;
N BMX,BMXVER
;VERSION
D
. S BMXN="BMXNET ADO.NET DATA PROVIDER" I $D(^DIC(9.4,"B",BMXN)) Q
. S BMXN="BMXNET RPMS .NET UTILITIES" I $D(^DIC(9.4,"B",BMXN)) Q
. S BMXN=""
. Q
;
S BMXVER=""
I BMXN]"",$D(^DIC(9.4,"B",BMXN)) D
. S BMX=$O(^DIC(9.4,"B",BMXN,0))
. I $D(^DIC(9.4,BMX,"VERSION")) S BMXVER=$P(^DIC(9.4,BMX,"VERSION"),"^")
. E S BMXVER="VERSION NOT FOUND"
S:BMXVER="" BMXVER="VERSION NOT FOUND"
;
;LOCATION
N BMXLOC
S BMXLOC=""
I $G(DUZ(2)),$D(^DIC(4,DUZ(2),0)) S BMXLOC=$P(^DIC(4,DUZ(2),0),"^")
S:BMXLOC="" BMXLOC="LOCATION NOT FOUND"
;
;WRITE
W !
W !,"BMXNet Version: ",BMXVER
W !,"Location: ",BMXLOC
Q
BMXMON ; IHS/OIT/HMW - BMXNet MONITOR ; 04 Jun 2010 3:10 PM
+1 ;;4.0;BMX;**2**;OCT 27, 2011;Build 2
+2 ;
+3 ;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace
+4 ;
STRT(BMXPORT,NS,IS,VB) ;EP
+1 ;Interactive monitor start
+2 ;Optional NS = namespace. If undefined, start in current ns
+3 ;Optional IS = Integrated Security. Default is 1
+4 ;Optional VB = Verbose. Default is 1
+5 ;
+6 NEW Y,BMXNS,BMXWIN
+7 ;
+8 ;Verbose
+9 SET BMXVB=$GET(VB,1)
+10 ;
+11 ;Check if port already running
+12 IF '$$SEMAPHOR(BMXPORT,"LOCK")
IF BMXVB
WRITE "BMXNet Monitor on port "_BMXPORT_" appears to be running already.",!
QUIT
+13 SET %=$$SEMAPHOR(BMXPORT,"UNLOCK")
+14 ;
+15 ;record problem marker
DO MARKER(BMXPORT,1)
+16 ; -- start the monitor
+17 ;
+18 ;Namespace
+19 XECUTE ^%ZOSF("UCI")
+20 SET BMXNS=$GET(NS,$PIECE(Y,","))
+21 ;
+22 ;Integrated security
+23 SET BMXWIN=$GET(IS,1)
+24 ;
+25 ;J DEBUG^%Serenji("MON^BMXMON("_BMXPORT_","_BMXNS_","_BMXWIN_")")
+26 ;IHS/OIT/HMW SAC Exemption Applied For
JOB MON^BMXMON(BMXPORT,BMXNS,BMXWIN)::5
IF '$TEST
IF BMXVB
WRITE "Unable to run BMXNet Monitor in background.",!
QUIT
+27 FOR %=1:1:5
Begin DoDot:1
+28 IF BMXVB
WRITE "Checking if BMXNet Monitor has started...",!
+29 HANG 1
+30 IF '$$MARKER(BMXPORT,0)
SET %=0
End DoDot:1
IF %=0
QUIT
+31 IF $$MARKER(BMXPORT,0)
Begin DoDot:1
+32 IF BMXVB
WRITE !,"BMXNet Monitor could not be started!",!
+33 IF BMXVB
WRITE "Check if port "_BMXPORT_" is busy on this CPU.",!
+34 ;clear marker
DO MARKER(BMXPORT,-1)
End DoDot:1
+35 IF '$TEST
IF BMXVB
WRITE "BMXNet Monitor started successfully."
+36 ;
+37 QUIT
+38 ;
RESTART ;EP
+1 ;Stop and Start all monitors in BMX MONITOR file
+2 ;Called by option BMX MONITOR START
+3 ;
+4 DO STOPALL
+5 DO STRTALL
+6 QUIT
+7 ;
STRTALL ;EP
+1 ;Start all monitors in BMX MONITOR file
+2 ;
+3 NEW BMXIEN
+4 SET BMXIEN=0
FOR
SET BMXIEN=$ORDER(^BMXMON(BMXIEN))
IF '+BMXIEN
QUIT
Begin DoDot:1
+5 SET BMXNOD=$GET(^BMXMON(BMXIEN,0))
+6 IF '+BMXNOD
QUIT
+7 IF '+$PIECE(BMXNOD,U,2)
QUIT
+8 SET BMXWIN=$PIECE(BMXNOD,U,3)
+9 SET BMXNS=$PIECE(BMXNOD,U,4)
+10 DO STRT($PIECE(BMXNOD,U),BMXNS,BMXWIN,0)
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
STOPALL ;EP
+1 ;Stop all monitors in BMXNET MONITOR file
+2 ;
+3 NEW BMXIEN,BMXPORT
+4 SET BMXIEN=0
FOR
SET BMXIEN=$ORDER(^BMXMON(BMXIEN))
IF '+BMXIEN
QUIT
Begin DoDot:1
+5 SET BMXNOD=$GET(^BMXMON(BMXIEN,0))
+6 IF '+BMXNOD
QUIT
+7 SET BMXPORT=+BMXNOD
+8 DO STOP(BMXPORT,0)
End DoDot:1
+9 QUIT
+10 ;
STOP(BMXPORT,VB) ;EP Stop monitor on BMXPORT
+1 ;Open a channel to monitor on BMXPORT and send shutdown request
+2 ;Optional VB = Verbose. Default is 1
+3 ;
+4 NEW IP,REF,X,DEV
+5 SET U="^"
DO HOME^%ZIS
+6 ;
+7 ;Verbose
+8 SET BMXVB=$GET(VB,1)
+9 ;
+10 IF BMXVB
DO EN^DDIOL("Stop BMXNet Monitor...")
+11 XECUTE ^%ZOSF("UCI")
SET REF=Y
+12 ;get server IP
SET IP="0.0.0.0"
+13 IF $GET(BMXPORT)=""
SET BMXPORT=9200
+14 ; -- make sure the listener is running
+15 IF $$SEMAPHOR(BMXPORT,"LOCK")
Begin DoDot:1
+16 SET %=$$SEMAPHOR(BMXPORT,"UNLOCK")
+17 IF BMXVB
DO EN^DDIOL("BMXNet Monitor does not appear to be running.")
End DoDot:1
QUIT
+18 ; -- send the shutdown message to the TCP Listener process
+19 DO CALL^%ZISTCP("127.0.0.1",BMXPORT)
IF POP
Begin DoDot:1
+20 SET %=$$SEMAPHOR(BMXPORT,"UNLOCK")
+21 IF BMXVB
DO EN^DDIOL("BMXNet Monitor does not appear to be running.")
End DoDot:1
QUIT
+22 USE IO
+23 SET X=$TEXT(+2)
SET X=$PIECE(X,";;",2)
SET X=$PIECE(X,";")
+24 IF X=""
SET X=0
+25 SET X=$CHAR($LENGTH(X))_X
+26 WRITE "{BMX}00011TCPshutdown",!
+27 ;IHS/OIT/HMW SAC Exemption Applied For
READ X#3:5
+28 DO CLOSE^%ZISTCP
+29 IF X="ack"
IF BMXVB
DO EN^DDIOL("BMXNet Monitor has been shutdown.")
+30 IF '$TEST
IF BMXVB
DO EN^DDIOL("Shutdown Failed!")
+31 ;change process name
+32 DO CHPRN($JOB)
+33 QUIT
+34 ;
MON(BMXPORT,NS,IS) ;Monitor port for connection & shutdown requests
+1 ;NS = Namespace to Start monitor
+2 ;IS = 1: Enable integrated security
+3 ;
+4 NEW BMXDEV,BMXQUIT,BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
+5 SET BMXQUIT=0
SET BMXDTIME=999999
+6 ;
+7 ;Set lock
+8 IF '$$SEMAPHOR(BMXPORT,"LOCK")
QUIT
+9 ;Clear problem marker
+10 DO MARKER(BMXPORT,-1)
+11 ;H 1
+12 ;
+13 ;Namespace
+14 XECUTE ^%ZOSF("UCI")
+15 IF $GET(NS)=""
SET BMXNS=$PIECE(Y,",")
+16 IF '$TEST
SET BMXNS=NS
+17 ;
+18 ;Integrated security
+19 SET BMXWIN=$GET(IS,1)
+20 ;
+21 ;Open server port;
+22 SET BMXDEV="|TCP|"_BMXPORT
RELOAD ;IHS/OIT/HMW SAC Exemption Applied For ; IHS/OIT/GIS 10/4/2011
CLOSE BMXDEV
+1 ;IHS/OIT/HMW SAC Exemption Applied For
OPEN BMXDEV:(:BMXPORT:"S"):5
IF '$TEST
QUIT
+2 ;
+3 ;S BMXDTIME(1)=BMXDTIME ; TODO: Set timeouts
+4 ;HMW 20050120
SET BMXDTIME(1)=.5
+5 USE BMXDEV
+6 FOR
Begin DoDot:1
+7 ;Read first 5 chars from TCP buffer, timeout=BMXDTIME ;IHS/OIT/HMW SAC Exemption Applied For
READ BMXACT#5:BMXDTIME
+8 ; LISTENER TIMED OUT AFTER 999999 SECONDS (10 DAYS) ; IHS/OIT/GIS 10/4/2011
IF BMXACT=""
SET BMXQUIT=1
QUIT
+9 ; PRIMARY MESSSAGE IS INVALID. NEED TO CLEAN OUT TCP BUFFER AND START OVER ; IHS/OIT/GIS 10/4/2011
IF BMXACT'="{BMX}"
SET BMXQUIT=2
QUIT
+10 ;Read next 5 chars - message length ;IHS/OIT/HMW SAC Exemption Applied For
READ BMXACT#5:BMXDTIME
+11 SET BMXLEN=+BMXACT
+12 ;IHS/OIT/HMW SAC Exemption Applied For
READ BMXACT#BMXLEN:BMXDTIME
+13 IF $PIECE(BMXACT,"^")="TCPconnect"
Begin DoDot:2
+14 NEW BMXNSJ,X,Y,ZCHILD,%
+15 ;Namespace
SET BMXNSJ=$PIECE(BMXACT,"^",2)
+16 SET BMXNSJ=$PIECE(BMXNSJ,",")
+17 IF BMXNSJ=""
SET BMXNSJ=BMXNS
+18 SET X=BMXNSJ
+19 XECUTE ^%ZOSF("UCICHECK")
IF Y=0
SET BMXNSJ=BMXNS
+20 ; SET CONNECTION STATUS BASED ON NAMESPACE VALIDITY
SET STATUS=$SELECT(Y'=0:"CONNECTION OK",1:"CONNECTION FAILED, INVALID NAMESPACE")
+21 ;IHS/OIT/HMW SAC Exemption Applied For
JOB SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5
+22 XECUTE ("S ZCHILD="_$CHAR(36,90)_"CHILD")
+23 IF ZCHILD
SET ^BMXTMP("CONNECT STATUS",ZCHILD)=STATUS
+24 QUIT
End DoDot:2
QUIT
+25 IF $PIECE(BMXACT,"^")="TCPshutdown"
SET BMXQUIT=1
WRITE "ack",!
End DoDot:1
IF BMXQUIT
QUIT
+26 ; PRIMARY MSG IS INVALID. CLEAR TCP BUFFER AND START ITERATING AGAIN. ; IHS/OIT/GIS 10/4/2011
IF BMXQUIT=2
SET BMXQUIT=0
GOTO RELOAD
+27 ; destroy 'running flag'
SET %=$$SEMAPHOR(BMXPORT,"UNLOCK")
+28 QUIT
+29 ;
SESSION(BMXWIN) ;EP
+1 ;Start session monitor
+2 ;BMXWIN = 1: Enable integrated security
SESSRES ;EP - reentry point from trap
+1 ;IHS/OIT/HMW SAC Exemption Applied For
+2 NEW $ESTACK
SET $ETRAP="D ETRAP^BMXMON"
+3 SET DIQUIET=1
SET U="^"
DO DT^DICRW
+4 ;Unregister all events for this session
DO UNREGALL^BMXMEVN
+5 USE $PRINCIPAL
DO SESSMAIN
+6 ;Turn off the error trap for the exit
+7 SET $ETRAP=""
+8 IF $GET(DUZ)
DO LOGOUT^XUSRB
+9 KILL BMXR,BMXARY
+10 ;IHS/OIT/HMW SAC Exemption Applied For
CLOSE $PRINCIPAL
+11 QUIT
+12 ;
SESSMAIN ;
+1 NEW BMXTBUF
+2 ;Setup required system vars
DO SETUP^BMXMSEC(.RET)
+3 SET U="^"
+4 USE $PRINCIPAL
+5 FOR
Begin DoDot:1
+6 ;IHS/OIT/HMW SAC Exemption Applied For
READ BMXTBUF#11:BMXDTIME
IF '$TEST
DO TIMEOUT
SET BMXTBUF="#BYE#"
QUIT
+7 IF BMXTBUF["XQKEY"
SET HWMP=1
+8 IF BMXTBUF="#BYE#"
QUIT
+9 ;check HDR
SET BMXHTYPE=$SELECT($EXTRACT(BMXTBUF,1,5)="{BMX}":1,1:0)
+10 IF 'BMXHTYPE
SET BMXTBUF="#BYE#"
DO SNDERR
WRITE BMXTBUF,$CHAR(4),!
QUIT
+11 SET BMXTLEN=$EXTRACT(BMXTBUF,6,10)
SET L=$EXTRACT(BMXTBUF,11,11)
+12 ;IHS/OIT/HMW SAC Exemption Applied For
READ BMXTBUF#4:BMXDTIME(1)
SET BMXTBUF=L_BMXTBUF
+13 SET BMXPLEN=BMXTBUF
+14 ;IHS/OIT/HMW SAC Exemption Applied For
READ BMXTBUF#BMXPLEN:BMXDTIME(1)
+15 IF $PIECE(BMXTBUF,U)="TCPconnect"
Begin DoDot:2
+16 ;Ack
DO SNDERR
WRITE "accept",$CHAR(4),!
End DoDot:2
QUIT
+17 IF BMXHTYPE
Begin DoDot:2
+18 KILL BMXR,BMXARY
+19 IF BMXTBUF="#BYE#"
DO SNDERR
WRITE "#BYE#",$CHAR(4),!
QUIT
+20 SET BMXTLEN=BMXTLEN-15
+21 DO CALLP^BMXMBRK(.BMXR,BMXTBUF)
+22 SET BMXPTYPE=$SELECT('$DATA(BMXPTYPE):1,BMXPTYPE<1:1,BMXPTYPE>6:1,1:BMXPTYPE)
End DoDot:2
+23 IF BMXTBUF="#BYE#"
QUIT
+24 USE $PRINCIPAL
+25 ;Clears SNDERR parameters
DO SNDERR
+26 DO SND
+27 ;send eot and flush buffer
DO WRITE($CHAR(4))
WRITE *-3
End DoDot:1
IF BMXTBUF="#BYE#"
QUIT
+28 ;Unregister all events for this session
DO UNREGALL^BMXMEVN
+29 ;End Of Main
QUIT
+30 ;
+31 ;
SNDERR ;send error information
+1 ;BMXSEC is the security packet, BMXERROR is application packet
+2 NEW X
+3 SET X=$EXTRACT($GET(BMXSEC),1,255)
+4 WRITE $CHAR($LENGTH(X))_X
WRITE *-3
+5 SET X=$EXTRACT($GET(BMXERROR),1,255)
+6 WRITE $CHAR($LENGTH(X))_X
WRITE *-3
+7 ;clears parameters
SET BMXERROR=""
SET BMXSEC=""
+8 QUIT
+9 ;
WRITE(BMXSTR) ;Write a data string
+1 ;
+2 IF $LENGTH(BMXSTR)<511
WRITE *-3
WRITE BMXSTR
QUIT
+3 ;Handle a long string
+4 ;Flush the buffer
WRITE *-3
+5 FOR
IF '$LENGTH(BMXSTR)
QUIT
WRITE $EXTRACT(BMXSTR,1,510),*-3
SET BMXSTR=$EXTRACT(BMXSTR,511,99999)
+6 QUIT
SND ; -- send data for all, Let WRITE sort it out
+1 NEW I,T
+2 ;
+3 ; -- error or abort occurred, send null
+4 IF $LENGTH(BMXSEC)>0
DO WRITE("")
QUIT
+5 ; -- single value
+6 IF BMXPTYPE=1
SET BMXR=$GET(BMXR)
DO WRITE(BMXR)
QUIT
+7 ; -- table delimited by CR+LF
+8 IF BMXPTYPE=2
Begin DoDot:1
+9 SET I=""
FOR
SET I=$ORDER(BMXR(I))
IF I=""
QUIT
DO WRITE(BMXR(I))
DO WRITE($CHAR(13,10))
End DoDot:1
QUIT
+10 ; -- word processing
+11 IF BMXPTYPE=3
Begin DoDot:1
+12 SET I=""
FOR
SET I=$ORDER(BMXR(I))
IF I=""
QUIT
DO WRITE(BMXR(I))
IF BMXWRAP
DO WRITE($CHAR(13,10))
End DoDot:1
QUIT
+13 ; -- global array
+14 IF BMXPTYPE=4
Begin DoDot:1
+15 SET I=$GET(BMXR)
IF I=""
QUIT
SET T=$EXTRACT(I,1,$LENGTH(I)-1)
IF $DATA(@I)>10
DO WRITE(@I)
+16 FOR
SET I=$QUERY(@I)
IF I=""!(I'[T)
QUIT
WRITE *-3
WRITE @I
IF BMXWRAP&(@I'=$CHAR(13,10))
WRITE $CHAR(13,10)
+17 IF $DATA(@BMXR)
KILL @BMXR
End DoDot:1
QUIT
+18 ; -- global instance
+19 IF BMXPTYPE=5
SET BMXR=$GET(@BMXR)
DO WRITE(BMXR)
QUIT
+20 ; -- variable length records only good upto 255 char)
+21 IF BMXPTYPE=6
SET I=""
FOR
SET I=$ORDER(BMXR(I))
IF I=""
QUIT
DO WRITE($CHAR($LENGTH(BMXR(I))))
DO WRITE(BMXR(I))
+22 QUIT
+23 ;
TIMEOUT ;Do this on MAIN loop timeout
+1 IF $GET(DUZ)>0
DO SNDERR
DO WRITE("#BYE#"_$CHAR(4))
QUIT
+2 ;Sign-on timeout
+3 SET BMXR(0)=0
SET BMXR(1)=1
SET BMXR(2)=""
SET BMXR(3)="TIME-OUT"
SET BMXPTYPE=2
+4 DO SNDERR
DO SND
DO WRITE($CHAR(4))
+5 QUIT
+6 ;
SEMAPHOR(BMXTSKT,BMXACT) ;Lock/Unlock BMXMON semaphore
+1 NEW RESULT
+2 SET U="^"
SET RESULT=1
+3 ;get Y=UCI^VOL^NODE^BOXLOOKUP of current system
DO GETENV^%ZOSV
+4 IF BMXACT="LOCK"
Begin DoDot:1
+5 LOCK +^BMXMON("BMXMON",$PIECE(Y,U,2),$PIECE(Y,U),$PIECE(Y,U,4),BMXTSKT):1
+6 SET RESULT=$TEST
End DoDot:1
+7 IF '$TEST
LOCK -^BMXMON("BMXMON",$PIECE(Y,U,2),$PIECE(Y,U),$PIECE(Y,U,4),BMXTSKT)
+8 QUIT RESULT
+9 ;
CHPRN(N) ;Change process name to N.
+1 DO SETNM^%ZOSV($EXTRACT(N,1,15))
+2 QUIT
+3 ;
CKSTAT(OUT,IN) ; EP - RPC: BMX CONNECT STATUS ; CONFIRMS THAT THAT A VALID PROCESS HAS BEEN SPAWNED BY BMXMON
+1 NEW PORT,STATUS,JOBID
+2 SET PORT=+$PIECE($PRINCIPAL,"|",3)
+3 SET JOBID=$PIECE($JOB,":",1)
+4 ;Wait for job to spawn ZCHILD to be set in MON^
IF $GET(^BMXTMP("CONNECT STATUS",JOBID))=""
HANG 1
+5 IF $GET(^BMXTMP("CONNECT STATUS",JOBID))=""
HANG 1
+6 IF $GET(^BMXTMP("CONNECT STATUS",JOBID))=""
HANG 1
+7 SET STATUS=$GET(^BMXTMP("CONNECT STATUS",JOBID))
+8 KILL ^BMXTMP("CONNECT STATUS",JOBID)
+9 IF STATUS=""
SET STATUS="CONNECTION STATUS UNKNOWN"
+10 SET OUT=PORT_"|"_STATUS_"|"_JOBID
+11 QUIT
+12 ;
MARKER(BMXPORT,BMXMODE) ;Set/Test/Clear Problem Marker, BMXMODE=0 is a function
+1 NEW IP,Y,%,REF
XECUTE ^%ZOSF("UCI")
SET REF=Y
SET IP="0.0.0.0"
SET %=0
+2 LOCK +^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"):1
+3 IF BMXMODE=1
SET ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")=1
+4 IF BMXMODE=0
IF $DATA(^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"))
SET %=1
+5 IF BMXMODE=-1
KILL ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
+6 LOCK -^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
+7 IF BMXMODE=0
QUIT %
QUIT
+8 ;
ETRAP ; -- on trapped error, send error info to client
+1 NEW BMXERC,BMXERR,BMXLGR
+2 ;Change trapping during trap.
+3 ;IHS/OIT/HMW SAC Exemption Applied For
SET $ETRAP="D ^%ZTER HALT"
+4 SET BMXERC=$$EC^%ZOSV
+5 SET BMXERR="M ERROR="_BMXERC_$CHAR(13,10)_"LAST REF="
+6 SET BMXLGR=$$LGR^%ZOSV_$C(4)
+7 SET BMXERR=BMXERR_BMXLGR
+8 ;%ZTER clears $ZE and $ECODE
DO ^%ZTER
+9 IF (BMXERC["READ")!(BMXERC["WRITE")!(BMXERC["SYSTEM-F")
IF $GET(DUZ)
DO LOGOUT^XUSRB
GOTO ^XUSCLEAN
+10 USE $PRINCIPAL
+11 DO SNDERR
DO WRITE(BMXERR)
WRITE *-3
+12 ;IHS/OIT/HMW SAC Exemption Applied For
SET $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON"
SET $ECODE=",U99,"
+13 QUIT
+14 ;
+1 ;
+2 NEW BMX,BMXVER
+3 ;VERSION
+4 Begin DoDot:1
+5 SET BMXN="BMXNET ADO.NET DATA PROVIDER"
IF $DATA(^DIC(9.4,"B",BMXN))
QUIT
+6 SET BMXN="BMXNET RPMS .NET UTILITIES"
IF $DATA(^DIC(9.4,"B",BMXN))
QUIT
+7 SET BMXN=""
+8 QUIT
End DoDot:1
+9 ;
+10 SET BMXVER=""
+11 IF BMXN]""
IF $DATA(^DIC(9.4,"B",BMXN))
Begin DoDot:1
+12 SET BMX=$ORDER(^DIC(9.4,"B",BMXN,0))
+13 IF $DATA(^DIC(9.4,BMX,"VERSION"))
SET BMXVER=$PIECE(^DIC(9.4,BMX,"VERSION"),"^")
+14 IF '$TEST
SET BMXVER="VERSION NOT FOUND"
End DoDot:1
+15 IF BMXVER=""
SET BMXVER="VERSION NOT FOUND"
+16 ;
+17 ;LOCATION
+18 NEW BMXLOC
+19 SET BMXLOC=""
+20 IF $GET(DUZ(2))
IF $DATA(^DIC(4,DUZ(2),0))
SET BMXLOC=$PIECE(^DIC(4,DUZ(2),0),"^")
+21 IF BMXLOC=""
SET BMXLOC="LOCATION NOT FOUND"
+22 ;
+23 ;WRITE
+24 WRITE !
+25 WRITE !,"BMXNet Version: ",BMXVER
+26 WRITE !,"Location: ",BMXLOC
+27 QUIT
