source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSRB4.m@ 1396

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1XUSRB4 ;ISF/RWF - Build a temporary sign-on token ;02/27/2007
2 ;;8.0;KERNEL;**150,337,395,419,437**;Jul 10, 1995;Build 2
3 Q
4 ;
5ASH(RET) ;rpc. Auto Signon Handle
6 N HDL
7 S HDL=$$HANDLE("XWBAS",1),RET="~1"_HDL
8 ;Now place user info in it.
9 D TOK(HDL)
10 Q
11 ;
12CCOW(RET) ;rpc. CCOW Auto Signon Handle
13 N HDL,HDL2,X
14 S RET(0)="NO PROXY USER",RET(1)="ERROR"
15 I $$USERTYPE^XUSAP(DUZ,"APPLICATION PROXY") Q ;No Proxy
16 I $$USERTYPE^XUSAP(DUZ,"CONNECTOR PROXY") Q ;No Proxy
17 S X=$$ACTIVE^XUSER(DUZ) I 'X S RET(0)=X Q ;User must be active
18 S HDL=$$HANDLE("XWBCCW",1)
19 ;Return RET(0) the CCOW token, RET(1) the domain name and the Station #
20 S RET(0)="~2"_$$LOW^XLFSTR(HDL),RET(1)=$G(^XMB("NETNAME"))_"^"_$$STA^XUAF4(DUZ(2))
21 ;Now place user info in it.
22 D TOK(HDL)
23 S ^XUTL("XQ",$J,"HDL")=HDL ;Save handle with job
24 Q
25 ;
26HANDLE(NS,LT) ;Return a unique handle into ^XTMP (ef. sup)
27 ;NS is the namespace, LT is the Handle Lifetime in days
28 N %H,A,J,HL
29 I $G(NS)="" Q "" ;Return null if no namespace
30 S LT=$G(LT,1) S:LT>7 LT=7 ;Default to 1
31 S %H=$H,J=NS_($J#2048)_"-"_(%H#7*86400+$P(%H,",",2))_"_",A=$R(10)
32 F S HL=J_A,A=A+1 L +^XTMP(HL):1 I $T Q:'$D(^XTMP(HL)) L -^XTMP(HL)
33 S ^XTMP(HL,0)=$$HTFM^XLFDT(%H+LT)_"^"_$$DT^XLFDT()
34 L -^XTMP(HL)
35 Q HL
36 ;
37TOK(H) ;Store a Token
38 ;H is handle into XTMP
39 N J,T,R
40 S T=$$H3^%ZTM($H)
41 S R=$J_"|"_T_"|"_$G(DUZ)_"|"_H
42 S ^XTMP(H,"D",0)="|"_$$ENCRYP^XUSRB1(R)_"|"
43 S ^XTMP(H,"D2")=$G(DUZ(2))
44 S %=$G(IO("IP")) I $L(%),%'?1.3N1P1.3N1P1.3N1P1.3N S %=$P($$ADDRESS^XLFNSLK(%),",")
45 S ^XTMP(H,"D3")=%
46 S ^XTMP(H,"JOB",$J)=$G(IO("IP"))
47 S ^XTMP(H,"STATUS")="0^New",^("CNT")=0
48 Q
49 ;
50CHKASH(HL) ;rpc. Check a Auto Signon Handle
51 N HDL,RET,FDA,IEN S HDL=$E(HL,3,999)
52 S RET=$$CHECK(HDL)
53 I RET>0 D
54 . S DUZ("ASH")=1,IEN=DUZ_","
55 . I $$GET1^DIQ(200,IEN,7,"I") S FDA(200,DUZ_",",7)=0 D FILE^DIE("K","FDA") ;rwf 403
56 K ^XTMP(HDL) ;Token only good for one try.
57 Q RET
58 ;
59CHKCCOW(HL) ;rpc. Check a CCOW Auto Signon Handle
60 N HDL,RET,T
61 S HDL=$$UP^XLFSTR($E(HL,3,999)),T=$P($G(^XTV(8989.3,1,30),5400),U)
62 S RET=$$CHECK(HDL,T)
63 I RET>0 D
64 . ;This CCOW Token good for more that one try.
65 . S ^XTMP(HDL,"JOB",$J)=$G(IO("IP"))
66 . S ^XTMP(HDL,"STATUS")=(^XTMP(HDL,"STATUS")+1)_"^Active"
67 . S ^XUTL("XQ",$J,"HDL")=HDL ;Save handle with job
68 . S DUZ("CCOW")=1 ;Flag a CCOW sign-on.
69 Q RET
70 ;
71CHECK(HL,TOUT) ;Check a Token
72 N %,J,D,L,M,S,T
73 S S=$G(^XTMP(HL,0)) I '$L(S) Q "0^Bad Handle"
74 S S=$G(^XTMP(HL,"D",0)) I '$L(S) Q "0^Bad Handle" ;Now have real token
75 I $E(S)'="|" Q "0^Bad Token"
76 S S=$$DECRYP^XUSRB1($E(S,2,$L(S)-1)) I S="" Q "0^Bad Token"
77 S J=$P(S,"|"),T=$P(S,"|",2),D=$P(S,"|",3),M=$P(S,"|",4)
78 ;Check token time
79 S %=$$H3^%ZTM($H),TOUT=$G(TOUT,20)
80 I T+TOUT<% Q "0^Token Expired" ;Token good for TOUT or 20 seconds
81 ;Check job
82 ;Check that token has handle
83 I M'=HL Q "0^Bad Token"
84 ;Check User
85 I $G(^VA(200,D,0))="" Q "0^Bad User"
86 ;Do IP check
87 S %=$G(IO("IP")) I $L(%),%'?1.3N1P1.3N1P1.3N1P1.3N S %=$P($$ADDRESS^XLFNSLK(%),",")
88 I $L($G(^XTMP(HL,"D3"))),^XTMP(HL,"D3")'=% Q "0^Different IP"
89 I $D(^XTMP(HL,"D2")),D>0 S DUZ(2)=^XTMP(HL,"D2")
90 D USER^XUS(D)
91 Q D
92 ;
93 ;
94CCOWPC(RET) ;Return ap
95 N I,XU4
96 S RET(0)="" I '$$BROKER^XWBLIB Q
97 D GETLST^XPAR(.XU4,"SYS","XUS CCOW VAULT PARAM","Q")
98 F I=0,1 S RET(I)=$P($G(XU4(I+1)),"^",2,99)
99 Q
Note: See TracBrowser for help on using the repository browser.