174 lines
8.7 KiB
Mathematica
174 lines
8.7 KiB
Mathematica
XOBSCAV2 ;; kec/oak - VistaLink Access/Verify Security ; 12/09/2002 17:00
|
|
;;1.5;VistALink Security;;Sep 09, 2005
|
|
;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
|
|
;;
|
|
QUIT
|
|
;
|
|
; --------------------------------------------------------------------
|
|
; Access/Verify Security: Security Message Request Handler
|
|
; (AV.GetUserDemographics req/resp pairs; XML parser callbacks)
|
|
; --------------------------------------------------------------------
|
|
;
|
|
;==== AV.GetUserDemographics.Request message processing ====
|
|
SENDDEM ; respond to user demographics request
|
|
IF '$$LOGGEDON^XOBSCAV() DO SENDDEM0("User not logged on.")
|
|
DO SENDDEM1
|
|
QUIT
|
|
SENDDEM1 ; success
|
|
NEW XOBMSG,XOBI,XOBNC,XOBNC1,XOBDIV,XOBRET,XOBERR,XOBTXT
|
|
; get ptr to Name Components file
|
|
DO GETS^DIQ(200,DUZ_",","10.1","I","XOBNC","XOBERR")
|
|
IF $DATA(XOBERR) DO QUIT
|
|
.SET XOBI=0,XOBTXT="FileMan Error: "
|
|
.FOR SET XOBI=$ORDER(XOBERR("DIERR",XOBI)) QUIT:'+XOBI SET XOBTXT=XOBTXT_XOBERR("DIERR",XOBI)_" "_XOBERR("DIERR",XOBI,"TEXT",1)
|
|
.DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Demographics failure",183006,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183006,.XOBTXT)))
|
|
SET XOBNC=XOBNC(200,DUZ_",",10.1,"I")
|
|
; get name components -- read access to file 20: DBIA# 3041
|
|
DO GETS^DIQ(20,XOBNC_",","1:6","","XOBNC1","XOBERR")
|
|
IF $DATA(XOBERR) DO QUIT
|
|
.SET XOBI=0,XOBTXT="FileMan Error: "
|
|
.FOR SET XOBI=$ORDER(XOBERR("DIERR",XOBI)) QUIT:'+XOBI SET XOBTXT=XOBTXT_XOBERR("DIERR",XOBI)_" "_XOBERR("DIERR",XOBI,"TEXT",1)
|
|
.DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Demographics failure",183006,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183006,.XOBTXT)))
|
|
; get more userinfo from Kernel
|
|
DO USERINFO^XUSRB2(.XOBRET) ; use of USERINFO^XUSRB2: DBIA #4055
|
|
; strip any illegal xml chars from data
|
|
FOR XOBI=1:1:7 SET XOBRET(XOBI)=$$CHARCHK^XOBVLIB(XOBRET(XOBI))
|
|
FOR XOBI=1:1:6 SET XOBNC1(20,XOBNC_",",XOBI)=$$CHARCHK^XOBVLIB(XOBNC1(20,XOBNC_",",XOBI))
|
|
; format return message
|
|
SET XOBMSG(1)="<NameInfo prefix='"_XOBNC1(20,XOBNC_",",4)_"' givenFirst='"_XOBNC1(20,XOBNC_",",2)_"' middle='"_XOBNC1(20,XOBNC_",",3)
|
|
SET XOBMSG(1)=XOBMSG(1)_"' familyLast='"_XOBNC1(20,XOBNC_",",1)_"' suffix='"_XOBNC1(20,XOBNC_",",5)
|
|
SET XOBMSG(1)=XOBMSG(1)_"' degree='"_XOBNC1(20,XOBNC_",",6)_"' newPerson01Name='"_XOBRET(1)_"' standardConcatenated='"_XOBRET(2)_"' />"
|
|
SET XOBMSG(2)="<UserInfo duz='"_DUZ_"' title='"_$$CHARCHK^XOBVLIB(XOBRET(4))_"' serviceSection='"_$$CHARCHK^XOBVLIB(XOBRET(5))_"' language='"_$$CHARCHK^XOBVLIB(XOBRET(6))_"' timeout='"_$$CHARCHK^XOBVLIB(XOBRET(7))
|
|
SET XOBMSG(2)=XOBMSG(2)_"' vpid='"_$$CHARCHK^XOBVLIB($G(XOBRET(8)))_"' />"
|
|
SET XOBMSG(3)="<Division ien='"_$$CHARCHK^XOBVLIB($PIECE(XOBRET(3),U))_"' divName='"_$$CHARCHK^XOBVLIB($PIECE(XOBRET(3),U,2))_"' divNumber='"_$$CHARCHK^XOBVLIB($PIECE(XOBRET(3),U,3))_"' />"
|
|
SET XOBMSG(4)="<SiteInfo domainName='"_$$KSP^XUPARAM("WHERE")_"'/>"
|
|
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUSERD^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHUSERD^XOBSCAV),";;",2))
|
|
QUIT
|
|
SENDDEM0(XOBTEXT) ; failure
|
|
NEW XOBMSG
|
|
SET XOBMSG(1)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB(XOBTEXT)_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
|
|
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUSERD^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
|
|
QUIT
|
|
;
|
|
; ==== SAX Parser Callbacks ====
|
|
;
|
|
ELEST(ELE,ATR) ; -- element start event handler
|
|
;
|
|
IF ELE="VistaLink" DO QUIT
|
|
. SET XOBDATA("MODE")=$GET(ATR("mode"),"singleton")
|
|
. SET XOBDATA("XOB SECAV","SECURITYTYPE")=$GET(ATR("messageType"),"unknown")
|
|
;
|
|
IF ELE="SecurityInfo" DO QUIT
|
|
. SET XOBDATA("XOB SECAV","SECURITYVERSION")=$GET(ATR("version"),"unknown")
|
|
;
|
|
IF ELE="Request" DO QUIT
|
|
. SET XOBDATA("XOB SECAV","SECURITYACTION")=$GET(ATR("type"),"unknown")
|
|
;
|
|
IF XOBDATA("XOB SECAV","SECURITYTYPE")'=$$MSGTYP^XOBSCAV("request") DO QUIT
|
|
.;if not a security request, shouldn't be here
|
|
.;
|
|
IF '$DATA(XOBDATA("XOB SECAV","SECURITYACTION")) DO QUIT
|
|
.;if haven't processed the "action" yet, shouldn't be here
|
|
;
|
|
IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.SetupAndIntroText" DO QUIT
|
|
. IF ELE="productionInfo" DO
|
|
. . SET XOBDATA("CLIENTISPRODUCTION")=$GET(ATR("clientIsProduction"))
|
|
. . SET XOBDATA("CLIENTPRIMARYSTATION")=$GET(ATR("clientPrimaryStation"))
|
|
;
|
|
IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.GetUserDemographics" DO QUIT
|
|
.; nothing needed
|
|
.;
|
|
IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.Logon" DO QUIT
|
|
.IF ELE="avCodes" SET XOBAVCOD=""
|
|
.SET XOBDATA("XOB SECAV","REQUESTCVC")=$GET(ATR("requestCvc"))
|
|
;
|
|
IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.Logout" DO QUIT
|
|
.; nothing needed
|
|
;
|
|
IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.SelectDivision" DO QUIT
|
|
.IF ELE="Division" SET XOBDATA("XOB SECAV","SELECTEDDIVISION")=$GET(ATR("ien"))
|
|
;
|
|
IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.UpdateVC" DO QUIT
|
|
.IF ELE="oldVc" SET XOBVCOLD="" QUIT
|
|
.IF ELE="newVc" SET XOBVCNEW="" QUIT
|
|
.IF ELE="confirmedVc" SET XOBVCCHK="" QUIT
|
|
;
|
|
;If got here -- an unknown type, ignore.
|
|
;
|
|
QUIT
|
|
;
|
|
ELEND(ELE) ; -- element end event handler
|
|
;
|
|
IF ELE="VistaLink" KILL XOBAVCOD,XOBVCOLD,XOBVCNEW,XOBVCCHK QUIT
|
|
IF $GET(XOBDATA("XOB SECAV","SECURITYACTION"))="AV.Logon",ELE="avCodes" DO QUIT
|
|
.SET XOBDATA("XOB SECAV","AVCODE")=XOBAVCOD KILL XOBAVCOD
|
|
IF $GET(XOBDATA("XOB SECAV","SECURITYACTION"))="AV.UpdateVC" DO QUIT
|
|
.IF ELE="oldVc" SET XOBDATA("XOB SECAV","OLDVC")=XOBVCOLD KILL XOBVCOLD QUIT
|
|
.IF ELE="newVc" SET XOBDATA("XOB SECAV","NEWVC")=XOBVCNEW KILL XOBVCNEW QUIT
|
|
.IF ELE="confirmedVc" SET XOBDATA("XOB SECAV","NEWVCCHECK")=XOBVCCHK KILL XOBVCCHK QUIT
|
|
.;shouldn't get here.
|
|
QUIT
|
|
;
|
|
CHR(TEXT) ; -- character value event handler <tag>TEXT</tag)
|
|
; -- need to concatenate because MXML parses on ENTITY characters (<>& etc.) and
|
|
; callback gets hit multiple times even though the tag text value is just one piece of data.
|
|
; (Yes, this seems kludgie!)
|
|
IF $DATA(XOBAVCOD) SET XOBAVCOD=XOBAVCOD_TEXT QUIT
|
|
IF $DATA(XOBVCOLD) SET XOBVCOLD=XOBVCOLD_TEXT QUIT
|
|
IF $DATA(XOBVCNEW) SET XOBVCNEW=XOBVCNEW_TEXT QUIT
|
|
IF $DATA(XOBVCCHK) SET XOBVCCHK=XOBVCCHK_TEXT QUIT
|
|
QUIT
|
|
;==== AV.UpdateVC.Request message processing ====
|
|
SENDNVC ; respond to "change verify code" request. Use of CVC^XUSRB per DBIA #4054
|
|
NEW XOBRET,XOBRETDV,XOBSDUZ
|
|
SET XOBSDUZ=DUZ ; save DUZ in case of failure - we need to restore
|
|
DO CVC^XUSRB(.XOBRET,XOBDATA("XOB SECAV","OLDVC")_U_XOBDATA("XOB SECAV","NEWVC")_U_XOBDATA("XOB SECAV","NEWVCCHECK"))
|
|
IF +$GET(DUZ) DO QUIT ; success changing verify code
|
|
.; check the divisions now
|
|
.DO DIVGET^XUSRB2(.XOBRETDV,DUZ) ; use of DIVGET^XUSRB2: DBIA #4055
|
|
.IF '+XOBRETDV(0) DO SENDNVC1 QUIT
|
|
.; otherwise this is a multidivisional user
|
|
.DO SENDNVCD(.XOBRETDV)
|
|
; cvc failed
|
|
SET DUZ=XOBSDUZ ; restore DUZ
|
|
DO SENDNVC0 ; failure
|
|
QUIT
|
|
SENDNVC1 ; send verify code update success
|
|
;update the vc/finish the logon
|
|
NEW XOBMSG
|
|
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUPDVC^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
|
|
QUIT
|
|
SENDNVC0 ; send verify code update error
|
|
;update the vc/finish the logon
|
|
NEW XOBMSG,XOBI
|
|
SET XOBMSG(1)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB($GET(XOBRET(1)))_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
|
|
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUPDVC^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
|
|
QUIT
|
|
SENDNVCD(XOBDIVS) ; send verify code partial success, need divisions
|
|
;XOBDIVS is in format of output from DIVGET^XUSRB2
|
|
NEW XOBMSG,XOBI,XOBLINE
|
|
SET XOBLINE=$$ADDDIVS^XOBSCAV(.XOBDIVS,.XOBMSG)
|
|
DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUPDVC^XOBSCAV),";;",2),.XOBMSG,$$PARTIAL^XOBSCAV(),$PIECE($TEXT(SCHPARTS^XOBSCAV),";;",2))
|
|
QUIT
|
|
;
|
|
;==== utility functions ====
|
|
;
|
|
GETINTRO(XOBSREF,XOBSCNTR) ;
|
|
; XOBSREF: variable in which to store intro text (at one level descendant)
|
|
; XOBSCNT: integer subscript counter value at which to start storing text
|
|
; returns: XOBSREF containing <IntroText> element text with intro text lines in CDATA section
|
|
; XOBSCNT incremented to last subscript at which text was stored (if passed as dot-arg)
|
|
;
|
|
NEW XOBCCMSK,XOBI,XOBITINF,XOBTMP1
|
|
; get intro text
|
|
DO INTRO^XUSRB(.XOBITINF) ; use of INTRO^XUSRB: DBIA #4054
|
|
; set up control character mask
|
|
SET XOBCCMSK="" FOR XOBI=0:1:8,11,12,14:1:31 SET XOBCCMSK=XOBCCMSK_$CHAR(XOBI)
|
|
; populate/format return value
|
|
SET @XOBSREF@(XOBSCNTR)="<IntroText><![CDATA["
|
|
SET XOBTMP1=-1 FOR SET XOBTMP1=$ORDER(XOBITINF(XOBTMP1)) QUIT:XOBTMP1']"" DO
|
|
.SET XOBSCNTR=XOBSCNTR+1,@XOBSREF@(XOBSCNTR)=$TRANSLATE(XOBITINF(XOBTMP1),XOBCCMSK,"")_"<BR>"
|
|
SET XOBSCNTR=XOBSCNTR+1,@XOBSREF@(XOBSCNTR)="]]></IntroText>"
|
|
QUIT
|
|
;
|