| 1 | XOBSCAV1 ;; kec/oak - VistaLink Access/Verify Security ; [6/28/06 2:26pm]
|
|---|
| 2 | ;;1.5;VistALink Security;**1**;Sep 09, 2005;Build 3
|
|---|
| 3 | ;;Foundations Toolbox Release v1.5 [Build: 1.5.1.001]
|
|---|
| 4 | ;;
|
|---|
| 5 | QUIT
|
|---|
| 6 | ;
|
|---|
| 7 | ; Access/Verify Security: Security Message Request Handler
|
|---|
| 8 | ; specific message request/response pairs)
|
|---|
| 9 | ;
|
|---|
| 10 | ; ** Setting/Killing of DUZ covered by blanket SAC Kernel exemption for Foundations
|
|---|
| 11 | ;
|
|---|
| 12 | ; ::AV.SetupAndIntroText.Request message processing
|
|---|
| 13 | SENDITXT ; Do Setup and send Intro Text
|
|---|
| 14 | NEW XOBSTINF,XOBITINF,XOBMSG,XOBTMP,XOBTMP1,XOBCCMSK,XOBI,XOBPROD
|
|---|
| 15 | ;
|
|---|
| 16 | IF $$PRODMISM() DO QUIT
|
|---|
| 17 | . NEW XOBSPAR SET XOBSPAR(1)=$GET(XOBDATA("CLIENTISPRODUCTION")),XOBSPAR(2)=$SELECT($$PROD^XUPROD(0):"true",1:"false")
|
|---|
| 18 | . DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Production-Test Mismatch",183007,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183007,.XOBSPAR)))
|
|---|
| 19 | ;
|
|---|
| 20 | IF $$STATMISM() DO QUIT
|
|---|
| 21 | . NEW XOBSPAR SET XOBSPAR(1)=$GET(XOBDATA("CLIENTPRIMARYSTATION")),XOBSPAR(2)=XOBSYS("PRIMARY STATION#")
|
|---|
| 22 | . DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Primary Station Mismatch",183010,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183010,.XOBSPAR)))
|
|---|
| 23 | ;
|
|---|
| 24 | ; Do SETUP^XUSRB to setup, then INTRO^XUSRB to get intro text
|
|---|
| 25 | ; NOTE: $$GETPEER^%ZOSV fails for TCP_SERVICES listeners if COM file doesn't set up VISTA$IP logical
|
|---|
| 26 | SET XWBTIP=$$GETPEER^%ZOSV ; XWBTIP needed by SETUP^XUSRB. Use of GETPEER^%ZOSV: DBIA #4056
|
|---|
| 27 | ;
|
|---|
| 28 | USE XOBNULL ; protect against direct writes to socket
|
|---|
| 29 | ; note: SETUP/INTRO^XUSRB set current IO to null device
|
|---|
| 30 | ;
|
|---|
| 31 | IF XOBSYS("ENV")="j2ee" DO
|
|---|
| 32 | . DO SETUP^XUSRB(.XOBSTINF,"") ; use of SETUP^XUSRB: DBIA #4054
|
|---|
| 33 | ELSE DO QUIT:$GET(DUZ)>0
|
|---|
| 34 | . SET XWBVER=1.1 ; to allow VistaLink to contact client agent
|
|---|
| 35 | . DO SETUP^XUSRB(.XOBSTINF,"") ; use of SETUP^XUSRB: DBIA #4054
|
|---|
| 36 | . ; start of auto-signon support
|
|---|
| 37 | . SET DUZ=$$AUTOXWB^XUS1B() IF DUZ<1 KILL DUZ ; use of $$AUTOXWB^XUS1B: DBIA #4060
|
|---|
| 38 | . IF $GET(DUZ)>0 DO NOW^XUSRB SET XUMSG=$$POST^XUSRB(0) IF XUMSG>0 KILL DUZ ; XUSRB calls: DBIA #4061
|
|---|
| 39 | . ; do autosignon and quit if DUZ is set
|
|---|
| 40 | . IF $GET(DUZ)>0 DO QUIT
|
|---|
| 41 | . .USE XOBPORT ; restore current IO (the TCP port)
|
|---|
| 42 | . .SET XOBRET(5)=0 DO LOGFIN
|
|---|
| 43 | . .QUIT
|
|---|
| 44 | . KILL XWBVER ; once auto-signon fails, don't need to contact client agent
|
|---|
| 45 | . ; end of autosignon support
|
|---|
| 46 | ;
|
|---|
| 47 | ;if failed autosignon, continue w/intro text
|
|---|
| 48 | DO INTRO^XUSRB(.XOBITINF) ; use of INTRO^XUSRB: DBIA #4054
|
|---|
| 49 | ; ** use of USE command covered by blanket SAC Kernel exemption for Foundations
|
|---|
| 50 | USE XOBPORT ; restore current IO (the TCP port)
|
|---|
| 51 | ;
|
|---|
| 52 | SET XOBMSG(1)="<SetupInfo serverName='"_$$CHARCHK^XOBVLIB(XOBSTINF(0))_"' volume='"
|
|---|
| 53 | ; note: next line, "dtime" attribute value is not DTIME, but is the VistaLink heartbeat rate.
|
|---|
| 54 | ; this is used by the J2SE client code to time out the client dialogs.
|
|---|
| 55 | ; Value may be replaced w/a signon-specific site parameter later.
|
|---|
| 56 | SET XOBMSG(1)=XOBMSG(1)_$$CHARCHK^XOBVLIB(XOBSTINF(1))_"' uci='"_$$CHARCHK^XOBVLIB(XOBSTINF(2))_"' device='"_$$CHARCHK^XOBVLIB(XOBSTINF(3))_"' numberAttempts='"_$$CHARCHK^XOBVLIB(XOBSTINF(4))_"' dtime='"_$$GETRATE^XOBVLIB()_"'/>"
|
|---|
| 57 | ; add intro text
|
|---|
| 58 | DO GETINTRO^XOBSCAV2("XOBMSG",2)
|
|---|
| 59 | ;
|
|---|
| 60 | DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGSETUP^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHSETUP^XOBSCAV),";;",2))
|
|---|
| 61 | QUIT
|
|---|
| 62 | ; ::AV.Logon.Request message processing
|
|---|
| 63 | LOGON ; process login request
|
|---|
| 64 | NEW XOBAC,XOBVC,XOBRET,XOBRETDV
|
|---|
| 65 | ;
|
|---|
| 66 | IF $$LOGGEDON^XOBSCAV DO QUIT
|
|---|
| 67 | .DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Server Partition State",183003,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183003)))
|
|---|
| 68 | ;
|
|---|
| 69 | KILL DUZ ; if DUZ is around, it shouldn't be.
|
|---|
| 70 | USE XOBNULL ; protect against direct writes to socket
|
|---|
| 71 | ; try to logon w/avcodes
|
|---|
| 72 | DO VALIDAV^XUSRB(.XOBRET,XOBDATA("XOB SECAV","AVCODE")) ; use of VALIDAV^XUSRB: DBIA#4054
|
|---|
| 73 | USE XOBPORT ; restore current IO (the TCP port)
|
|---|
| 74 | ;
|
|---|
| 75 | ; if bad a/v code credentials
|
|---|
| 76 | IF '+XOBRET(0),'+XOBRET(1),'+XOBRET(2) DO QUIT
|
|---|
| 77 | . IF XOBSYS("ENV")="j2ee" DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Connector Proxy User Error",183008,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183008,$GET(XOBRET(3)))))
|
|---|
| 78 | . ; look for particular error string which means IP is locked
|
|---|
| 79 | . IF $GET(XOBRET(3))["Device/IP address is locked due" DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Logon Failed",182306,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(182306,$GET(XOBRET(3))))) QUIT
|
|---|
| 80 | . ELSE DO LOGBADCD
|
|---|
| 81 | ;
|
|---|
| 82 | ; if Kernel says user needs to change verify code
|
|---|
| 83 | IF '+XOBRET(0),'+XOBRET(1),XOBRET(2) DO LOGCVC QUIT
|
|---|
| 84 | ;
|
|---|
| 85 | IF '+XOBRET(0) DO QUIT ; there was an error
|
|---|
| 86 | .NEW XOBSPAR
|
|---|
| 87 | .SET XOBSPAR(1)=$GET(XOBRET(3))
|
|---|
| 88 | .; look for particular error string which means too many invalid signon attempts
|
|---|
| 89 | .IF XOBSPAR(1)["too many invalid sign" DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Logon Failed",183005,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183005,.XOBSPAR))) QUIT
|
|---|
| 90 | .DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Logon Failed",183004,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183004,.XOBSPAR)))
|
|---|
| 91 | ;
|
|---|
| 92 | ; if user requested to change verify code
|
|---|
| 93 | IF XOBDATA("XOB SECAV","REQUESTCVC")="true" DO LOGCVC QUIT
|
|---|
| 94 | ;
|
|---|
| 95 | ; if j2ee, test for connector proxy user
|
|---|
| 96 | IF XOBSYS("ENV")="j2ee" QUIT:'$$ISCPROXY()
|
|---|
| 97 | ;
|
|---|
| 98 | ; at this point login was successful
|
|---|
| 99 | DO LOGFIN
|
|---|
| 100 | QUIT
|
|---|
| 101 | LOGFIN ; check the divisions, finish login now
|
|---|
| 102 | NEW XOBRETDV DO DIVGET^XUSRB2(.XOBRETDV,DUZ) ; use of DIVGET^XUSRB2: DBIA #4055
|
|---|
| 103 | IF '+XOBRETDV(0) DO QUIT
|
|---|
| 104 | . DO LOGOK
|
|---|
| 105 | . DO DUZSV^XOBVSYSI(.DUZ)
|
|---|
| 106 | ; otherwise this is a multidivisional user
|
|---|
| 107 | DO LOGSELDV(.XOBRETDV)
|
|---|
| 108 | QUIT
|
|---|
| 109 | LOGBADCD ; response if bad a/v code pair
|
|---|
| 110 | NEW XOBMSG
|
|---|
| 111 | SET XOBMSG(1)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB(XOBRET(3))_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
|
|---|
| 112 | DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGON^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
|
|---|
| 113 | QUIT
|
|---|
| 114 | LOGCVC ; response if need to change vc
|
|---|
| 115 | NEW XOBMSG,XOBLINE
|
|---|
| 116 | SET XOBLINE=$$POSTTXT^XOBSCAV(.XOBRET,.XOBMSG)
|
|---|
| 117 | SET XOBMSG(XOBLINE+1)="<"_$PIECE($TEXT(PARTTAG^XOBSCAV),";;",2)_" changeVerify=""true"" cvcHelpText="""_$$CHARCHK^XOBVLIB($$AVHLPTXT^XUS2())_""" />" ; use of AVHLPTXT^XUS2: DBIA #4057
|
|---|
| 118 | SET XOBMSG(XOBLINE+2)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB(XOBRET(3))_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
|
|---|
| 119 | DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGON^XOBSCAV),";;",2),.XOBMSG,$$PARTIAL^XOBSCAV(),$PIECE($TEXT(SCHPARTS^XOBSCAV),";;",2))
|
|---|
| 120 | QUIT
|
|---|
| 121 | LOGSELDV(XOBDIVS) ; response if need to select division
|
|---|
| 122 | ;XOBDIVS is in format of output from DIVGET^XUSRB2
|
|---|
| 123 | NEW XOBMSG,XOBLINE
|
|---|
| 124 | SET XOBLINE=$$POSTTXT^XOBSCAV(.XOBRET,.XOBMSG)
|
|---|
| 125 | SET XOBLINE=$$ADDDIVS^XOBSCAV(.XOBDIVS,.XOBMSG)
|
|---|
| 126 | DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGON^XOBSCAV),";;",2),.XOBMSG,$$PARTIAL^XOBSCAV(),$PIECE($TEXT(SCHPARTS^XOBSCAV),";;",2))
|
|---|
| 127 | QUIT
|
|---|
| 128 | LOGOK ; response if everything's looking good
|
|---|
| 129 | NEW XOBMSG,XOBLINE
|
|---|
| 130 | SET XOBLINE=$$POSTTXT^XOBSCAV(.XOBRET,.XOBMSG)
|
|---|
| 131 | DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGON^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHLGON^XOBSCAV),";;",2))
|
|---|
| 132 | QUIT
|
|---|
| 133 | ; ::AV.Logout.Request message processing
|
|---|
| 134 | LOGOUT ; logout
|
|---|
| 135 | USE XOBNULL ; protect against direct writes to socket
|
|---|
| 136 | ; do the logout
|
|---|
| 137 | DO CLEAN
|
|---|
| 138 | USE XOBPORT ; restore current IO (the TCP port)
|
|---|
| 139 | NEW XOBMSG
|
|---|
| 140 | DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGLGOUT^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
|
|---|
| 141 | QUIT
|
|---|
| 142 | ; ::Logout to call if connection has timed out
|
|---|
| 143 | CLEAN ; logout
|
|---|
| 144 | DO LOGOUT^XUSRB ; use of LOGOUT^XUSRB: DBIA #4054
|
|---|
| 145 | QUIT
|
|---|
| 146 | ; ::AV.SelectDivision.Request message processing
|
|---|
| 147 | DIVSLCT ; select division
|
|---|
| 148 | NEW XOBRET
|
|---|
| 149 | IF '+DUZ DO DIVSLCT0("User did not complete the access/verify code login process.") QUIT ; need DUZ
|
|---|
| 150 | DO DIVSET^XUSRB2(.XOBRET,"`"_XOBDATA("XOB SECAV","SELECTEDDIVISION")) ; use of DIVSET^XUSRB2: DBIA #4055
|
|---|
| 151 | IF +XOBRET DO QUIT
|
|---|
| 152 | . DO DIVSLCT1
|
|---|
| 153 | . DO DUZSV^XOBVSYSI(.DUZ)
|
|---|
| 154 | DO DIVSLCT0("division not found for this user.")
|
|---|
| 155 | QUIT
|
|---|
| 156 | ;
|
|---|
| 157 | DIVSLCT0(XOBTEXT) ; send
|
|---|
| 158 | NEW XOBMSG
|
|---|
| 159 | SET XOBMSG(1)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB(XOBTEXT)_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
|
|---|
| 160 | DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGSELDV^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
|
|---|
| 161 | QUIT
|
|---|
| 162 | ;
|
|---|
| 163 | DIVSLCT1 ; success
|
|---|
| 164 | NEW XOBMSG
|
|---|
| 165 | DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGSELDV^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
|
|---|
| 166 | QUIT
|
|---|
| 167 | ;
|
|---|
| 168 | PRODMISM() ; returns 1 if production mismatch, 0 if not
|
|---|
| 169 | IF XOBSYS("ENV")'="j2ee" QUIT 0 ; skip in c/s mode
|
|---|
| 170 | SET XOBPROD=$SELECT($GET(XOBDATA("CLIENTISPRODUCTION"))="true":1,1:0)
|
|---|
| 171 | IF '(XOBPROD=$$PROD^XUPROD(0)) QUIT 1
|
|---|
| 172 | QUIT 0
|
|---|
| 173 | ;
|
|---|
| 174 | STATMISM() ; return 1 if primary station mismatch, 0 if not
|
|---|
| 175 | IF XOBSYS("ENV")'="j2ee" QUIT 0 ; no checking for c/s mode
|
|---|
| 176 | NEW XOBSTAT
|
|---|
| 177 | ; strip off suffix
|
|---|
| 178 | SET XOBSTAT=$$STRPSUFF($GET(XOBDATA("CLIENTPRIMARYSTATION")))
|
|---|
| 179 | ; compare w/KSP value
|
|---|
| 180 | IF XOBSTAT'=XOBSYS("PRIMARY STATION#") QUIT 1 ;mismatch found
|
|---|
| 181 | QUIT 0
|
|---|
| 182 | ;
|
|---|
| 183 | STRPSUFF(XOBSTAT) ; strip alpha suffix from sta# e.g. AAC "200M"
|
|---|
| 184 | SET XOBSTAT=+XOBSTAT
|
|---|
| 185 | ; nursing home, treat 9 as suffix
|
|---|
| 186 | IF $LENGTH(XOBSTAT)=4,$E(XOBSTAT,4)=9 SET XOBSTAT=$E(XOBSTAT,1,3)
|
|---|
| 187 | QUIT XOBSTAT
|
|---|
| 188 | ;
|
|---|
| 189 | ISCPROXY() ; c/proxy check
|
|---|
| 190 | ; returns 1 if c/proxy user, 0 if not
|
|---|
| 191 | NEW XOBCPCHK,XOBOK
|
|---|
| 192 | SET XOBOK=1
|
|---|
| 193 | SET XOBCPCHK=$$CPCHK^XUSAP(+XOBRET(0))
|
|---|
| 194 | IF 'XOBCPCHK DO SET XOBOK=0
|
|---|
| 195 | . DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Connector Proxy User Error",183008,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183008,$PIECE($GET(XOBCPCHK),U,2))))
|
|---|
| 196 | QUIT XOBOK
|
|---|
| 197 | ;
|
|---|
