source: WorldVistAEHR/trunk/r/VISTALINK_SECURITY-XOBS/XOBSCAV.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 8.1 KB
RevLine 
[613]1XOBSCAV ;; kec/oak - VistaLink Access/Verify Security ; 12/09/2002 17:00
2 ;;1.5;VistALink Security;;Sep 09, 2005
3 ;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
4 ;;
5 QUIT
6 ;
7 ; ---------------------------------------------------------------------
8 ; Access/Verify Security: Security Message Request Handler
9 ; (main entry point; utilities; constants)
10 ; ---------------------------------------------------------------------
11 ;
12 ; ==== main entry point ====
13 ;
14EN(XOBDATA) ; -- handle parsed messages request
15 ;
16 IF XOBDATA("XOB SECAV","SECURITYTYPE")'=$$MSGTYP^XOBSCAV("request") DO QUIT
17 .;this routine should never see a message not of this type.
18 .NEW XOBSPAR SET XOBSPAR(1)=$$MSGTYP^XOBSCAV("request"),XOBSPAR(2)=XOBDATA("SECURITYTYPE")
19 .DO ERROR(.XOBR,$PIECE($TEXT(FCLIENT),";;",2),"Unexpected Message Format",183001,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183001,.XOBSPAR)))
20 ;
21 ;---- now process each security message type ----
22 IF XOBDATA("XOB SECAV","SECURITYACTION")=$PIECE($TEXT(MSGSETUP),";;",2) DO SENDITXT^XOBSCAV1 QUIT
23 IF XOBDATA("XOB SECAV","SECURITYACTION")=$PIECE($TEXT(MSGLGON),";;",2) DO LOGON^XOBSCAV1 QUIT
24 IF XOBDATA("XOB SECAV","SECURITYACTION")=$PIECE($TEXT(MSGLGOUT),";;",2) DO LOGOUT^XOBSCAV1 QUIT
25 IF XOBDATA("XOB SECAV","SECURITYACTION")=$PIECE($TEXT(MSGSELDV),";;",2) DO DIVSLCT^XOBSCAV1 QUIT
26 IF XOBDATA("XOB SECAV","SECURITYACTION")=$PIECE($TEXT(MSGUPDVC),";;",2) DO SENDNVC^XOBSCAV2 QUIT
27 IF XOBDATA("XOB SECAV","SECURITYACTION")=$PIECE($TEXT(MSGUSERD),";;",2) DO SENDDEM^XOBSCAV2 QUIT
28 ;
29 ; done processing all known message types
30 NEW XOBSPAR SET XOBSPAR(1)=XOBDATA("XOB SECAV","SECURITYACTION")
31 DO ERROR(.XOBR,$PIECE($TEXT(FCLIENT),";;",2),"Unexpected Message Format",183002,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183002,.XOBSPAR)))
32 QUIT
33 ;
34 ; ==== utilities ====
35 ;
36SENDSEC(XOBR,XOBMSGTP,XOBRSTYP,XOBMSG,XOBSTAT,XOBSCHEM) ; -- stream XML security reply back
37 ;
38 ; XOBR: internal VistaLink variable
39 ; XOBMSGTP: type of message (e.g., gov.va.med.foundations.security.response)
40 ; XOBRSTYP: type of response (e.g., AV.SetupAndIntroText)
41 ; XOBMSG: message lines to send inside standard wrapper
42 ; XOBSTAT: type of result (e.g., success)
43 ; XOBSCHEM: noNamespaceSchemaLocation
44 ;
45 NEW XOBFILL
46 ; -- prepare socket for writing
47 DO PRE^XOBVSKT
48 ; -- write XML header tag and VistaLink tag
49 DO WRITE^XOBVSKT($$ENVHDR^XOBVLIB(XOBMSGTP,XOBSCHEM))
50 ; -- write SecurityInfo tag
51 DO WRITE^XOBVSKT("<SecurityInfo version="""_$PIECE($TEXT(VRSNSEC),";;",2)_""" />")
52 ; -- write Response opening tag
53 DO WRITE^XOBVSKT("<Response type="""_XOBRSTYP_""" status="""_XOBSTAT_""">")
54 ; -- write lines of message passed in
55 NEW XOBI SET XOBI=0 FOR SET XOBI=$ORDER(XOBMSG(XOBI)) QUIT:'+XOBI DO WRITE^XOBVSKT(XOBMSG(XOBI))
56 ; -- write closing Response tag, closing VistaLink tag
57 DO WRITE^XOBVSKT("</Response>")
58 DO WRITE^XOBVSKT($$ENVFTR^XOBVLIB())
59 ; -- send eot and flush buffer
60 DO POST^XOBVSKT
61 ;
62 KILL XOBDATA("XOB SECAV")
63 QUIT
64 ;
65ERROR(XOBR,XOBFCODE,XOBFSTR,XOBCODE,XOBSTR) ; -- send security error back to client
66 ;
67 ; XOBR: internal VistaLink variable
68 ; XOBFCODE: the fault code
69 ; XOBFSTRING: the fault string
70 ; XOBCODE: error code
71 ; XOBSTR: error message
72 ;
73 NEW XOBFILL
74 ; -- prepare socket for writing
75 DO PRE^XOBVSKT
76 ; -- write XML header tag and VistaLink tag
77 DO WRITE^XOBVSKT($$ENVHDR^XOBVLIB($PIECE($TEXT(ERRTYPE^XOBSCAV),";;",2),$PIECE($TEXT(SCHERROR^XOBSCAV),";;",2)))
78 ; -- write SecurityInfo tag
79 DO WRITE^XOBVSKT("<SecurityInfo version="""_$PIECE($TEXT(VRSNSEC),";;",2)_""" />")
80 ; -- write fault message
81 DO WRITE^XOBVSKT("<Fault>")
82 DO WRITE^XOBVSKT("<FaultCode>"_XOBFCODE_"</FaultCode>")
83 DO WRITE^XOBVSKT("<FaultString>"_XOBFSTR_"</FaultString>")
84 DO WRITE^XOBVSKT("<Detail>")
85 DO WRITE^XOBVSKT("<Error code="""_XOBCODE_""">")
86 DO WRITE^XOBVSKT("<Message>"_XOBSTR_"</Message>")
87 DO WRITE^XOBVSKT("</Error>")
88 DO WRITE^XOBVSKT("</Detail>")
89 DO WRITE^XOBVSKT("</Fault>")
90 DO WRITE^XOBVSKT($$ENVFTR^XOBVLIB())
91 ; -- send eot and flush buffer
92 DO POST^XOBVSKT
93 ; -- log the error/fault unless it's "too many invalid login attempts"
94 IF XOBCODE'=183005 DO
95 .DO ^%ZTER
96 KILL XOBDATA("XOB SECAV")
97 QUIT
98 ;
99POSTTXT(XOBRET,XOBMSG) ; -- adds the post-sign-in-text to a message being prepared
100 NEW XOBI,XOBLINE,XOBCNT
101 SET XOBCNT="",XOBLINE=1 FOR SET XOBCNT=$ORDER(XOBMSG(XOBCNT)) QUIT:XOBCNT']"" SET XOBLINE=XOBCNT
102 SET XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="<PostSignInText>"
103 ; only return post sign in text if the signon says that the text line count is > 0
104 ; (even if, past XOBRET(5), there are actually messages from the post-sign-in text)
105 IF XOBRET(5)>0 DO
106 .SET XOBI=5 FOR SET XOBI=$ORDER(XOBRET(XOBI)) QUIT:XOBI']"" DO
107 ..SET XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="<Line>"_$$CHARCHK^XOBVLIB(XOBRET(XOBI))_"</Line>"
108 SET XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="</PostSignInText>"
109 QUIT XOBLINE
110 ;
111ADDDIVS(XOBRET,XOBMSG) ; -- adds division list to a message being prepared
112 NEW XOBI,XOBLINE,XOBCNT,XOBDEF
113 SET XOBCNT="",XOBLINE=1 FOR SET XOBCNT=$ORDER(XOBMSG(XOBCNT)) QUIT:XOBCNT']"" SET XOBLINE=XOBCNT
114 ;
115 SET XOBDEF=$ORDER(^VA(200,DUZ,2,"AX1",1,"")) ; default division if any. Use of ^VA(200,,2,"AX1"): DBIA #4058
116 SET XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="<"_$PIECE($TEXT(PARTTAG),";;",2)_" needDivisionSelection=""true"">"
117 SET XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="<Divisions>"
118 SET XOBI=0 FOR SET XOBI=$ORDER(XOBDIVS(XOBI)) QUIT:XOBI']"" DO
119 .SET XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="<Division ien="""_$PIECE(XOBDIVS(XOBI),U)_""" divName="""_$$CHARCHK^XOBVLIB($PIECE(XOBDIVS(XOBI),U,2))_""" divNumber="""_$$CHARCHK^XOBVLIB($PIECE(XOBDIVS(XOBI),U,3))_""""
120 .SET:($PIECE(XOBDIVS(XOBI),U)=XOBDEF) XOBMSG(XOBLINE)=XOBMSG(XOBLINE)_" default=""true"" "
121 .SET XOBMSG(XOBLINE)=XOBMSG(XOBLINE)_" />"
122 SET XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)="</Divisions>"
123 SET XOBLINE=XOBLINE+1,XOBMSG(XOBLINE)=" </"_$PIECE($TEXT(PARTTAG),";;",2)_">"
124 ;
125 QUIT XOBLINE
126 ;
127LOGGEDON() ; -- checks if the environment was previously properly set up, e.g.,
128 ; logon succeeded in some previous call
129 QUIT +$GET(DUZ)
130 ;
131CRCONTXT(XOBOPTNM) ; -- create the contxt if it doesn't already exist
132 ; INPUT VALUE: XOBOPTNM encoded with Kernel encoding algorithm
133 ; RETURN VALUE: +result will be 1 if successful, or 0 if unsuccessful
134 ; if unsuccessful, result may (or may not) also contain the textual reason for failure
135 ;
136 ; Accessing, Setting and Killing of XQY and XQY0: DBIA #4059
137 ;
138 NEW XOBRSLT,XOBOPTN1
139 ;
140 SET XOBOPTN1=$$DECRYP^XUSRB1(XOBOPTNM)
141 ; -- if context already set, quit 1
142 IF $LENGTH($GET(XQY0)),XQY0=XOBOPTN1 QUIT 1
143 ; -- if param is empty string, then kill off the context
144 IF XOBOPTN1="" KILL XQY0,XQY QUIT 1
145 ; -- otherwise try to create the context
146 DO CRCONTXT^XWBSEC(.XOBRSLT,XOBOPTNM) ; use of CRCONTXT^XWBSEC: DBIA #4053
147 ; -- return the result
148 QUIT XOBRSLT
149 ;
150CHKCTXT(XOBRPCNM) ; -- does user have access to RPC?
151 NEW XWBSEC
152 DO CHKPRMIT^XWBSEC(XOBRPCNM) ; use of CHKPRMIT^XWBSEC: DBIA # 4053
153 QUIT:'+$LENGTH($GET(XWBSEC)) 1
154 QUIT XWBSEC
155 ;
156 ; ==== Constants ====
157 ;
158MSGTYP(XOBRQRS) ; return request message type
159 IF XOBRQRS="request" QUIT $PIECE($TEXT(REQTYPE),";;",2)
160 IF XOBRQRS="response" QUIT $PIECE($TEXT(RESTYPE),";;",2)
161 IF XOBRQRS="error" QUIT $PIECE($TEXT(ERRTYPE),";;",2)
162 QUIT ""
163SUCCESS() ; resulttype
164 QUIT $PIECE($TEXT(RESTYPES+1),";;",2)
165FAILURE() ;
166 QUIT $PIECE($TEXT(RESTYPES+2),";;",2)
167PARTIAL() ;
168 QUIT $PIECE($TEXT(RESTYPES+3),";;",2)
169 ;
170RESTYPES ;Result types
171 ;;success
172 ;;failure
173 ;;partialSuccess
174 ;
175 ;Message types
176REQTYPE ;;gov.va.med.foundations.security.request
177RESTYPE ;;gov.va.med.foundations.security.response
178ERRTYPE ;;gov.va.med.foundations.security.fault
179 ;
180 ;Message response types
181MSGSETUP ;;AV.SetupAndIntroText
182MSGLGON ;;AV.Logon
183MSGLGOUT ;;AV.Logout
184MSGSELDV ;;AV.SelectDivision
185MSGUPDVC ;;AV.UpdateVC
186MSGUSERD ;;AV.GetUserDemographics
187 ;
188 ;Attribute values for response XML messages
189VRSNSEC ;;1.0
190 ;
191 ;XML Tag names
192PARTTAG ;;PartialSuccessData
193MSGTAG ;;Message
194 ;
195 ;XML Schemas
196SCHERROR ;;secFault.xsd
197SCHLGON ;;secLogonResponse.xsd
198SCHPARTS ;;secPartialSuccessResponse.xsd
199SCHSETUP ;;secSetupIntroResponse.xsd
200SCHSIMPL ;;secSimpleResponse.xsd
201SCHUSERD ;;secUserDemographicsResponse.xsd
202 ;
203 ;Faultcodes
204FSERVER ;;Server
205FCLIENT ;;Client
206FVERSION ;;VersionMismatch
207FUNDERST ;;MustUnderstand
Note: See TracBrowser for help on using the repository browser.