XWBSEC.m

XWBSEC ;SFISC/VYD - RPC BROKER ;02/03/10  11:37

 ;;1.1;RPC BROKER;**3,6,10,35,53**;Mar 28, 1997;Build 5

CHKPRMIT(XWBRP) ;checks to see if remote procedure is permited to run

 ;Input:  XWBRP - Remote procedure to check

 Q:$$KCHK^XUSRB("XUPROGMODE")

 N ERR,XWBPRMIT,XWBALLOW

 S U="^",XWBSEC="" ;Return XWBSEC="" if OK to run RPC

 ;

 ;In the beginning, when no DUZ is defined and no context exist, setup

 ;default signon context

 S:'$G(DUZ) DUZ=0,XQY0="XUS SIGNON"   ;set up default context

 ;

 ;These RPC's are allowed in any context, so we can just quit

 I "^XWB IM HERE^XWB CREATE CONTEXT^XWB RPC LIST^XWB IS RPC AVAILABLE^XUS GET USER INFO^XUS GET TOKEN^XUS SET VISITOR^"[(U_XWBRP_U) Q  ;p53

 ;VistAlink RPC's that are always allowed.

 I "^XUS KAAJEE GET USER INFO^XUS KAAJEE LOGOUT^"[(U_XWBRP_U) Q

 ;

 ;If in Signon context, only allow XUS and XWB rpc's

 I $G(XQY0)="XUS SIGNON","^XUS^XWB^"'[(U_$E(XWBRP,1,3)_U) S XWBSEC="Application context has not been created!" Q

 ;XQCS allows all users access to the XUS SIGNON context.

 ;Also to any context in the XUCOMMAND menu.

 ;

 I $G(XQY0)'="" D  ;1.1*6. XQY0="" after XUS SIGNON context deleted.

 . S XWBALLOW=$$CHK^XQCS(DUZ,$P(XQY0,U),XWBRP)         ;do the check

 . S:'XWBALLOW XWBSEC=XWBALLOW

 E  S XWBSEC="Application context has not been created!"

 Q

 ;

 ;

CRCONTXT(RESULT,OPTION) ;creates context for the passed in option

 K XQY0,XQY N XWB1,XABPGMOD,XWBPGMOD S RESULT=0

 S OPTION=$$DECRYP^XUSRB1(OPTION) ;S:OPTION="" OPTION="\"

 I OPTION="" S XQY=0,XQY0="",RESULT=1 Q  ;delete context if "" passed in.

 S XWB1=$$OPTLK^XQCS(OPTION)

 I XWB1="" S (XWBSEC,RESULT)="The context '"_OPTION_"' does not exist on server." Q  ;P10

 S RESULT=$$CHK^XQCS(DUZ,XWB1)

 ;Access or programmer

 S XWBPGMOD=$$KCHK^XUSRB("XUPROGMODE")

 I RESULT!XWBPGMOD S XQY0=OPTION,XQY=XWB1,RESULT=1

 E  S XWBSEC=RESULT

 Q

 ;

 ;

STATE(%) ;Return a state value

 Q:'$L($G(%)) $G(XWBSTATE)

 Q $G(XWBSTATE(%))

 ;

 ;

SET(%,VALUE) ;Set the state variable

 I $G(%)="" S XWBSTATE=VALUE

 S XWBSTATE(%)=VALUE

 Q

KILL(%) ;Kill state variable

 I $L($G(%)) K XWBSTATE(%)

 Q

XWBSEC    ;SFISC/VYD - RPC BROKER ;02/03/10  11:37

 +1       ;;1.1;RPC BROKER;**3,6,10,35,53**;Mar 28, 1997;Build 5

CHKPRMIT(XWBRP) ;checks to see if remote procedure is permited to run

 +1       ;Input:  XWBRP - Remote procedure to check

 +2        IF $$KCHK^XUSRB("XUPROGMODE")

               QUIT 

 +3        NEW ERR,XWBPRMIT,XWBALLOW

 +4       ;Return XWBSEC="" if OK to run RPC

           SET U="^"

           SET XWBSEC=""

 +5       ;

 +6       ;In the beginning, when no DUZ is defined and no context exist, setup

 +7       ;default signon context

 +8       ;set up default context

           IF '$GET(DUZ)

               SET DUZ=0

               SET XQY0="XUS SIGNON"

 +9       ;

 +10      ;These RPC's are allowed in any context, so we can just quit

 +11      ;p53

           IF "^XWB IM HERE^XWB CREATE CONTEXT^XWB RPC LIST^XWB IS RPC AVAILABLE^XUS GET USER INFO^XUS GET TOKEN^XUS SET VISITOR^"[(U_XWBRP_U)

               QUIT 

 +12      ;VistAlink RPC's that are always allowed.

 +13       IF "^XUS KAAJEE GET USER INFO^XUS KAAJEE LOGOUT^"[(U_XWBRP_U)

               QUIT 

 +14      ;

 +15      ;If in Signon context, only allow XUS and XWB rpc's

 +16       IF $GET(XQY0)="XUS SIGNON"

               IF "^XUS^XWB^"'[(U_$EXTRACT(XWBRP,1,3)_U)

                   SET XWBSEC="Application context has not been created!"

                   QUIT 

 +17      ;XQCS allows all users access to the XUS SIGNON context.

 +18      ;Also to any context in the XUCOMMAND menu.

 +19      ;

 +20      ;1.1*6. XQY0="" after XUS SIGNON context deleted.

           IF $GET(XQY0)'=""

               Begin DoDot:1

 +21      ;do the check

                   SET XWBALLOW=$$CHK^XQCS(DUZ,$PIECE(XQY0,U),XWBRP)

 +22               IF 'XWBALLOW

                       SET XWBSEC=XWBALLOW

               End DoDot:1

 +23      IF '$TEST

               SET XWBSEC="Application context has not been created!"

 +24       QUIT 

 +25      ;

 +26      ;

CRCONTXT(RESULT,OPTION) ;creates context for the passed in option

 +1        KILL XQY0,XQY

           NEW XWB1,XABPGMOD,XWBPGMOD

           SET RESULT=0

 +2       ;S:OPTION="" OPTION="\"

           SET OPTION=$$DECRYP^XUSRB1(OPTION)

 +3       ;delete context if "" passed in.

           IF OPTION=""

               SET XQY=0

               SET XQY0=""

               SET RESULT=1

               QUIT 

 +4        SET XWB1=$$OPTLK^XQCS(OPTION)

 +5       ;P10

           IF XWB1=""

               SET (XWBSEC,RESULT)="The context '"_OPTION_"' does not exist on server."

               QUIT 

 +6        SET RESULT=$$CHK^XQCS(DUZ,XWB1)

 +7       ;Access or programmer

 +8        SET XWBPGMOD=$$KCHK^XUSRB("XUPROGMODE")

 +9        IF RESULT!XWBPGMOD

               SET XQY0=OPTION

               SET XQY=XWB1

               SET RESULT=1

 +10      IF '$TEST

               SET XWBSEC=RESULT

 +11       QUIT 

 +12      ;

 +13      ;

STATE(%)  ;Return a state value

 +1        IF '$LENGTH($GET(%))

               QUIT $GET(XWBSTATE)

 +2        QUIT $GET(XWBSTATE(%))

 +3       ;

 +4       ;

SET(%,VALUE) ;Set the state variable

 +1        IF $GET(%)=""

               SET XWBSTATE=VALUE

 +2        SET XWBSTATE(%)=VALUE

 +3        QUIT 

KILL(%)   ;Kill state variable

 +1        IF $LENGTH($GET(%))

               KILL XWBSTATE(%)

 +2        QUIT