Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: CIANBLIS

CIANBLIS.m

Go to the documentation of this file. 
  1. CIANBLIS ;MSC/IND/DKM - MSC RPC Broker ;23-Mar-2011 18:36;PLS
  1.  ;;1.1;CIA NETWORK COMPONENTS;**001007,001008**;Sep 18, 2007
  1.  ;;Copyright 2000-2011, Medsphere Systems Corporation
  1.  ;=================================================================
  1.  ; Start listener process (primary and secondary)
  1.  ;   CIAPORT = Listener port
  1.  ;   CIAIP = IP address of client
  1.  ;   CIAMODE = Connection type:
  1.  ;     0: primary listener - dispatches connections
  1.  ;     1: secondary listener - services individual clients
  1.  ;     2: secondary listener - concurrent mode
  1.  ;
  1. EN(CIAPORT,CIAIP,CIAMODE) ;PEP - See above
  1.  N CIAVER,CIAOS,CIATDEV,CIAQUIT,CIALN,CIAXUT,CIAUCI,CIARETRY,XWBOS,X,Y,$ET,$ES
  1.  D UCI^%ZOSV
  1.  S U="^",CIAUCI=$P(Y,","),CIAMODE=+$G(CIAMODE),CIAIP=$G(CIAIP),(CIAQUIT,CIARETRY)=0
  1.  D MONSTART^CIANBEVT                                                   ; Start background event monitor if not already running
  1.  S:'$G(CIAPORT) CIAPORT=9000                                           ; Default service port
  1.  Q:'$$STATE(1)                                                         ; Quit if listener already running
  1.  S Y=$G(^%ZOSF("OS")),(CIAOS,X)=0
  1.  F XWBOS="DSM","MSM","OpenM" S X=X+1 I Y[XWBOS S CIAOS=X Q
  1.  D:'CIAOS RAISE(15,Y)
  1.  D CLEANUP,STSAVE(0),NULLOPEN,STSAVE(1)
  1.  D:CIAMODE=1 LOGRSRC^%ZOSV("$BROKER HANDLER$",2,1)                     ; Start RUM for Broker Handler
  1.  D CHPRN("CIA"_$S($L(CIAIP):$P(CIAIP,".",3,4)_":"_CIAPORT,1:CIAPORT))  ; Change process name
  1.  D LISTEN
  1.  D:CIAMODE=1 LOGRSRC^%ZOSV("$BROKER HANDLER$",2,2)                     ; Stop RUM for handler
  1.  D:CIAQUIT>0!'CIAMODE STATE(0),STREST(1),^%ZISC,STREST(0),CLEANUP,LOGOUT^XUSRB:$G(DUZ)
  1.  I 'CIAMODE,'CIAQUIT J EN^CIANBLIS(CIAPORT)                            ; Restart primary listener after fatal error
  1.  Q
  1.  ; Entry point for interactive debugging
  1. DEBUG N CIAPORT,CIAIP
  1.  W !!,"Debug Mode Support",!!
  1.  S CIAIP=$$PMPT("Addr","Enter callback IP address.","127.0.0.1")
  1.  Q:U[CIAIP
  1.  S CIAPORT=$$PMPT("Port","Enter callback port.")
  1.  Q:U[CIAPORT
  1.  I $L($T(^%Serenji)),$$ASK^CIAU("Use Serenji Debugger","Y") D  Q
  1.  .N SRJIP,SRJPORT
  1.  .S SRJIP=$$PMPT("Serenji Listener Addr","Enter Serenji listener address",CIAIP)
  1.  .Q:U[SRJIP
  1.  .S SRJPORT=$$PMPT("Serenji Listener Port","Enter Serenji listener port",4321)
  1.  .Q:U[SRJPORT
  1.  .D DEBUG^%Serenji("EN^CIANBLIS(CIAPORT,CIAIP,1)",SRJIP,SRJPORT)
  1.  W !
  1.  D EN(CIAPORT,CIAIP,1)
  1.  Q
  1. PMPT(PMPT,HELP,DFLT) ;
  1.  N RET
  1. PMPTX W PMPT,": ",$S($D(DFLT):DFLT_"// ",1:"")
  1.  R RET:$G(DTIME,30)
  1.  E  S RET=U
  1.  I $D(DFLT),'$L(RET) S RET=DFLT W DFLT
  1.  W !
  1.  I RET["?" W !,HELP,!! G PMPTX
  1.  Q RET
  1.  ; Entry point for MSERVER process (MSM only)
  1. MSERVER D EN(%("PORT"),%("ADDRESS"),2)
  1.  Q
  1.  ; Entry point for UCX process (DSM only)
  1. USERVER D EN($P(%,":",2),$P(%,":"),2)
  1.  Q
  1.  ; Start primary listener
  1. START(CIAPORT) ;EP
  1.  D SSLIS(,CIAPORT,,1),CLEANUP^CIANBUTL
  1.  Q
  1.  ; Stop primary or secondary listener
  1. STOP(CIAPORT,CIAIP) ;EP
  1.  D SSLIS(.CIAIP,CIAPORT,,0)
  1.  Q
  1.  ; Start all primary listeners
  1. STARTALL ;PEP - see above
  1.  D SSALL(1)
  1.  Q
  1.  ; Stop all primary listeners
  1. STOPALL ;PEP - see above
  1.  D SSALL(0)
  1.  Q
  1.  ; Start/stop all registered listeners
  1. SSALL(SS,SL) ;
  1.  N IEN,X
  1.  S SL=$G(SL,$D(ZTQUEUED)),U="^"
  1.  F IEN=0:0 S IEN=$O(^CIANB(19941.22,IEN)) Q:'IEN  S X=^(IEN,0) D
  1.  .I SS,$P(X,U,3) Q
  1.  .W:'SL !,$P(X,U),": "
  1.  .D SSLIS(,$P(X,U,2),$P(X,U,4),SS,SL)
  1.  Q
  1.  ; Start/stop primary listener
  1. SSLIS(CIAIP,CIAPORT,CIAUCI,SS,SL) ;
  1.  N CIALN,X,P1,P2,$ET
  1.  S SL=$G(SL,$D(ZTQUEUED))
  1.  S:'SL $ET="D SSERR^CIANBLIS"
  1.  S P1=$S(SS:"start",1:"stop"),P2=P1_$S(SS:"ed",1:"ped")
  1.  I $$STATE=SS W:'SL "Listener ",$S(SS:"already",1:"not")," running on port ",CIAPORT,!! Q
  1.  I 'SS S @$$LOCKNODE=1
  1.  E  I $L($G(CIAUCI)) D
  1.  .J EN^CIANBLIS(CIAPORT)[CIAUCI]
  1.  E  J EN^CIANBLIS(CIAPORT)
  1.  Q:SL
  1.  W "Waiting for listener to ",P1,"..."
  1.  F X=1:1:5 D
  1.  .H 2
  1.  .W "."
  1.  .S:$$STATE=SS X=99
  1.  I X<99 W "Listener failed to ",P1,!
  1.  E  W "Listener ",P2," on port ",CIAPORT,!
  1.  Q
  1. SSERR W:'$G(SL) "Listener failed to ",P1,": ",$$EC^%ZOSV,!
  1.  S $ET="D UNWIND^%ZTER"
  1.  Q
  1.  ; Main loop
  1. LISTEN N $ET,$ES
  1.  S $ET="D ETRAP1^CIANBLIS",CIARETRY=0,CIAQUIT='$$TCPOPEN
  1.  F  Q:$$QUIT  D
  1.  .N $ET,$ES
  1.  .S:$$DOACTION($S(CIAMODE=2&(CIAOS'=3):"C",CIAMODE:"DPQRSU",1:"C")) CIARETRY=0
  1.  D TCPCLOSE
  1.  Q
  1.  ; Read action and params
  1.  ;  VAC = List of valid action codes
  1.  ; Returns true if valid inputs
  1. DOACTION(VAC) ;
  1.  N NM,SB,RT,VL,PR,CIA,ACT,SEQ,ARG,CIAERR,CIADATA,X
  1.  S CIAERR(0)=0
  1.  D TCPUSE
  1.  S X=$$TCPREAD(8,10)
  1.  Q:$E(X,1,5)'="{CIA}" 0
  1.  S ARG=0,CIA("EOD")=$A(X,6),SEQ=$E(X,7),ACT=$E(X,8)
  1.  F  S NM=$$TCPREADL Q:'$L(NM)  S PR=NM=+NM,RT=$S(PR:"P"_NM,1:"CIA("""_NM_"""") N:PR&'$D(ARG(NM)) @RT D
  1.  .S:PR ARG=$S(NM>ARG:NM,1:ARG),ARG(NM)=""
  1.  .S SB=$$TCPREADL,VL=$$TCPREADL
  1.  .I $L(SB) S RT=RT_$S(PR:"(",1:",")_SB_")"
  1.  .E  S:'PR RT=RT_")"
  1.  .S @RT=VL
  1.  W SEQ
  1.  I '$$ERRCHK^CIANBACT(VAC'[ACT,9,ACT) D
  1.  .N $ET,$ES
  1.  .S $ET="D ETRAP2^CIANBLIS"
  1.  .D @("ACT"_ACT_"^CIANBACT")
  1.  I CIAERR(0) D
  1.  .D SNDERR
  1.  E  I $D(CIADATA) D
  1.  .D REPLY(.CIADATA)
  1.  E  D SNDEOD
  1.  D:'CIAMODE TCPREL
  1.  Q 1
  1.  ; Cleanup environment
  1. CLEANUP K ^TMP("CIANBRPC",$J),^TMP("CIANBLIS",$J),^XUTL("XQ",$J),@$$LOCKNODE
  1.  Q
  1.  ; Returns true if listener should quit
  1. QUIT() S:'CIAQUIT CIAQUIT=+$G(@$$LOCKNODE)
  1.  Q CIARETRY>5!CIAQUIT
  1.  ; Save application state
  1. STSAVE(ST) ;
  1.  D SAVE^XUS1
  1.  K ^TMP("CIANBLIS",$J,ST)
  1.  M ^TMP("CIANBLIS",$J,ST)=^XUTL("XQ",$J)
  1.  Q
  1.  ; Restore application state
  1. STREST(ST) ;
  1.  K ^XUTL("XQ",$J)
  1.  M ^XUTL("XQ",$J)=^TMP("CIANBLIS",$J,ST)
  1.  K IO
  1.  D RESETVAR^%ZIS
  1.  I ST,$D(IO)#2 D
  1.  .N $ET
  1.  .S $ET="S $EC="""" D NULLOPEN^CIANBLIS"
  1.  .U IO
  1.  Q
  1.  ; Establish null device as default IO device
  1. NULLOPEN N %ZIS,IOP,POP
  1.  S %ZIS="0H",IOP="NULL"
  1.  D ^%ZIS,RAISE(16):POP
  1.  U IO
  1.  Q
  1.  ; Open TCP listener port
  1.  ; Returns true if successful
  1. TCPOPEN() ;
  1.  N POP
  1.  S POP=0
  1.  I CIAMODE=2 D
  1.  .S CIATDEV=$S(CIAOS=1:"SYS$NET",CIAOS=2:56,1:$P)
  1.  .I CIAOS=1 O CIATDEV:TCPDEV:5 S POP='$T
  1.  I CIAMODE=1 D
  1.  .D CALL^%ZISTCP(CIAIP,CIAPORT)
  1.  .Q:POP
  1.  .S CIATDEV=IO,IO(0)=IO
  1.  .D:$T(SHARELIC^%ZOSV)'="" SHARELIC^%ZOSV(1)
  1.  I 'CIAMODE D
  1.  .I CIAOS=1 D
  1.  ..S CIATDEV=CIAPORT
  1.  ..O CIATDEV:TCPCHAN:5
  1.  ..S POP='$T
  1.  .I CIAOS=2 S CIATDEV=56
  1.  .I CIAOS=3 D
  1.  ..S CIATDEV="|TCP|"_CIAPORT
  1.  ..O CIATDEV:(:CIAPORT:"DS"):5
  1.  ..S POP='$T
  1.  Q 'POP
  1.  ; Use TCP listener port
  1. TCPUSE I CIAOS=1 U CIATDEV Q
  1.  I CIAOS=2 D  Q
  1.  .I CIAMODE U CIATDEV S:$ZC CIAQUIT=1 Q
  1.  .O CIATDEV
  1.  .U CIATDEV::"TCP"
  1.  .W /SOCKET("",CIAPORT)
  1.  I CIAOS=3 U CIATDEV
  1.  Q
  1.  ; Close TCP listener port
  1. TCPCLOSE C:$D(CIATDEV) CIATDEV
  1.  Q
  1.  ; Release TCP port
  1. TCPREL I CIAOS=1 U CIATDEV:DISCONNECT Q
  1.  I CIAOS=2 C CIATDEV Q
  1.  I CIAOS=3 W *-3,*-2
  1.  Q
  1.  ; Read from listener port
  1. TCPREAD(CNT,TMO) ;
  1.  N X,Y
  1.  S Y="",TMO=$G(TMO,60)
  1.  F  Q:CNT'>0  D
  1.  .R X#CNT:TMO
  1.  .I '$L(X) S Y="",CNT=0 S:CIAMODE=2 CIARETRY=CIARETRY+.5
  1.  .E  S Y=Y_X,CNT=CNT-$L(X)
  1.  Q Y
  1.  ; Read byte from listener port
  1. TCPREADB() ;
  1.  Q $A($$TCPREAD(1))
  1.  ; Read length-prefixed data from input stream
  1. TCPREADL() ;
  1.  N X,L,I,N
  1.  S X=$$TCPREADB
  1.  Q:X=CIA("EOD") ""
  1.  S N=X#16,X=$$TCPREAD(X\16),L=0
  1.  F I=1:1:$L(X) S L=L*256+$A(X,I)
  1.  Q $$TCPREAD(L*16+N)
  1.  ; Raise an exception
  1. RAISE(MSG,P1,P2) ;
  1.  D GETDLG^CIANBUTL(MSG,.MSG,.P1,.P2)
  1.  S $EC=MSG(1)
  1.  Q
  1.  ; Communication error
  1. ETRAP1 N ECSAV
  1.  S $ET="D UNWIND^CIANBLIS Q:$Q 0 Q",ECSAV=$EC,CIARETRY=CIARETRY+1
  1.  D:CIARETRY=1&(ECSAV'["READ") ^%ZTER
  1.  S $EC=ECSAV
  1.  Q
  1.  ; Unwind stack
  1. UNWIND Q:$ES>1
  1.  S $EC=""
  1.  Q
  1.  ; Trapped error, send error info to client
  1. ETRAP2 N ECSAV
  1.  S $ET="D UNWIND^CIANBLIS Q:$Q 0 Q",ECSAV=$$EC^%ZOSV,CIARETRY=CIARETRY+1
  1.  D:CIARETRY=1 ^%ZTER,ERRCHK^CIANBACT(1,1,ECSAV)
  1.  S $EC=ECSAV
  1.  Q
  1.  ; Send a reply
  1. REPLY(DATA,ACK) ;
  1.  D TCPUSE
  1.  W $C(+$G(ACK)),$G(DATA)
  1.  D SNDEOD
  1.  Q
  1.  ; Send error information
  1. SNDERR ;
  1.  N X
  1.  D TCPUSE
  1.  W $C(1)
  1.  D OUT^CIANBACT("CIAERR",1),SNDEOD
  1.  S CIAERR(0)=0
  1.  Q
  1.  ; Send end of data byte if not already sent
  1. SNDEOD I $D(CIA("EOD")) D
  1.  .D TCPUSE
  1.  .W $C(CIA("EOD")),!
  1.  .K CIA("EOD")
  1.  Q
  1.  ; Lock/Unlock listener
  1.  ; CIAACT:  1 = lock, 0 = unlock, missing = return status
  1.  ; Returns true if locked, false if not.
  1. STATE(CIAACT) ;
  1.  N RES,Y
  1.  S Y=$$LOCKNODE
  1.  I '$D(CIAACT) D
  1.  .L +@Y:0
  1.  .S RES='$T
  1.  .L:'RES -@Y
  1.  E  I CIAACT D
  1.  .L +@Y:1
  1.  .S RES=$T
  1.  E  D
  1.  .L -@Y
  1.  .S RES=0
  1.  Q:$Q RES
  1.  Q
  1.  ; Get global reference for lock node
  1. LOCKNODE(LN) ;
  1.  S:'$D(LN) LN=$NA(^[$G(CIAUCI)]XTMP("CIANBLIS",$G(CIAIP)_":"_CIAPORT_$S($G(CIAMODE)=2:":"_$J,1:"")))
  1.  Q:$Q LN
  1.  Q
  1.  ; Change process name to X
  1. CHPRN(X) D SETNM^%ZOSV($E(X,1,15))
  1.  Q