- XUS1B ;ISF/RWF - Auto sign-on ;12/04/14 14:57
- ;;8.0;KERNEL;**59,337,395,469,543,594,638**;Jul 10, 1995;Build 15
- ;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- AUTOXUS() ;Do the check for XUS and Auto Sign-on
- N %,FG,Y
- I $G(XQXFLG("ASO")) Q 0 ;Already tried once.
- G AUTO
- ;
- AUTOXWB() ;Do the check for XWB and Auto Sign-on
- N %,FG,Y,NUNOW
- I $G(XQXFLG("ASO")) Q 0 ;Already tried so skip.
- S XUNOW=$$NOW^XLFDT ;p543
- AUTO ;Common code
- I ($T(^XWBCAGNT)="")!($P(XOPT,U,18)="d") S XQXFLG("ZEBRA")=-1 Q 0 ;Disabled
- S Y=$$CHKVIP(),%=0
- I Y>0 S %=$$PREF($P(XOPT,U,18),$P($G(^VA(200,Y,200)),U,18))
- I Y>0,'% S Y=0 ;No Auto signon
- ;check parameter, skip set if yes, default is no p594
- I Y>0,'$$GET^XPAR("SYS","XU594",1,"Q") S DUZ(2)=+FG ;Set Division p543
- Q Y
- ;
- CHKVIP() ;Check for a Valid current IP
- N REF,XREF,IEN,R0,ENV,JOB,HNDL,XTMP
- ;D SETUP ;To log data for debug
- S IEN=0,ENV=$$ENV,REF=$G(IO("IP")) I $L(REF) D GETHNDL(.HNDL)
- ;p638 - Look thru the IPv6 X-ref
- I $L(REF) D LKUP("AS4",$$FORCEIP6^XLFIPV(REF)) ;Will set IEN
- Q IEN
- ;
- LKUP(XREF,LK) ;Check one X-ref
- N R0,R1,IX,D1,NM ;p543
- S IX=0,IEN=0
- F S IX=$O(^XUSEC(0,XREF,LK,IX)) Q:'$L(IX) D CHK Q:IEN>0
- Q
- CHK ;Could this be a good one.
- N R0,R1,D1,XIPV6,REF6,XNM,REFNM
- S R0=$G(^XUSEC(0,IX,0))
- ;Check that IP really matches (Q if IPv6<>REF6)
- S XIPV6=$P($G(^XUSEC(0,IX,1)),U,1) ;Stored IPv6 address
- S REF6=$$FORCEIP6^XLFIPV(REF) ;Reference address converted to IPv6
- I XIPV6'=REF6 Q
- ;Check entry does not have sign-off D/T. p543
- I $P(R0,U,4) Q
- ;Check that Client name matches
- S XNM=$$LOW^XLFSTR($P(R0,U,12)) ;Stored client name
- S REFNM=$$LOW^XLFSTR($P($G(IO("CLNM")),".")) ;Reference client name
- I $L(XNM),$L(REFNM),XNM'=REFNM Q
- ;Check date within 8 hours p543
- S D1=$$FMDIFF^XLFDT(XUNOW,IX,2) I (D1>28800)!(D1<-5) Q
- ;Check handle. Use timeout on Lock p543
- S R1=$P(R0,U,13) I $L(R1),$D(HNDL(R1)) D
- . L +^XWB("SESSION",IX_"~"_R1):DILOCKTM I $T L -^XWB("SESSION",IX_"~"_R1) Q
- . ;Remove D LOG after debug.
- . S IEN=+R0,FG=$P(R0,"^",17),XQXFLG("ASO")=IX ;D LOG Q ;Found a match
- . Q
- Q
- ;
- ENV() N Y D GETENV^%ZOSV
- Q Y
- ;
- PREF(%1,%2) ;
- Q $S($L(%2):%2,1:%1)
- ;
- GETHNDL(RET) ;Get the Handles from the Client
- N %,%1,X,XXX,TS
- ;Don't call Terminal servers/Proxy's
- S TS=$G(IO("IP"))
- I $L(TS),$O(^XTV(8989.3,1,405.2,"B",TS,0)) S XQXFLG("ZEBRA")=-1 Q ;Disable to TS and Proxy's
- S %=$$CMD^XWBCAGNT(.XXX,"XWB GET HANDLES") I '% S XQXFLG("ZEBRA")=-1 Q ;Disable on Timeout p543
- Q:'$O(XXX(0))
- ;build array
- S RET=0,%1=1 F %=1:1:$L(XXX(%1),"^") S X=$P(XXX(%1),"^",%) S:X]"" RET(X)="",RET=RET+1
- Q
- ;Temp for data collection
- SETUP ;
- N N1,N2
- I '$D(^XTMP("XUSP543","CNT")) S ^XTMP("XUSP543",0)=$$HTFM^XLFDT($H+30)_"^"_XUNOW,^("CNT")=0
- S N1="XUSP543",N2="CNT"
- X "S XTMP=$INCREMENT(^XTMP(N1,N2))"
- S ^XTMP("XUSP543",XTMP,0)=$G(IO("IP"))_U_$G(IO("ZIO"))_U_XUNOW
- Q
- ;
- LOG ;Log more data
- M ^XTMP("XUSP543",XTMP,"HNDL")=HNDL
- S ^XTMP("XUSP543",XTMP,"R0")=R0,^("R1")=R1,^("IX")=IX
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUS1B 3074 printed Jan 18, 2025@03:13:05 Page 2
- XUS1B ;ISF/RWF - Auto sign-on ;12/04/14 14:57
- +1 ;;8.0;KERNEL;**59,337,395,469,543,594,638**;Jul 10, 1995;Build 15
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- AUTOXUS() ;Do the check for XUS and Auto Sign-on
- +1 NEW %,FG,Y
- +2 ;Already tried once.
- IF $GET(XQXFLG("ASO"))
- QUIT 0
- +3 GOTO AUTO
- +4 ;
- AUTOXWB() ;Do the check for XWB and Auto Sign-on
- +1 NEW %,FG,Y,NUNOW
- +2 ;Already tried so skip.
- IF $GET(XQXFLG("ASO"))
- QUIT 0
- +3 ;p543
- SET XUNOW=$$NOW^XLFDT
- AUTO ;Common code
- +1 ;Disabled
- IF ($TEXT(^XWBCAGNT)="")!($PIECE(XOPT,U,18)="d")
- SET XQXFLG("ZEBRA")=-1
- QUIT 0
- +2 SET Y=$$CHKVIP()
- SET %=0
- +3 IF Y>0
- SET %=$$PREF($PIECE(XOPT,U,18),$PIECE($GET(^VA(200,Y,200)),U,18))
- +4 ;No Auto signon
- IF Y>0
- IF '%
- SET Y=0
- +5 ;check parameter, skip set if yes, default is no p594
- +6 ;Set Division p543
- IF Y>0
- IF '$$GET^XPAR("SYS","XU594",1,"Q")
- SET DUZ(2)=+FG
- +7 QUIT Y
- +8 ;
- CHKVIP() ;Check for a Valid current IP
- +1 NEW REF,XREF,IEN,R0,ENV,JOB,HNDL,XTMP
- +2 ;D SETUP ;To log data for debug
- +3 SET IEN=0
- SET ENV=$$ENV
- SET REF=$GET(IO("IP"))
- IF $LENGTH(REF)
- DO GETHNDL(.HNDL)
- +4 ;p638 - Look thru the IPv6 X-ref
- +5 ;Will set IEN
- IF $LENGTH(REF)
- DO LKUP("AS4",$$FORCEIP6^XLFIPV(REF))
- +6 QUIT IEN
- +7 ;
- LKUP(XREF,LK) ;Check one X-ref
- +1 ;p543
- NEW R0,R1,IX,D1,NM
- +2 SET IX=0
- SET IEN=0
- +3 FOR
- SET IX=$ORDER(^XUSEC(0,XREF,LK,IX))
- if '$LENGTH(IX)
- QUIT
- DO CHK
- if IEN>0
- QUIT
- +4 QUIT
- CHK ;Could this be a good one.
- +1 NEW R0,R1,D1,XIPV6,REF6,XNM,REFNM
- +2 SET R0=$GET(^XUSEC(0,IX,0))
- +3 ;Check that IP really matches (Q if IPv6<>REF6)
- +4 ;Stored IPv6 address
- SET XIPV6=$PIECE($GET(^XUSEC(0,IX,1)),U,1)
- +5 ;Reference address converted to IPv6
- SET REF6=$$FORCEIP6^XLFIPV(REF)
- +6 IF XIPV6'=REF6
- QUIT
- +7 ;Check entry does not have sign-off D/T. p543
- +8 IF $PIECE(R0,U,4)
- QUIT
- +9 ;Check that Client name matches
- +10 ;Stored client name
- SET XNM=$$LOW^XLFSTR($PIECE(R0,U,12))
- +11 ;Reference client name
- SET REFNM=$$LOW^XLFSTR($PIECE($GET(IO("CLNM")),"."))
- +12 IF $LENGTH(XNM)
- IF $LENGTH(REFNM)
- IF XNM'=REFNM
- QUIT
- +13 ;Check date within 8 hours p543
- +14 SET D1=$$FMDIFF^XLFDT(XUNOW,IX,2)
- IF (D1>28800)!(D1<-5)
- QUIT
- +15 ;Check handle. Use timeout on Lock p543
- +16 SET R1=$PIECE(R0,U,13)
- IF $LENGTH(R1)
- IF $DATA(HNDL(R1))
- Begin DoDot:1
- +17 LOCK +^XWB("SESSION",IX_"~"_R1):DILOCKTM
- IF $TEST
- LOCK -^XWB("SESSION",IX_"~"_R1)
- QUIT
- +18 ;Remove D LOG after debug.
- +19 ;D LOG Q ;Found a match
- SET IEN=+R0
- SET FG=$PIECE(R0,"^",17)
- SET XQXFLG("ASO")=IX
- +20 QUIT
- End DoDot:1
- +21 QUIT
- +22 ;
- ENV() NEW Y
- DO GETENV^%ZOSV
- +1 QUIT Y
- +2 ;
- PREF(%1,%2) ;
- +1 QUIT $SELECT($LENGTH(%2):%2,1:%1)
- +2 ;
- GETHNDL(RET) ;Get the Handles from the Client
- +1 NEW %,%1,X,XXX,TS
- +2 ;Don't call Terminal servers/Proxy's
- +3 SET TS=$GET(IO("IP"))
- +4 ;Disable to TS and Proxy's
- IF $LENGTH(TS)
- IF $ORDER(^XTV(8989.3,1,405.2,"B",TS,0))
- SET XQXFLG("ZEBRA")=-1
- QUIT
- +5 ;Disable on Timeout p543
- SET %=$$CMD^XWBCAGNT(.XXX,"XWB GET HANDLES")
- IF '%
- SET XQXFLG("ZEBRA")=-1
- QUIT
- +6 if '$ORDER(XXX(0))
- QUIT
- +7 ;build array
- +8 SET RET=0
- SET %1=1
- FOR %=1:1:$LENGTH(XXX(%1),"^")
- SET X=$PIECE(XXX(%1),"^",%)
- if X]""
- SET RET(X)=""
- SET RET=RET+1
- +9 QUIT
- +10 ;Temp for data collection
- SETUP ;
- +1 NEW N1,N2
- +2 IF '$DATA(^XTMP("XUSP543","CNT"))
- SET ^XTMP("XUSP543",0)=$$HTFM^XLFDT($HOROLOG+30)_"^"_XUNOW
- SET ^("CNT")=0
- +3 SET N1="XUSP543"
- SET N2="CNT"
- +4 XECUTE "S XTMP=$INCREMENT(^XTMP(N1,N2))"
- +5 SET ^XTMP("XUSP543",XTMP,0)=$GET(IO("IP"))_U_$GET(IO("ZIO"))_U_XUNOW
- +6 QUIT
- +7 ;
- LOG ;Log more data
- +1 MERGE ^XTMP("XUSP543",XTMP,"HNDL")=HNDL
- +2 SET ^XTMP("XUSP543",XTMP,"R0")=R0
- SET ^("R1")=R1
- SET ^("IX")=IX
- +3 QUIT