| [613] | 1 | XUSRB4 ;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 | ;
|
|---|
| 5 | ASH(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 | ;
|
|---|
| 12 | CCOW(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 | ;
|
|---|
| 26 | HANDLE(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 | ;
|
|---|
| 37 | TOK(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 | ;
|
|---|
| 50 | CHKASH(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 | ;
|
|---|
| 59 | CHKCCOW(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 | ;
|
|---|
| 71 | CHECK(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 | ;
|
|---|
| 94 | CCOWPC(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
|
|---|
