source: FOIAVistA/trunk/r/VISTALINK_SECURITY-XOBS/XOBSRAKJ.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1XOBSRAKJ ;kc/oak - VistALink Reauthentication Code, SSO/UC KAAJEE ; 03/02/2004 07: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 ; RPC Server: Reauthentication subroutines for SSO/UC KAAJEE
9 ; ------------------------------------------------------------------------
10 ;
11CCOW(XOBID,XOBERR) ; -- CCOW connection type
12 NEW XOBOUT,T,HDL
13 SET XOBID=0
14 ;
15 ;get DUZ using Kernel CCOW Token xref
16 SET HDL=$GET(XOBDATA("XOB RPC","SECURITY","TYPE","CCOW"))
17 SET HDL=$$DECRYP^XUSRB1(HDL)
18 ;
19 IF $EXTRACT(HDL,1,2)'="~2" DO QUIT
20 . SET XOBERR=182301_U_"CCOW"_U_"[token does not match CCOW handle format.]"
21 . SET XOBID=0
22 ;
23 ; TODO: need IP address, then need to do $$IPLOCKED(IP)?
24 ;
25 ; since bypassing CHKCCOW^XUSRB4, need to extract true handle, expiry here
26 SET HDL=$$UP^XLFSTR($EXTRACT(HDL,3,99)),T=$PIECE($GET(^XTV(8989.3,1,30),5400),U)
27 ; call Kernel to resolve CCOW handle into user ID
28 SET XOBOUT=$$CHECK^XUSRB4(HDL,T)
29 IF (+XOBOUT)<1 DO QUIT
30 . SET XOBERR=182301_U_"CCOW"_U_"["_$PIECE(XOBOUT,U,2)_"]"
31 . SET XOBID=0
32 ;
33 ; need to get set XOBID=DUZ, save off DUZ(2) and anything else held in the token for XOBSRA
34 SET XOBID=+XOBOUT
35 ;
36 ; Save the division station# into $GET(XOBDATA("XOB RPC","SECURITY","DIV")) -- that
37 ; is where the XOBSRA division check is looking for it
38 SET:+DUZ(2) XOBDATA("XOB RPC","SECURITY","DIV")=$$STA^XUAF4(DUZ(2))
39 ;
40 IF XOBID<1 DO QUIT
41 . SET XOBERR=182305_U_"CCOW"
42 . SET XOBID=0
43 ;
44 ; probably can run MORECHKS as is?
45 ; SET XOBERR=$$MORECHKS(XOBID)
46 ;
47 IF XOBERR SET XOBID=0 QUIT
48 ;
49 ; TODO: POST(IP)
50 ;
51 QUIT
52 ;
53AV(XOBID,XOBERR) ; -- AV connection type
54 NEW AC,AVCODE,VC,X,XOBCLIP,XOBTYPE
55 SET XOBID=0
56 ;
57 ; -- get DUZ using access and verify codes
58 SET AVCODE=$GET(XOBDATA("XOB RPC","SECURITY","TYPE","AVCODE"))
59 ;
60 SET AVCODE=$$DECRYP^XUSRB1(AVCODE)
61 SET AC=$PIECE(AVCODE,";",1),VC=$PIECE(AVCODE,";",2),XOBCLIP=$PIECE(AVCODE,";",3)
62 ;
63 ; -- convert AC, VC into hashed versions
64 SET X=AC,AC=$$EN^XUSHSH($$UP^XLFSTR(X))
65 SET X=VC,VC=$$EN^XUSHSH($$UP^XLFSTR(X))
66 ;
67 ; -- check if exceeded multiple signon attempts
68 SET XOBERR=$$IPLOCKED(XOBCLIP) IF XOBERR SET XOBID=0 QUIT
69 ;
70 ; -- look up AC
71 SET XOBID=+$ORDER(^VA(200,"A",AC,0))
72 IF XOBID<1 DO QUIT
73 . SET XOBERR=182305_U_"AV"
74 . SET XOBID=0
75 ;
76 ; -- check VC
77 IF $PIECE($GET(^VA(200,XOBID,.1)),U,2)'=VC DO QUIT
78 . SET XOBERR=182305_U_"AV"
79 . SET XOBID=0
80 ;
81 ; -- check user access and whether verify code needs changing
82 SET XOBERR=$$MORECHKS(XOBID)
83 IF XOBERR SET XOBID=0 QUIT
84 ;
85 ; login succeeded
86 DO POST(XOBCLIP)
87 ;
88 ; NOTE: AV doesn't need to check $$PERSON for AV because our source was file 200, not a separate index
89 ;
90 QUIT
91 ;
92MORECHKS(XOBID) ; -- More separate checks
93 NEW XOBERR
94 SET XOBERR=0
95 ;
96 ; -- check user access
97 SET XOBERR=$$NOACCESS^XOBSRA(XOBID)
98 IF XOBERR SET XOBID=0 QUIT XOBERR
99 ;
100 ; -- check if verify code needs changing
101 SET XOBERR=$$VCHG^XOBSRA(XOBID)
102 IF XOBERR SET XOBID=0 QUIT XOBERR
103 ;
104 QUIT XOBERR
105 ;
106IPLOCKED(XOBCLIP) ; -- check if IP address is locked, increment if not
107 ;
108 ; Implements the script-inhibiting lock-by-IP-address Kernel function.
109 ; Does not lock user out for long, but does slow down scripts.
110 ;
111 ; Return:
112 ; 182306^XOBID : if too many invalid login attempts
113 ; 0 : not too many login attempts
114 ;
115 IF $$LKCHECK^XUSTZIP(XOBCLIP) DO QUIT XOBERR
116 . SET XOBERR="182306^Too many invalid signon attempts."
117 ;
118 NEW XOBERR,XUFAC SET XOBERR=0
119 ;
120 IF $$FAIL^XUS3(XOBCLIP) SET XOBERR="182306^"_$$RA^XUSTZ(XOBCLIP)
121 QUIT XOBERR
122 ;
123POST(XOBCLIP) ; post-successful tasks
124 DO CLRFAC^XUS3(XOBCLIP)
125 QUIT
Note: See TracBrowser for help on using the repository browser.