Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUSRB4

XUSRB4.m

Go to the documentation of this file.
  1. XUSRB4 ;ISF/RWF - Build a temporary sign-on token ;01/29/14 14:56
  1. ;;8.0;KERNEL;**150,337,395,419,437,499,523,573,596,638,659**;Jul 10, 1995;Build 22
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. ASH(RET) ;rpc. Auto Signon Handle
  1. N HDL
  1. ;Do not give token to user with authentication Level Of Assurance = 1, as they then would
  1. ;have the ability to re-authenticate at a higher Level Of Assurance (spoofing).
  1. S RET="NOT AUTHENTICATED"
  1. I $G(DUZ)<1 Q ;Not an authenticated user
  1. I $G(DUZ("LOA"))=1 Q ;Not an authenticated user
  1. S HDL=$$HANDLE("XWBAS",1),RET="~1"_HDL
  1. ;Now place user info in it.
  1. D TOK(HDL)
  1. Q
  1. ;
  1. CCOW(RET) ;rpc. CCOW Auto Signon Handle
  1. N HDL,HDL2,X
  1. S RET(0)="NO PROXY USER",RET(1)="ERROR"
  1. I $$USERTYPE^XUSAP(DUZ,"APPLICATION PROXY") Q ;No Proxy
  1. I $$USERTYPE^XUSAP(DUZ,"CONNECTOR PROXY") Q ;No Proxy
  1. ;Do not give token to user with authentication Level Of Assurance = 1, as they then would
  1. ;have the ability to re-authenticate at a higher Level Of Assurance (spoofing).
  1. S RET(0)="NOT AUTHENTICATED",RET(1)="ERROR"
  1. I $G(DUZ("LOA"))=1 Q ;Not an authenticated user
  1. S X=$$ACTIVE^XUSER(DUZ) I 'X S RET(0)=X Q ;User must be active
  1. S HDL=$$HANDLE("XWBCCW",1)
  1. ;Return RET(0) the CCOW token, RET(1) the domain name and the Station #
  1. S RET(0)="~2"_$$LOW^XLFSTR(HDL),RET(1)=$G(^XMB("NETNAME"))_"^"_$$STA^XUAF4(DUZ(2))
  1. ;Now place user info in it.
  1. D TOK(HDL)
  1. S ^XUTL("XQ",$J,"HDL")=HDL ;Save handle with job
  1. Q
  1. ;
  1. HANDLE(NS,LT) ;Return a unique handle into ^XTMP (ef. sup)
  1. ;NS is the namespace, LT is the Handle Lifetime in days
  1. N %H,A,J,HL
  1. I $G(NS)="" Q "" ;Return null if no namespace
  1. S LT=$G(LT,1) S:LT>7 LT=7 ;Default to 1
  1. S %H=$H,J=NS_($J#2048)_"-"_(%H#7*86400+$P(%H,",",2))_"_",A=$R(10)
  1. F S HL=J_A,A=A+1 L +^XTMP(HL):1 I $T Q:'$D(^XTMP(HL)) L -^XTMP(HL)
  1. S ^XTMP(HL,0)=$$HTFM^XLFDT(%H+LT)_"^"_$$DT^XLFDT()
  1. ;L -^XTMP(HL) Leave the Unlock to the caller
  1. Q HL
  1. ;
  1. TOK(H) ;Store a Token
  1. ;H is handle into XTMP
  1. N J,T,R,%
  1. S T=$$H3^%ZTM($H)
  1. S R=$J_"|"_T_"|"_$G(DUZ)_"|"_H
  1. S ^XTMP(H,"D",0)="|"_$$ENCRYP^XUSRB1(R)_"|"
  1. S ^XTMP(H,"D2")=$G(DUZ(2))
  1. S %=$G(IO("IP")) I $L(%),'$$VALIDATE^XLFIPV(%) S %=$P($$ADDRESS^XLFNSLK(%),",") ;p638
  1. S ^XTMP(H,"D3")=%
  1. S ^XTMP(H,"CLNM")=$G(IO("CLNM"))
  1. S ^XTMP(H,"JOB",$J)=$G(IO("IP"))
  1. S ^XTMP(H,"STATUS")="0^New",^("CNT")=0
  1. L -^XTMP(H) ;Clear Lock
  1. Q
  1. ;
  1. REMOVE(HL) ;Remove (kill) a Handle. p523
  1. I $L($G(HL)) K ^XTMP(HL)
  1. Q
  1. ;
  1. CHKASH(HL) ;rpc. Check a Auto Signon Handle
  1. N HDL,RET,FDA,IEN S HDL=$E(HL,3,999)
  1. S RET=$$CHECK(HDL)
  1. I RET>0 D
  1. . S DUZ("ASH")=1,IEN=DUZ_","
  1. . I $$GET1^DIQ(200,IEN,7,"I") S FDA(200,DUZ_",",7)=0 D FILE^DIE("K","FDA") ;p403
  1. D REMOVE(HDL) ;Token only good for one try.
  1. Q RET
  1. ;
  1. CHKCCOW(HL) ;rpc. Check a CCOW Auto Signon Handle
  1. N HDL,RET,T
  1. S HDL=$$UP^XLFSTR($E(HL,3,999)),T=$P($G(^XTV(8989.3,1,30),5400),U)
  1. S RET=$$CHECK(HDL,T)
  1. I RET>0 D
  1. . ;This CCOW Token good for more that one try.
  1. . S ^XTMP(HDL,"JOB",$J)=$G(IO("IP"))
  1. . S ^XTMP(HDL,"STATUS")=(^XTMP(HDL,"STATUS")+1)_"^Active"
  1. . S ^XUTL("XQ",$J,"HDL")=HDL ;Save handle with job
  1. . S DUZ("CCOW")=1 ;Flag a CCOW sign-on.
  1. Q RET
  1. ;
  1. CHECK(HL,TOUT) ;Check a Token
  1. N %,J,D,L,M,S,T,CLNM
  1. S S=$G(^XTMP(HL,0)) I '$L(S) Q "0^Bad Handle"
  1. S S=$G(^XTMP(HL,"D",0)) I '$L(S) Q "0^Bad Handle" ;Now have real token
  1. I $E(S)'="|" Q "0^Bad Token"
  1. S S=$$DECRYP^XUSRB1($E(S,2,$L(S)-1)) I S="" Q "0^Bad Token"
  1. S J=$P(S,"|"),T=$P(S,"|",2),D=$P(S,"|",3),M=$P(S,"|",4)
  1. ;Check token time
  1. S %=$$H3^%ZTM($H),TOUT=$G(TOUT,90) ; P573 changed 20 to 90 JLI
  1. I T+TOUT<% D REMOVE(HL) Q "0^Token Expired" ;Token good for TOUT or 90 seconds
  1. ;Check job
  1. ;Check that token has handle
  1. I M'=HL Q "0^Bad Token"
  1. ;Check User
  1. I $G(^VA(200,D,0))="" Q "0^Bad User"
  1. ;Do IP check
  1. S %=$G(IO("IP")),T=0,CLNM=""
  1. I $L(%),'$$VALIDATE^XLFIPV(%) S CLNM=%,%=$P($$ADDRESS^XLFNSLK(%),",") ;p638
  1. S CLNM=$S($L($G(IO("CLNM"))):IO("CLNM"),$L(CLNM):CLNM,1:"") ;p499
  1. I $L($G(^XTMP(HL,"D3"))),^XTMP(HL,"D3")=% S T=1
  1. I 'T,$L(CLNM),$G(^XTMP(HL,"CLNM"))=IO("CLNM") S T=1
  1. I 'T,$$LOW^XLFSTR($S($L($G(IO("ZIO"))):IO("ZIO"),1:$G(IO)))[$P($G(^XTMP(HL,"CLNM")),".") S T=1 ;ram p596
  1. I 'T Q "0^Different IP" ;p499
  1. I $D(^XTMP(HL,"D2")),D>0 S DUZ(2)=^XTMP(HL,"D2")
  1. D USER^XUS(D)
  1. Q D
  1. ;
  1. ;
  1. CCOWPC(RET) ;Return ap
  1. N I,XU4
  1. S RET(0)="" I '$$BROKER^XWBLIB Q
  1. D GETLST^XPAR(.XU4,"SYS","XUS CCOW VAULT PARAM","Q")
  1. F I=0,1 S RET(I)=$P($G(XU4(I+1)),"^",2,99)
  1. Q
  1. ;
  1. ;p500
  1. CCOWIP(RET,CLIENTIP) ;rpc. CCOW Auto Signon Handle for middle tiered application servers
  1. N %
  1. S %=$G(IO("IP")) ; save original
  1. ; get actual ip address instead of localhost address if possible
  1. S IO("IP")=$S($G(CLIENTIP)=$$CONVERT^XLFIPV("127.0.0.1"):%,$G(CLIENTIP)="":%,1:$G(CLIENTIP)) ;p638
  1. D CCOW(.RET)
  1. S IO("IP")=% ; revert to original
  1. Q
  1. ;