BMXMON ; IHS/OIT/HMW - BMXNet MONITOR ; 7/20/2009 ; 12/7/10 3:20pm ;;2.3;BMX;;Jan 25, 2011 ; ;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace ; 7/20/2009: Release of patch to support GT.M WV/SMH ; Changes: ; Addition of XINETD and GTMLNX entry points for support of GT.M ; Changes of W *-3 (which only works on Cache) to W ! ; 9/7/2010: Minor bug fixes and enhancements ; In GTMLNX: Set process name ; In GTMLNX: Time out based now on the Kernel Broker Timeout field ; in kernel system parameters file ; 12/12/2010: Minor bug fixes ; ETRAP nows screens errors before logging them. If it is a network ; write error, it's not logged to the Error Trap ; Set Process Name crashed on Cache due to undefined IO("GT.M"). ; Now this is surrounded by $Get to prevent this error. ; 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 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") S BMXNS=$G(NS,$P(Y,",")) ; ;Integrated security S BMXWIN=$G(IS,1) ; ;Open server port; S BMXDEV="|TCP|"_BMXPORT C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For 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 . I BMXACT'="{BMX}" S BMXQUIT=1 Q . R BMXACT#5:BMXDTIME ;Read next 5 chars - message length . S BMXLEN=+BMXACT . R BMXACT#BMXLEN:BMXDTIME . I $P(BMXACT,"^")="TCPconnect" D Q . . ;IHS/OIT/HMW added validity check for namespace . . N BMXNSJ,X,Y . . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace . . S BMXNSJ=$P(BMXNSJ,",") . . ;if passed in namespace is invalid, new job will start in listener namespace . . I BMXNSJ]"" S X=BMXNSJ X ^%ZOSF("UCICHECK") S:Y=0 BMXNSJ=BMXNS . . ;Job another MONITOR using concurrent connection . . ;J DEBUG^%Serenji("SESSION^BMXMON("_BMXWIN_")"):(:5:BMXDEV:BMXDEV):5 . . ;J SESSION^BMXMON(BMXWIN)[$P(BMXNS,",")]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For . . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For . I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",! S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag' Q ; XINETD ;PEP Directly from xinetd or inetd for GT.M N BMXDEV S U="^",$ETRAP="D ^%ZTER H" ;Set up the error trap S $ZT="" ;Clear old trap ; GT.M specific error and device code S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""") S BMXDEV=$P X "U BMXDEV:(nowrap:nodelimiter:ioerror=""TRAP"")" S %="",@("%=$ZTRNLNM(""REMOTE_HOST"")") S:$L(%) IO("GTM-IP")=% I %["::ffff:" S IO("GTM-IP")=$P(%,"::ffff:",2) ; IPv6 support ; Read message type N BMXACT,BMXDTIME S BMXDTIME=10 ; change in 2.2 instead of 9999999 - initial conn timout R BMXACT#5:BMXDTIME Q:BMXACT'="{BMX}" ; Not a BMX message - quit. ; Fall through to below... GTMLNX ;EP from XWBTCPM for GT.M ; not implementing NS and integrated authentication ; Vars: Read timeout, msg len, msg, windows auth, Namespace N BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS S BMXNSJ="",BMXWIN=0 ; No NS on GT.M, no Windows Authentication S BMXDTIME(1)=.5,BMXDTIME=180 ; sign on timeout like XWBTCPM R BMXACT#5:BMXDTIME ;Read next 5 chars - message length S BMXLEN=+BMXACT R BMXACT#BMXLEN:BMXDTIME I $P(BMXACT,"^")="TCPconnect" G SESSRES I $P(BMXACT,"^")="TCPshutdown" W "ack",! Q Q ; Should't hit this quit, but just in case ; SESSION(BMXWIN) ;EP ;Start session monitor ;BMXWIN = 1: Enable integrated security SESSRES ;EP - reentry point from trap ;IHS/OIT/HMW SAC Exemption Applied For S BMXDTIME(1)=.5,BMXDTIME=$$BAT^XUPARAM ; new in 2.2: Use kernel rpc timeout instead of 9999999 ; ; Change Process Name (new in 2.2 and 2.3) ; (GT.M doesn't store the IP in $P, but Cache does. We get GT.M ; remote process IP from linux env var $REMOTE_HOST) D:+$G(IO("GTM-IP")) CHPRN("BMX:ip"_$P(IO("GTM-IP"),".",3,4)) ; GT.M D:+$P CHPRN("BMX:ip_"_$P($P,".",3,4)) ; Cache ; 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 . 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 . S BMXPLEN=BMXTBUF . R BMXTBUF#BMXPLEN:BMXDTIME(1) . 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 ! ;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 ! S X=$E($G(BMXERROR),1,255) W $C($L(X))_X W ! S BMXERROR="",BMXSEC="" ;clears parameters Q ; WRITE(BMXSTR) ;Write a data string ; I $L(BMXSTR)<511 W ! W BMXSTR Q ;Handle a long string W ! ;Flush the buffer F Q:'$L(BMXSTR) W $E(BMXSTR,1,510),! 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 ! 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 ; 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 ; Error Trap Vars: Code, Error, Last Global Reference N BMXERC,BMXERR,BMXLGR ; ; Change trapping during trap. N $ETRAP S $ETRAP="D ^%ZTER HALT" ; ; If the error is simply that we can't write to the TCP device ; clear and log out ; GT.M Error Code. I $ECODE=",Z150376602," S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT ; Cache Error Codes: I ($EC["READ")!($EC["WRITE")!($EC["SYSTEM-F") S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT ; ; Otherwise, log the error and send it to the client 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 ; U $P ; D SNDERR,WRITE(BMXERR) W ! ; S $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99," QUIT ; MENU ;EP - ENTRY ACTION FROM BMXMENU OPTION ; 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