XWBRM ;OIFO-Oakland/REM - M2M Broker Server Request Mgr ;4/6/06 10:21
;;1.1;RPC BROKER;**28,45,62,64**;Mar 28, 1997;Build 12
;Per VHA Directive 6402, this routine should not be modified
;
QUIT
;
; ---------------------------------------------------------------------
; Server Request Manager (SRM)
; ---------------------------------------------------------------------
;
EN(XWBROOT) ; -- main entry point for SRM
NEW XWBOK,XWBOPT,XWBDATA,XWBMODE
N XWBM2M ;Flag for M2M requests **M2M
SET XWBOK=0,XWBM2M=0
;
; -- parse the xml
SET XWBOPT=""
DO EN^XWBRMX(XWBROOT,.XWBOPT,.XWBDATA)
S XWBMODE=$G(XWBDATA("MODE"))
;access/verify RPC must be within first 2 calls (p62)
;Identity and Access Management (IAM) Secure Token Service (STS) SAML token may be provided as an alternative to
; Access and Verify codes (p64)
I $G(XWBAVC) D Q:XWBAVC>1 '(XWBAVC=3)
. Q:$G(XWBDATA("URI"))="XUS SIGNON SETUP"
. I $G(XWBDATA("URI"))="XUS AV CODE" D EN^XWBRPC(.XWBDATA) S XWBAVC=2 Q
. I $G(XWBDATA("URI"))="XUS ESSO VALIDATE" D EN^XWBRPC(.XWBDATA) S XWBAVC=2 Q
. S XWBCODES(2)="",XWBCODES=$G(XWBCODES)+1,XWBAVC=3
. D SECERR(.XWBCODES)
. Q
;removed in P62
;I $G(XWBDATA("URI"))="XUS GET VISITOR" D EN^XWBRPC(.XWBDATA) S XWBOK=1 S:'$D(DUZ) XWBSTOP=1 Q 1
;Break off to RCPBroker **M2M
IF $G(XWBDATA("MODE"))="RPCBroker" D RPC^XWBM2MS(.XWBDATA) SET XWBSTOP=0
; -- single call processing
IF $G(XWBDATA("MODE"),"single call")="single call" SET XWBSTOP=1
;
; -- check if app defined
IF $G(XWBDATA("APP"))="" DO RMERR(1) SET XWBOK=0 GOTO ENQ
;
; -- process close request
IF $G(XWBDATA("APP"))="CLOSE" DO SET XWBOK=0 GOTO ENQ
. D:$G(DUZ) LOGOUT^XUSRB ;**M2M -Logout user and cleanup
. DO RESPONSE^XWBVL()
. SET XWBSTOP=1
;
; -- do security checks
IF $G(XWBDATA("MODE"))'="RPCBroker",'$$SECCHK() SET XWBOK=0 GOTO ENQ
;
; -- call app to write to socket
IF $G(XWBDATA("APP"))="RPC" DO EN^XWBRPC(.XWBDATA) SET XWBOK=1
;
ENQ ;
QUIT XWBOK
;
; ---------------------------------------------------------------------
;
SECCHK() ; -- do security checks (no real checks at this time)
NEW XWBCODES
;
; -- is token valid
IF '$$CHKTOKEN($G(XWBDATA("SECTOKEN"))) SET XWBCODES(1)="",XWBCODES=$G(XWBCODES)+1
;
; -- is DUZ valid
IF '$$CHKDUZ($G(XWBDATA("DUZ"))) SET XWBCODES(2)="",XWBCODES=$G(XWBCODES)+1
;
; -- if security errors then send error response
IF $G(XWBCODES) D SECERR(.XWBCODES)
;
QUIT '+$G(XWBCODES)
;
CHKTOKEN(XWBTOKEN) ; -- do check against token for validity
; -- // TODO: Need to check into how we might use XUS1B and related code in Kernel Sign-On (ESSO)
NEW XWBINVAL
SET XWBINVAL="#UNKNOWN#"
IF $G(XWBTOKEN,XWBINVAL)=XWBINVAL QUIT 0
QUIT 1
;
CHKDUZ(XWBDUZ) ; -- do check against DUZ for validity
; -- // TODO: Need to check into how we might use XUS1B and related code in Kernel Sign-On (ESSO)
NEW XWBINVAL
SET XWBINVAL="#UNKNOWN#"
IF $G(XWBDUZ,XWBINVAL)=XWBINVAL QUIT 0
IF '$D(^VA(200,+XWBDUZ,0)) QUIT 0
QUIT 1
;
; ---------------------------------------------------------------------
; Request Manager and Security Error Handlers
; ---------------------------------------------------------------------
RMERR(XWBCODE) ; -- send request error message
NEW XWBDAT,XWBMSG
SET XWBMSG=$P($TEXT(RMERRS+XWBCODE),";;",2)
SET XWBDAT("MESSAGE TYPE")="Gov.VA.Med.Foundations.Errors"
SET XWBDAT("ERRORS",1,"CODE")=1
SET XWBDAT("ERRORS",1,"ERROR TYPE")="request manager"
SET XWBDAT("ERRORS",1,"CDATA")=1
SET XWBDAT("ERRORS",1,"MESSAGE",1)="An Request Manager error occurred: "_XWBMSG
DO ERROR^XWBUTL(.XWBDAT)
QUIT
;
RMERRS ; -- application errors
;;No valid application specified
;;
;
SECERR(XWBCODES) ; -- send security error message and log
NEW XWBDAT,XWBCNT,XWBCODE
SET XWBCNT=0
SET XWBDAT("MESSAGE TYPE")="Gov.VA.Med.Foundations.Security.Errors"
SET XWBCODE=0 FOR SET XWBCODE=$O(XWBCODES(XWBCODE)) Q:'XWBCODE DO
. SET XWBCNT=XWBCNT+1
. SET XWBDAT("ERRORS",XWBCNT,"CODE")=XWBCODE
. SET XWBDAT("ERRORS",XWBCNT,"ERROR TYPE")="security"
. SET XWBDAT("ERRORS",XWBCNT,"MESSAGE",1)=$P($TEXT(SECERRS+XWBCODE),";;",2)
. SET XWBDAT("ERRORS",XWBCNT,"CDATA")=0
. D XTMP
DO ERROR^XWBUTL(.XWBDAT)
QUIT
;
SECERRS ; -- security errors
;;Security token is either invalid or was not passed.
;;DUZ is either invalid or was not passed.
;;
;
XTMP ;
;reset expiration date to T+7 on security log
S:'$G(^XTMP("XWBSEC"_DT,0)) ^(0)=$$FMADD^XLFDT(DT,7)_U_DT_U_0
S X=$P(^XTMP("XWBSEC"_DT,0),U,3)+1,$P(^(0),U,3)=X,^(X)=XWBCODE_U_$J_U_$G(IO("IP"))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXWBRM 4676 printed Oct 16, 2024@18:37:58 Page 2
XWBRM ;OIFO-Oakland/REM - M2M Broker Server Request Mgr ;4/6/06 10:21
+1 ;;1.1;RPC BROKER;**28,45,62,64**;Mar 28, 1997;Build 12
+2 ;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
+6 ; ---------------------------------------------------------------------
+7 ; Server Request Manager (SRM)
+8 ; ---------------------------------------------------------------------
+9 ;
EN(XWBROOT) ; -- main entry point for SRM
+1 NEW XWBOK,XWBOPT,XWBDATA,XWBMODE
+2 ;Flag for M2M requests **M2M
NEW XWBM2M
+3 SET XWBOK=0
SET XWBM2M=0
+4 ;
+5 ; -- parse the xml
+6 SET XWBOPT=""
+7 DO EN^XWBRMX(XWBROOT,.XWBOPT,.XWBDATA)
+8 SET XWBMODE=$GET(XWBDATA("MODE"))
+9 ;access/verify RPC must be within first 2 calls (p62)
+10 ;Identity and Access Management (IAM) Secure Token Service (STS) SAML token may be provided as an alternative to
+11 ; Access and Verify codes (p64)
+12 IF $GET(XWBAVC)
Begin DoDot:1
+13 if $GET(XWBDATA("URI"))="XUS SIGNON SETUP"
QUIT
+14 IF $GET(XWBDATA("URI"))="XUS AV CODE"
DO EN^XWBRPC(.XWBDATA)
SET XWBAVC=2
QUIT
+15 IF $GET(XWBDATA("URI"))="XUS ESSO VALIDATE"
DO EN^XWBRPC(.XWBDATA)
SET XWBAVC=2
QUIT
+16 SET XWBCODES(2)=""
SET XWBCODES=$GET(XWBCODES)+1
SET XWBAVC=3
+17 DO SECERR(.XWBCODES)
+18 QUIT
End DoDot:1
if XWBAVC>1
QUIT '(XWBAVC=3)
+19 ;removed in P62
+20 ;I $G(XWBDATA("URI"))="XUS GET VISITOR" D EN^XWBRPC(.XWBDATA) S XWBOK=1 S:'$D(DUZ) XWBSTOP=1 Q 1
+21 ;Break off to RCPBroker **M2M
+22 IF $GET(XWBDATA("MODE"))="RPCBroker"
DO RPC^XWBM2MS(.XWBDATA)
SET XWBSTOP=0
+23 ; -- single call processing
+24 IF $GET(XWBDATA("MODE"),"single call")="single call"
SET XWBSTOP=1
+25 ;
+26 ; -- check if app defined
+27 IF $GET(XWBDATA("APP"))=""
DO RMERR(1)
SET XWBOK=0
GOTO ENQ
+28 ;
+29 ; -- process close request
+30 IF $GET(XWBDATA("APP"))="CLOSE"
Begin DoDot:1
+31 ;**M2M -Logout user and cleanup
if $GET(DUZ)
DO LOGOUT^XUSRB
+32 DO RESPONSE^XWBVL()
+33 SET XWBSTOP=1
End DoDot:1
SET XWBOK=0
GOTO ENQ
+34 ;
+35 ; -- do security checks
+36 IF $GET(XWBDATA("MODE"))'="RPCBroker"
IF '$$SECCHK()
SET XWBOK=0
GOTO ENQ
+37 ;
+38 ; -- call app to write to socket
+39 IF $GET(XWBDATA("APP"))="RPC"
DO EN^XWBRPC(.XWBDATA)
SET XWBOK=1
+40 ;
ENQ ;
+1 QUIT XWBOK
+2 ;
+3 ; ---------------------------------------------------------------------
+4 ;
SECCHK() ; -- do security checks (no real checks at this time)
+1 NEW XWBCODES
+2 ;
+3 ; -- is token valid
+4 IF '$$CHKTOKEN($GET(XWBDATA("SECTOKEN")))
SET XWBCODES(1)=""
SET XWBCODES=$GET(XWBCODES)+1
+5 ;
+6 ; -- is DUZ valid
+7 IF '$$CHKDUZ($GET(XWBDATA("DUZ")))
SET XWBCODES(2)=""
SET XWBCODES=$GET(XWBCODES)+1
+8 ;
+9 ; -- if security errors then send error response
+10 IF $GET(XWBCODES)
DO SECERR(.XWBCODES)
+11 ;
+12 QUIT '+$GET(XWBCODES)
+13 ;
CHKTOKEN(XWBTOKEN) ; -- do check against token for validity
+1 ; -- // TODO: Need to check into how we might use XUS1B and related code in Kernel Sign-On (ESSO)
+2 NEW XWBINVAL
+3 SET XWBINVAL="#UNKNOWN#"
+4 IF $GET(XWBTOKEN,XWBINVAL)=XWBINVAL
QUIT 0
+5 QUIT 1
+6 ;
CHKDUZ(XWBDUZ) ; -- do check against DUZ for validity
+1 ; -- // TODO: Need to check into how we might use XUS1B and related code in Kernel Sign-On (ESSO)
+2 NEW XWBINVAL
+3 SET XWBINVAL="#UNKNOWN#"
+4 IF $GET(XWBDUZ,XWBINVAL)=XWBINVAL
QUIT 0
+5 IF '$DATA(^VA(200,+XWBDUZ,0))
QUIT 0
+6 QUIT 1
+7 ;
+8 ; ---------------------------------------------------------------------
+9 ; Request Manager and Security Error Handlers
+10 ; ---------------------------------------------------------------------
RMERR(XWBCODE) ; -- send request error message
+1 NEW XWBDAT,XWBMSG
+2 SET XWBMSG=$PIECE($TEXT(RMERRS+XWBCODE),";;",2)
+3 SET XWBDAT("MESSAGE TYPE")="Gov.VA.Med.Foundations.Errors"
+4 SET XWBDAT("ERRORS",1,"CODE")=1
+5 SET XWBDAT("ERRORS",1,"ERROR TYPE")="request manager"
+6 SET XWBDAT("ERRORS",1,"CDATA")=1
+7 SET XWBDAT("ERRORS",1,"MESSAGE",1)="An Request Manager error occurred: "_XWBMSG
+8 DO ERROR^XWBUTL(.XWBDAT)
+9 QUIT
+10 ;
RMERRS ; -- application errors
+1 ;;No valid application specified
+2 ;;
+3 ;
SECERR(XWBCODES) ; -- send security error message and log
+1 NEW XWBDAT,XWBCNT,XWBCODE
+2 SET XWBCNT=0
+3 SET XWBDAT("MESSAGE TYPE")="Gov.VA.Med.Foundations.Security.Errors"
+4 SET XWBCODE=0
FOR
SET XWBCODE=$ORDER(XWBCODES(XWBCODE))
if 'XWBCODE
QUIT
Begin DoDot:1
+5 SET XWBCNT=XWBCNT+1
+6 SET XWBDAT("ERRORS",XWBCNT,"CODE")=XWBCODE
+7 SET XWBDAT("ERRORS",XWBCNT,"ERROR TYPE")="security"
+8 SET XWBDAT("ERRORS",XWBCNT,"MESSAGE",1)=$PIECE($TEXT(SECERRS+XWBCODE),";;",2)
+9 SET XWBDAT("ERRORS",XWBCNT,"CDATA")=0
+10 DO XTMP
End DoDot:1
+11 DO ERROR^XWBUTL(.XWBDAT)
+12 QUIT
+13 ;
SECERRS ; -- security errors
+1 ;;Security token is either invalid or was not passed.
+2 ;;DUZ is either invalid or was not passed.
+3 ;;
+4 ;
XTMP ;
+1 ;reset expiration date to T+7 on security log
+2 if '$GET(^XTMP("XWBSEC"_DT,0))
SET ^(0)=$$FMADD^XLFDT(DT,7)_U_DT_U_0
+3 SET X=$PIECE(^XTMP("XWBSEC"_DT,0),U,3)+1
SET $PIECE(^(0),U,3)=X
SET ^(X)=XWBCODE_U_$JOB_U_$GET(IO("IP"))
+4 QUIT
