BMXMON ; IHS/OIT/HMW - BMXNet MONITOR ; 5/22/11 3:35pm ;;4.1000;BMX;;Apr 17, 2011 ; ; Changes for *1000 by WV/SMH (Feb 2 2011) to support GT.M ; - XINETD entry point for GT.M ; - Replacement of all W *-3 to W ! ; - Addition of logging capabilities for analysis using XWBDLOG ; - In SESSRES ; -- Broker Timeout set from Kernel System Parameter Broker Timeout Field ; -- Process Name now gets Set to show in %SS or ZSY ; - Error Handling does not log Network Errors to the Error Trap. ; - Major refactoring to Writing to the TCP Network Stream. ; --> All writes are buffered up to 32767 characters (max string on Cache) ; --> Then sent... ; --> See EP's WRITE and WBF ; --> This avoids the side effects of the Nagle Algorithm on the Linux TCP Stack ; - BMXERR renamed to BMXERROR in EP ETRAP so that it can be sent via SNDERR. ; --> This reduces the need for custom error trap handling which is very difficult to do ; --> in Mumps for new programmers. Mumps errors now are thrown on the client. ; - CHSTAT now has code to get the port for GT.M when using xinetd ; ;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 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 ;IHS/OIT/HMW SAC Exemption Applied For . I BMXACT'="{BMX}" S BMXQUIT=1 Q . 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",! S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag' Q ; XINETD ;PEP Directly from xinetd or inetd for GT.M ; N XWBDEBUG S XWBDEBUG=$$GET^XPAR("SYS","XWBDEBUG") ; 0 1 2 or 3; depending on the level of verbosity desired. D:XWBDEBUG LOGSTART^XWBDLOG("XINETD^BMXMON") ; Start Log only if logging ; 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; get remove ip address S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""") S BMXDEV=$P X "U BMXDEV:(nowrap:nodelimiter:ioerror=""^%ZTER H"")" S %="",@("%=$ZTRNLNM(""REMOTE_HOST"")") S:$L(%) IO("GTM-IP")=% ; ; Read message type N BMXACT,BMXDTIME S BMXDTIME=10 ; change in 2.2 instead of 9999999 - initial conn timout R BMXACT#5:BMXDTIME ; D LOG("Read: "_BMXACT) ; 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 R BMXACT#5:BMXDTIME ;Read next 5 chars - message length ; D LOG("Read: "_BMXACT) ; S BMXLEN=+BMXACT R BMXACT#BMXLEN:BMXDTIME ; D LOG("Read: "_BMXACT) ; I $P(BMXACT,"^")="TCPconnect" S ^BMXTMP("CONNECT STATUS",$JOB)="CONNECTION OK" G SESSRES ; <--WARNING: A GOTO I $P(BMXACT,"^")="TCPshutdown" W "ack",! Q QUIT ; 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 ; new in 2.2: Use kernel rpc timeout instead of 9999999 S BMXDTIME(1)=.5,BMXDTIME=$$BAT^XUPARAM ; ; 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 ; ;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 ; MAIN LOOP!!!!!! N BMXTBUF ; BMX Read Buffer N BMXWBUF S BMXWBUF="" ; BMX Write Buffer 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 . ; . D LOG("Read: "_BMXTBUF) . ; . I BMXTBUF="#BYE#" QUIT ;**QUITTING HERE** . S BMXHTYPE=$S($E(BMXTBUF,1,5)="{BMX}":1,1:0) ;check HDR . I 'BMXHTYPE S BMXTBUF="#BYE#" D QUIT ;;***QUITTING HERE*** . . D SNDERR . . D WRITE(BMXTBUF_$C(4)),WBF . S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11) . R BMXTBUF#4:BMXDTIME(1) . ; . D LOG("Read: "_BMXTBUF) . ; . 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 . ; . D LOG("Read: "_BMXTBUF) . ; . I $P(BMXTBUF,U)="TCPconnect" D QUIT ;;***QUIT HERE*** . . D SNDERR . . D WRITE("accept"_$C(4)),WBF ;Ack . IF BMXHTYPE D . . K BMXR,BMXARY . . IF BMXTBUF="#BYE#" D QUIT . . . D SNDERR . . . D WRITE("#BYE#"_$C(4)) . . . D WBF . . 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)) ;send eot . D WBF ; 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) D WRITE($C($L(X))_X) S X=$E($G(BMXERROR),1,255) D WRITE($C($L(X))_X) S BMXERROR="",BMXSEC="" ;clears parameters Q ; WRITE(BMXSTR) ;Write a data string to the output buffer F Q:'$L(BMXSTR) D . I $L(BMXWBUF)+$L(BMXSTR)>32767 D WBF ; Maximum String Length on Cache . S BMXWBUF=BMXWBUF_$E(BMXSTR,1,255),BMXSTR=$E(BMXSTR,256,999999) QUIT ; WBF ;Write Buffer to Network Stream then flush Q:'$L(BMXWBUF) I $G(XWBDEBUG)>2,$L(BMXWBUF) D LOG^XWBDLOG("wrt ("_$L(BMXWBUF)_"): "_BMXWBUF) W BMXWBUF,! S BMXWBUF="" QUIT 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("") QUIT ; ; -- single value IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) QUIT ; ; -- table delimited by CR+LF IF BMXPTYPE=2 D QUIT . S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)),WRITE($C(13,10)) ; ; -- word processing IF BMXPTYPE=3 D QUIT . S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)),WRITE($C(13,10)):BMXWRAP ; ; -- global array IF BMXPTYPE=4 D QUIT . 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) D WRITE(@I),WRITE($C(13,10)):(BMXWRAP&(@I'=$C(13,10))) . IF $D(@BMXR) K @BMXR ; ; -- global instance IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) QUIT ; ; -- 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)) QUIT ; TIMEOUT ;Do this on MAIN loop timeout I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)),WBF QUIT ;Sign-on timeout S BMXR(0)=0,BMXR(1)=1,BMXR(2)="",BMXR(3)="TIME-OUT",BMXPTYPE=2 D SNDERR,SND,WRITE($C(4)),WBF QUIT ; 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 ; On GT.M on xinetd, get port from ZSHOW "D":^SAM -- thanks to Wally Fort in VistaLink for the Idea ;^SAM("D",1)="/dev/null OPEN " ;^SAM("D",2)="0 OPEN SOCKET TOTAL=1 CURRENT=0 " ;^SAM("D",3)=" SOCKET[0]=h13060671680 DESC=0 CONNECTED ACTIVE TRAP REMOTE=172.16.16.56@54531 LOCAL=172.16.16.142@9260 " ;^SAM("D",4)=" ZDELAY ZBFSIZE=1024 ZIBFSIZE=0 NODELIMITER " ; N PORT,STATUS,JOBID S PORT=+$P($P,"|",3) ; On Cache, port would be the 3rd piece of $Principle I PORT=0,^%ZOSF("OS")["GT.M" DO ; if port is blank and we are on GT.M, then we must be using Xinetd . N BMXTMP ; holds device data . X "ZSHOW ""D"":BMXTMP" ; dump data . N % S %="" ; loop var . F S %=$O(BMXTMP("D",%)) Q:'% Q:BMXTMP("D",%)["LOCAL" ; Cycle % to the right value . S PORT=+$P($P(BMXTMP("D",%),"LOCAL=",2),"@",2) ; Get port 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 ; Error Trap Vars: Code, Error, Last Global Reference N BMXERC,BMXERROR,BMXLGR ; ;Change trapping during trap. S $ETRAP="D ^%ZTER HALT" ;IHS/OIT/HMW SAC Exemption Applied For ; ; 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 error and send to client S BMXERC=$$EC^%ZOSV S BMXERROR="M ERROR="_BMXERC_$C(13,10)_"LAST REF=" S BMXLGR=$$LGR^%ZOSV_$C(4) S BMXERROR=BMXERROR_BMXLGR ; D ^%ZTER ;%ZTER clears $ZE and $ECODE ; U $P ; D SNDERR,WRITE(BMXERROR),WBF ; S $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99," ;IHS/OIT/HMW SAC Exemption Applied For QUIT ; LOG(STR) ; EP - Log stuff in Broker log only if XWBDLOG is defined D:XWBDEBUG LOG^XWBDLOG(STR) 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