| 1 | XWBRM ;OIFO-Oakland/REM - M2M Broker Server Request Mgr ;4/6/06 10:21
|
|---|
| 2 | ;;1.1;RPC BROKER;**28,45**;Mar 28, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | QUIT
|
|---|
| 5 | ;
|
|---|
| 6 | ; ---------------------------------------------------------------------
|
|---|
| 7 | ; Server Request Manager (SRM)
|
|---|
| 8 | ; ---------------------------------------------------------------------
|
|---|
| 9 | ;
|
|---|
| 10 | EN(XWBROOT) ; -- main entry point for SRM
|
|---|
| 11 | NEW XWBOK,XWBOPT,XWBDATA,XWBMODE
|
|---|
| 12 | N XWBM2M ;Flag for M2M requests **M2M
|
|---|
| 13 | SET XWBOK=0,XWBM2M=0
|
|---|
| 14 | ;
|
|---|
| 15 | ; -- parse the xml
|
|---|
| 16 | SET XWBOPT=""
|
|---|
| 17 | DO EN^XWBRMX(XWBROOT,.XWBOPT,.XWBDATA)
|
|---|
| 18 | S XWBMODE=$G(XWBDATA("MODE"))
|
|---|
| 19 | ;M ^REM($J)=XWBDATA ;**TEST ONLY
|
|---|
| 20 | ;
|
|---|
| 21 | I $G(XWBDATA("URI"))="XUS GET VISITOR" D EN^XWBRPC(.XWBDATA) S XWBOK=1 S:'$D(DUZ) XWBSTOP=1 Q 1
|
|---|
| 22 | ;Break off to RCPBroker **M2M
|
|---|
| 23 | IF $G(XWBDATA("MODE"))="RPCBroker" D RPC^XWBM2MS(.XWBDATA) SET XWBSTOP=0
|
|---|
| 24 | ; -- single call processing
|
|---|
| 25 | IF $G(XWBDATA("MODE"),"single call")="single call" SET XWBSTOP=1
|
|---|
| 26 | ;
|
|---|
| 27 | ; -- check if app defined
|
|---|
| 28 | IF $G(XWBDATA("APP"))="" DO RMERR(1) SET XWBOK=0 GOTO ENQ
|
|---|
| 29 | ;
|
|---|
| 30 | ; -- process close request
|
|---|
| 31 | IF $G(XWBDATA("APP"))="CLOSE" DO SET XWBOK=0 GOTO ENQ
|
|---|
| 32 | . D:$G(DUZ) LOGOUT^XUSRB ;**M2M -Logout user and cleanup
|
|---|
| 33 | . DO RESPONSE^XWBVL()
|
|---|
| 34 | . SET XWBSTOP=1
|
|---|
| 35 | ;
|
|---|
| 36 | ; -- do security checks
|
|---|
| 37 | IF $G(XWBDATA("MODE"))'="RPCBroker",'$$SECCHK() SET XWBOK=0 GOTO ENQ
|
|---|
| 38 | ;
|
|---|
| 39 | ; -- call app to write to socket
|
|---|
| 40 | IF $G(XWBDATA("APP"))="RPC" DO EN^XWBRPC(.XWBDATA) SET XWBOK=1
|
|---|
| 41 | ;
|
|---|
| 42 | ENQ ;
|
|---|
| 43 | QUIT XWBOK
|
|---|
| 44 | ;
|
|---|
| 45 | ; ---------------------------------------------------------------------
|
|---|
| 46 | ;
|
|---|
| 47 | SECCHK() ; -- do security checks (no real checks at this time)
|
|---|
| 48 | NEW XWBCODES
|
|---|
| 49 | ;
|
|---|
| 50 | ; -- is token valid
|
|---|
| 51 | IF '$$CHKTOKEN($G(XWBDATA("SECTOKEN"))) SET XWBCODES(1)="",XWBCODES=$G(XWBCODES)+1
|
|---|
| 52 | ;
|
|---|
| 53 | ; -- is DUZ valid
|
|---|
| 54 | IF '$$CHKDUZ($G(XWBDATA("DUZ"))) SET XWBCODES(2)="",XWBCODES=$G(XWBCODES)+1
|
|---|
| 55 | ;
|
|---|
| 56 | ; -- if security errors then send error response
|
|---|
| 57 | IF $G(XWBCODES) D SECERR(.XWBCODES)
|
|---|
| 58 | ;
|
|---|
| 59 | QUIT '+$G(XWBCODES)
|
|---|
| 60 | ;
|
|---|
| 61 | CHKTOKEN(XWBTOKEN) ; -- do check against token for validity
|
|---|
| 62 | ; -- // TODO: Need to check into how we might use XUS1B and related code in Kernel Sign-On (ESSO)
|
|---|
| 63 | NEW XWBINVAL
|
|---|
| 64 | SET XWBINVAL="#UNKNOWN#"
|
|---|
| 65 | IF $G(XWBTOKEN,XWBINVAL)=XWBINVAL QUIT 0
|
|---|
| 66 | QUIT 1
|
|---|
| 67 | ;
|
|---|
| 68 | CHKDUZ(XWBDUZ) ; -- do check against DUZ for validity
|
|---|
| 69 | ; -- // TODO: Need to check into how we might use XUS1B and related code in Kernel Sign-On (ESSO)
|
|---|
| 70 | NEW XWBINVAL
|
|---|
| 71 | SET XWBINVAL="#UNKNOWN#"
|
|---|
| 72 | IF $G(XWBDUZ,XWBINVAL)=XWBINVAL QUIT 0
|
|---|
| 73 | IF '$D(^VA(200,+XWBDUZ,0)) QUIT 0
|
|---|
| 74 | QUIT 1
|
|---|
| 75 | ;
|
|---|
| 76 | ; ---------------------------------------------------------------------
|
|---|
| 77 | ; Request Manager and Security Error Handlers
|
|---|
| 78 | ; ---------------------------------------------------------------------
|
|---|
| 79 | RMERR(XWBCODE) ; -- send request error message
|
|---|
| 80 | NEW XWBDAT,XWBMSG
|
|---|
| 81 | SET XWBMSG=$P($TEXT(RMERRS+XWBCODE),";;",2)
|
|---|
| 82 | SET XWBDAT("MESSAGE TYPE")="Gov.VA.Med.Foundations.Errors"
|
|---|
| 83 | SET XWBDAT("ERRORS",1,"CODE")=1
|
|---|
| 84 | SET XWBDAT("ERRORS",1,"ERROR TYPE")="request manager"
|
|---|
| 85 | SET XWBDAT("ERRORS",1,"CDATA")=1
|
|---|
| 86 | SET XWBDAT("ERRORS",1,"MESSAGE",1)="An Request Manager error occurred: "_XWBMSG
|
|---|
| 87 | DO ERROR^XWBUTL(.XWBDAT)
|
|---|
| 88 | QUIT
|
|---|
| 89 | ;
|
|---|
| 90 | RMERRS ; -- application errors
|
|---|
| 91 | ;;No valid application specified.
|
|---|
| 92 | ;
|
|---|
| 93 | SECERR(XWBCODES) ; -- send security error message
|
|---|
| 94 | NEW XWBDAT,XWBCNT,XWBCODE
|
|---|
| 95 | SET XWBCNT=0
|
|---|
| 96 | SET XWBDAT("MESSAGE TYPE")="Gov.VA.Med.Foundations.Security.Errors"
|
|---|
| 97 | SET XWBCODE=0 FOR SET XWBCODE=$O(XWBCODES(XWBCODE)) Q:'XWBCODE DO
|
|---|
| 98 | . SET XWBCNT=XWBCNT+1
|
|---|
| 99 | . SET XWBDAT("ERRORS",XWBCNT,"CODE")=XWBCODE
|
|---|
| 100 | . SET XWBDAT("ERRORS",XWBCNT,"ERROR TYPE")="security"
|
|---|
| 101 | . SET XWBDAT("ERRORS",XWBCNT,"MESSAGE",1)=$P($TEXT(SECERRS+XWBCODE),";;",2)
|
|---|
| 102 | . SET XWBDAT("ERRORS",XWBCNT,"CDATA")=0
|
|---|
| 103 | DO ERROR^XWBUTL(.XWBDAT)
|
|---|
| 104 | QUIT
|
|---|
| 105 | ;
|
|---|
| 106 | SECERRS ; -- security errors
|
|---|
| 107 | ;;Security token is either invalid or was not passed.
|
|---|
| 108 | ;;DUZ is either invalid or was not passed.
|
|---|
| 109 | ;;
|
|---|
