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

XWBRM.m

Go to the documentation of this file. 
  1. XWBRM ;OIFO-Oakland/REM - M2M Broker Server Request Mgr  ;4/6/06  10:21
  1.  ;;1.1;RPC BROKER;**28,45,62**;Mar 28, 1997;Build 13
  1.  ;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  QUIT
  1.  ;
  1.  ; ---------------------------------------------------------------------
  1.  ;                             Server Request Manager (SRM)
  1.  ; ---------------------------------------------------------------------
  1.  ;
  1. EN(XWBROOT) ; -- main entry point for SRM
  1.  NEW XWBOK,XWBOPT,XWBDATA,XWBMODE
  1.  N XWBM2M ;Flag for M2M requests **M2M
  1.  SET XWBOK=0,XWBM2M=0
  1.  ;
  1.  ; -- parse the xml
  1.  SET XWBOPT=""
  1.  DO EN^XWBRMX(XWBROOT,.XWBOPT,.XWBDATA)
  1.  S XWBMODE=$G(XWBDATA("MODE"))
  1.  ;access/verify RPC must be within first 2 calls P62
  1.  I $G(XWBAVC) D  Q:XWBAVC>1 '(XWBAVC=3)
  1.  . Q:$G(XWBDATA("URI"))="XUS SIGNON SETUP"
  1.  . I $G(XWBDATA("URI"))="XUS AV CODE" D EN^XWBRPC(.XWBDATA) S XWBAVC=2 Q
  1.  . S XWBCODES(2)="",XWBCODES=$G(XWBCODES)+1,XWBAVC=3
  1.  . D SECERR(.XWBCODES)
  1.  . Q
  1.  ;removed in P62
  1.  ;I $G(XWBDATA("URI"))="XUS GET VISITOR" D EN^XWBRPC(.XWBDATA) S XWBOK=1 S:'$D(DUZ) XWBSTOP=1 Q 1
  1.  ;Break off to RCPBroker **M2M
  1.  IF $G(XWBDATA("MODE"))="RPCBroker" D RPC^XWBM2MS(.XWBDATA) SET XWBSTOP=0
  1.  ; -- single call processing
  1.  IF $G(XWBDATA("MODE"),"single call")="single call" SET XWBSTOP=1
  1.  ;
  1.  ; -- check if app defined
  1.  IF $G(XWBDATA("APP"))="" DO RMERR(1) SET XWBOK=0 GOTO ENQ
  1.  ;
  1.  ; -- process close request
  1.  IF $G(XWBDATA("APP"))="CLOSE" DO  SET XWBOK=0 GOTO ENQ
  1.  . D:$G(DUZ) LOGOUT^XUSRB ;**M2M -Logout user and cleanup
  1.  . DO RESPONSE^XWBVL()
  1.  . SET XWBSTOP=1
  1.  ;
  1.  ; -- do security checks
  1.  IF $G(XWBDATA("MODE"))'="RPCBroker",'$$SECCHK() SET XWBOK=0 GOTO ENQ
  1.  ;
  1.  ; -- call app to write to socket
  1.  IF $G(XWBDATA("APP"))="RPC" DO EN^XWBRPC(.XWBDATA) SET XWBOK=1
  1.  ;
  1. ENQ ;
  1.  QUIT XWBOK
  1.  ;
  1.  ; ---------------------------------------------------------------------
  1.  ;
  1. SECCHK() ; -- do security checks  (no real checks at this time)
  1.  NEW XWBCODES
  1.  ;
  1.  ; -- is token valid
  1.  IF '$$CHKTOKEN($G(XWBDATA("SECTOKEN"))) SET XWBCODES(1)="",XWBCODES=$G(XWBCODES)+1
  1.  ;
  1.  ; -- is DUZ valid
  1.  IF '$$CHKDUZ($G(XWBDATA("DUZ"))) SET XWBCODES(2)="",XWBCODES=$G(XWBCODES)+1
  1.  ;
  1.  ; -- if security errors then send error response
  1.  IF $G(XWBCODES) D SECERR(.XWBCODES)
  1.  ;
  1.  QUIT '+$G(XWBCODES)
  1.  ;
  1. 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)
  1.  NEW XWBINVAL
  1.  SET XWBINVAL="#UNKNOWN#"
  1.  IF $G(XWBTOKEN,XWBINVAL)=XWBINVAL QUIT 0
  1.  QUIT 1
  1.  ;
  1. 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)
  1.  NEW XWBINVAL
  1.  SET XWBINVAL="#UNKNOWN#"
  1.  IF $G(XWBDUZ,XWBINVAL)=XWBINVAL QUIT 0
  1.  IF '$D(^VA(200,+XWBDUZ,0)) QUIT 0
  1.  QUIT 1
  1.  ;
  1.  ; ---------------------------------------------------------------------
  1.  ;                 Request Manager and Security Error Handlers
  1.  ; ---------------------------------------------------------------------
  1. RMERR(XWBCODE) ; -- send request error message
  1.  NEW XWBDAT,XWBMSG
  1.  SET XWBMSG=$P($TEXT(RMERRS+XWBCODE),";;",2)
  1.  SET XWBDAT("MESSAGE TYPE")="Gov.VA.Med.Foundations.Errors"
  1.  SET XWBDAT("ERRORS",1,"CODE")=1
  1.  SET XWBDAT("ERRORS",1,"ERROR TYPE")="request manager"
  1.  SET XWBDAT("ERRORS",1,"CDATA")=1
  1.  SET XWBDAT("ERRORS",1,"MESSAGE",1)="An Request Manager error occurred: "_XWBMSG
  1.  DO ERROR^XWBUTL(.XWBDAT)
  1.  QUIT
  1.  ;
  1. RMERRS ; -- application errors
  1.  ;;No valid application specified
  1.  ;;
  1.  ;
  1. SECERR(XWBCODES) ; -- send security error message and log
  1.  NEW XWBDAT,XWBCNT,XWBCODE
  1.  SET XWBCNT=0
  1.  SET XWBDAT("MESSAGE TYPE")="Gov.VA.Med.Foundations.Security.Errors"
  1.  SET XWBCODE=0 FOR  SET XWBCODE=$O(XWBCODES(XWBCODE)) Q:'XWBCODE  DO
  1.  . SET XWBCNT=XWBCNT+1
  1.  . SET XWBDAT("ERRORS",XWBCNT,"CODE")=XWBCODE
  1.  . SET XWBDAT("ERRORS",XWBCNT,"ERROR TYPE")="security"
  1.  . SET XWBDAT("ERRORS",XWBCNT,"MESSAGE",1)=$P($TEXT(SECERRS+XWBCODE),";;",2)
  1.  . SET XWBDAT("ERRORS",XWBCNT,"CDATA")=0
  1.  . D XTMP
  1.  DO ERROR^XWBUTL(.XWBDAT)
  1.  QUIT
  1.  ;
  1. SECERRS ; -- security errors
  1.  ;;Security token is either invalid or was not passed.
  1.  ;;DUZ is either invalid or was not passed.
  1.  ;;
  1.  ;
  1. XTMP ;
  1.  ;reset expiration date to T+7 on security log
  1.  S:'$G(^XTMP("XWBSEC"_DT,0)) ^(0)=$$FMADD^XLFDT(DT,7)_U_DT_U_0
  1.  S X=$P(^XTMP("XWBSEC"_DT,0),U,3)+1,$P(^(0),U,3)=X,^(X)=XWBCODE_U_$J_U_$G(IO("IP"))
  1.  Q