XUSTZIP ;WRJ/DAF,ISF/RWF - Security Twilight Zone, Failed Access Attempts ;03/24/2004 11:12
;;8.0;KERNEL;**265,419**;Jul 10, 1995;Build 5
Q
;The subfiles in KSP file.
;405.2 List of Terminal Servers, slack, last reset
;
;^XUSEC(3, (File 3.083) Locked IP's, lock until
;^XUSEC(4, (File 3.084) Failed attempts count
;$P(^VA(200,DUZ,1.1),U,5) Locked Users
;
CLEAN ;CLEAN UP OLD LOCKED IP NODES, ^XUSEC(3,
N ZNUM,NOW
S ZNUM=0,NOW=$$NOW^XLFDT
L +^XUSEC(3,0):10
F S ZNUM=$O(^XUSEC(3,ZNUM)) Q:ZNUM'>0 D
.I $P(^XUSEC(3,ZNUM,0),"^",2)'>NOW D LKDEL(ZNUM)
L -^XUSEC(3,0),+^XUSEC(4,0):10
N XUFAC,OV
S ZNUM=0,NOW=$$H3-90
F S ZNUM=$O(^XUSEC(4,ZNUM)) Q:ZNUM'>0 D
.S OV=$$H3($P(^XUSEC(4,ZNUM,0),"^",3)) I OV'>NOW D
..N DIK,DA
..S DA=ZNUM,DIK="^XUSEC(4," D ^DIK
L -^XUSEC(4,0)
Q
X6IP ;EXAMINE AND ALLOW RESET OF LOCKED IPS
N I,ZFDA,DIR,XUNOW,ZNM,ZNUM,Y S ZNM="",I=0
I '$D(^XUSEC(3,"B")) W !,"There are no IP's to Clear" Q
F S ZNM=$O(^XUSEC(3,"B",ZNM)) Q:ZNM']"" S ZNUM=$O(^XUSEC(3,"B",ZNM,"")) D
. I '$D(^XUSEC(3,ZNUM,0)) K ^XUSEC(3,"B",ZNM) Q ;419
. S I=I+1,ZNM(I)=ZNUM_"^"_ZNM
. W !,I_". ",ZNM," lock out till: ",$$FMTE^XLFDT($P(^XUSEC(3,ZNUM,0),"^",2))
. Q
S DIR(0)="N^1:"_I,DIR("A")="Choose the number of the IP to reset" D ^DIR Q:$D(DIRUT)
S ZNM=$P(ZNM(Y),"^",2),ZNUM=+ZNM(Y)
;Call with IEN
D LKDEL(ZNUM)
W !,ZNM," Cleared"
;Call with IP
D CLRFAC^XUS3(ZNM) ;Clear access count
;if this is a ts reset and then set reset date in site param file
S ZIEN=$$TSCHK(ZNM)
I ZIEN>0 S ZFDA(8989.305,ZIEN_",1,",2)=$$NOW D UPDATE^DIE("","ZFDA")
K DIR,DIRUT
Q
;
LKSET(IP) ;Set IP Lock Node
N ZNUM,ZFDA,ZIEN
Q:'$$ON 0
S ZIEN="?+2,",ZFDA(3.083,ZIEN,.01)=IP
S ZFDA(3.083,ZIEN,2)=$$LKTL
D UPDATE^DIE("","ZFDA","ZIEN")
D CLRFAC^XUS3(IP) ;Clear the access count
Q 1
LKTL() ;Lock until
Q $$HTFM^XLFDT($$HADD^XLFDT($H,0,0,0,$$LKTME))
;
NOW() ;
I $G(XUNOW) Q XUNOW
S XUNOW=$$NOW^XLFDT
Q XUNOW
;
IP() ;Get a device IP.
Q $S($D(IP):IP,$D(IO("IP")):IO("IP"),$D(IO("ZIO")):IO("ZIO"),1:"")
;
LKTME() ;Get lock-out time
I $D(XOPT) Q $P(XOPT,U,3)
Q $P(^XTV(8989.3,1,"XUS"),U,3)
;
LKCHECK(IP) ;Check if IP is LOCKED
I '$$ON Q 0 ;Are we doing IP/device locking
S IP=$$IP() Q:'$L(IP) 0
N ZREC S ZREC=$$LKREC(IP)
Q:'$L(ZREC) 0
;Found a LOCK record, Check time
S X=$P(ZREC,"^",2)>$$NOW
Q X
;
LKREC(IP) ;Get the Lock record
N ZNUM
S ZNUM=+$O(^XUSEC(3,"B",IP,0))
Q $G(^XUSEC(3,ZNUM,0))
;
LKDEL(ZNUM) ;Delete LOCKED IP
N DIK,DA ;419
S DIK="^XUSEC(3,",DA=ZNUM D ^DIK
Q
;
LKWAIT(%) ;How long to wait
N T1,T2,IP
S IP=$$IP() Q:'$L(IP) %
S T1=$$LKREC(IP)
Q $$FMDIFF^XLFDT($P(T1,U,2),$$NOW^XLFDT,2)
;
TSCHK(IP) ;Check if IP is for a TERMINAL SERVER.
;is this IP for a teriminal server.
N ZNUM S ZNUM=$O(^XTV(8989.3,1,405.2,"B",IP,0))
Q ZNUM
;
IPCHECK(IP) ;Check if IP should be LOCKED. Called from XUSTZ, and others.
;Return 1 if should lock, 0 if No.
I '$$ON Q 0
S IP=$$IP Q:'$L(IP) 0
N LIMIT,TSIEN,ZEND,ZNUM,ZLST,SLK,TFAC,TSREC,Z10
;If the IP is locked, Don't relock. Could cause an endless lock.
I $$LKCHECK(IP) Q 0
;is this the IP of a teriminal server. if not lock
S TSIEN=$$TSCHK(IP) ;Returns TS ien.
;If TSIEN<1 lock the IP.
Q:TSIEN<1 1
;count # of failures for this TS in last 10 minutes and compare that
;against the established limit. if no limit set, use 2. maybe cut
;some slack.
S Z10=$$HTFM^XLFDT($$HADD^XLFDT($H,0,0,-10)) ;NOW-10
S TSREC=$G(^XTV(8989.3,1,405.2,TSIEN,0)) ;Get TS record
S ZLST=$P(TSREC,"^",3) ;Last reset
S ZEND=$S(ZLST>Z10:ZLST,1:Z10) ;stop at last reset or NOW-10.
S ZNUM="A",TFAC=0,Y=$S(IP["/":"/",1:":")
F S ZNUM=$O(^%ZUA(3.05,ZNUM),-1) Q:ZNUM'>0!(ZEND>ZNUM) D
. I $P($P(^%ZUA(3.05,ZNUM,0),"^",7),Y)=$P(IP,Y) S TFAC=TFAC+1
S LIMIT=$P($G(^XTV(8989.3,1,405)),"^",6) S:'LIMIT LIMIT=2
S SLK=$$SLACK(Z10) ;
Q $S(SLK:TFAC>SLK,1:TFAC>LIMIT)
;
SLACK(TEND) ;SLACK CALCULATOR
;if this TS has been reset in last 10 minutes allow 100 tries.
;Normal hours return 0, after hours use TS Slack value
N HRMIN,X,NOW,TS
S X=$P(TSREC,"^",3) ;Last Reset
I X>TEND Q 100 ;TEND is Now-10 min
;if now is during normal work hours 8am to 4:30 pm, cut no slack
S HRMIN=$P($H,",",2)
; 8am is 28800 and 4:30 pm is 59400
; If Normal hours don't give slack unless user locking is on.
I (HRMIN>28800&(HRMIN<59400)) Q $S($P($G(^XTV(8989.3,1,405)),"^",4)="y":10,1:0)
;if TS param says to cut slack, cut amount of slack set up in param.
Q $S($P(TSREC,"^",2):$P(TSREC,"^",2),1:0)
;
ON() ;ON OR OFF
Q $P($G(^XTV(8989.3,1,405)),"^",1)="y"
;
H3(%H) ;Make seconds
S:'$G(%H) %H=$H
Q %H*86400+$P(%H,",",2)
;
H0(%H) ;
S:'$G(%H) %H=0
Q (%H\86400)_","_(%H#86400)
;
DSPTME(%H) ;Convert seconds to display format
Q $$HTE^XLFDT($$H0(%H),"1P")
;
WATCH ;Watch the globals
N TIME,C,I,X
WT2 S TIME=$$HTE^XLFDT($H)
W @IOF,"Failed access attempts count. Current time: ",TIME
S I=0,C=0
F S I=$O(^XUSEC(4,I)) Q:I'>0 S X=^(I,0),C=1 W !,I,?5,"IP: ",$P(X,U,1),?25,"Count: ",$P(X,U,2),?35,"Until: ",$$HTE^XLFDT($P(X,U,3))
I C=0 W !,?10,"None"
W !,"Locked IP's. Current time: ",TIME
S I=0,C=0
F S I=$O(^XUSEC(3,I)) Q:I'>0 S X=^(I,0),C=1 W !,I,?5,"IP: ",$P(X,U,1),?25,"Until: ",$$FMTE^XLFDT($P(X,U,2))
I C=0 W !,?10,"None"
R !,"Refresh: Yes// ",X:30 S:'$T X="Y" G WT2:"Yy"[$E(X)
I $E(X)="?" W !,"Enter 'Yes' or return to refresh, anyother key will exit" H 2 G WT2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSTZIP 5513 printed Oct 16, 2024@18:13:55 Page 2
XUSTZIP ;WRJ/DAF,ISF/RWF - Security Twilight Zone, Failed Access Attempts ;03/24/2004 11:12
+1 ;;8.0;KERNEL;**265,419**;Jul 10, 1995;Build 5
+2 QUIT
+3 ;The subfiles in KSP file.
+4 ;405.2 List of Terminal Servers, slack, last reset
+5 ;
+6 ;^XUSEC(3, (File 3.083) Locked IP's, lock until
+7 ;^XUSEC(4, (File 3.084) Failed attempts count
+8 ;$P(^VA(200,DUZ,1.1),U,5) Locked Users
+9 ;
CLEAN ;CLEAN UP OLD LOCKED IP NODES, ^XUSEC(3,
+1 NEW ZNUM,NOW
+2 SET ZNUM=0
SET NOW=$$NOW^XLFDT
+3 LOCK +^XUSEC(3,0):10
+4 FOR
SET ZNUM=$ORDER(^XUSEC(3,ZNUM))
if ZNUM'>0
QUIT
Begin DoDot:1
+5 IF $PIECE(^XUSEC(3,ZNUM,0),"^",2)'>NOW
DO LKDEL(ZNUM)
End DoDot:1
+6 LOCK -^XUSEC(3,0),+^XUSEC(4,0):10
+7 NEW XUFAC,OV
+8 SET ZNUM=0
SET NOW=$$H3-90
+9 FOR
SET ZNUM=$ORDER(^XUSEC(4,ZNUM))
if ZNUM'>0
QUIT
Begin DoDot:1
+10 SET OV=$$H3($PIECE(^XUSEC(4,ZNUM,0),"^",3))
IF OV'>NOW
Begin DoDot:2
+11 NEW DIK,DA
+12 SET DA=ZNUM
SET DIK="^XUSEC(4,"
DO ^DIK
End DoDot:2
End DoDot:1
+13 LOCK -^XUSEC(4,0)
+14 QUIT
X6IP ;EXAMINE AND ALLOW RESET OF LOCKED IPS
+1 NEW I,ZFDA,DIR,XUNOW,ZNM,ZNUM,Y
SET ZNM=""
SET I=0
+2 IF '$DATA(^XUSEC(3,"B"))
WRITE !,"There are no IP's to Clear"
QUIT
+3 FOR
SET ZNM=$ORDER(^XUSEC(3,"B",ZNM))
if ZNM']""
QUIT
SET ZNUM=$ORDER(^XUSEC(3,"B",ZNM,""))
Begin DoDot:1
+4 ;419
IF '$DATA(^XUSEC(3,ZNUM,0))
KILL ^XUSEC(3,"B",ZNM)
QUIT
+5 SET I=I+1
SET ZNM(I)=ZNUM_"^"_ZNM
+6 WRITE !,I_". ",ZNM," lock out till: ",$$FMTE^XLFDT($PIECE(^XUSEC(3,ZNUM,0),"^",2))
+7 QUIT
End DoDot:1
+8 SET DIR(0)="N^1:"_I
SET DIR("A")="Choose the number of the IP to reset"
DO ^DIR
if $DATA(DIRUT)
QUIT
+9 SET ZNM=$PIECE(ZNM(Y),"^",2)
SET ZNUM=+ZNM(Y)
+10 ;Call with IEN
+11 DO LKDEL(ZNUM)
+12 WRITE !,ZNM," Cleared"
+13 ;Call with IP
+14 ;Clear access count
DO CLRFAC^XUS3(ZNM)
+15 ;if this is a ts reset and then set reset date in site param file
+16 SET ZIEN=$$TSCHK(ZNM)
+17 IF ZIEN>0
SET ZFDA(8989.305,ZIEN_",1,",2)=$$NOW
DO UPDATE^DIE("","ZFDA")
+18 KILL DIR,DIRUT
+19 QUIT
+20 ;
LKSET(IP) ;Set IP Lock Node
+1 NEW ZNUM,ZFDA,ZIEN
+2 if '$$ON
QUIT 0
+3 SET ZIEN="?+2,"
SET ZFDA(3.083,ZIEN,.01)=IP
+4 SET ZFDA(3.083,ZIEN,2)=$$LKTL
+5 DO UPDATE^DIE("","ZFDA","ZIEN")
+6 ;Clear the access count
DO CLRFAC^XUS3(IP)
+7 QUIT 1
LKTL() ;Lock until
+1 QUIT $$HTFM^XLFDT($$HADD^XLFDT($HOROLOG,0,0,0,$$LKTME))
+2 ;
NOW() ;
+1 IF $GET(XUNOW)
QUIT XUNOW
+2 SET XUNOW=$$NOW^XLFDT
+3 QUIT XUNOW
+4 ;
IP() ;Get a device IP.
+1 QUIT $SELECT($DATA(IP):IP,$DATA(IO("IP")):IO("IP"),$DATA(IO("ZIO")):IO("ZIO"),1:"")
+2 ;
LKTME() ;Get lock-out time
+1 IF $DATA(XOPT)
QUIT $PIECE(XOPT,U,3)
+2 QUIT $PIECE(^XTV(8989.3,1,"XUS"),U,3)
+3 ;
LKCHECK(IP) ;Check if IP is LOCKED
+1 ;Are we doing IP/device locking
IF '$$ON
QUIT 0
+2 SET IP=$$IP()
if '$LENGTH(IP)
QUIT 0
+3 NEW ZREC
SET ZREC=$$LKREC(IP)
+4 if '$LENGTH(ZREC)
QUIT 0
+5 ;Found a LOCK record, Check time
+6 SET X=$PIECE(ZREC,"^",2)>$$NOW
+7 QUIT X
+8 ;
LKREC(IP) ;Get the Lock record
+1 NEW ZNUM
+2 SET ZNUM=+$ORDER(^XUSEC(3,"B",IP,0))
+3 QUIT $GET(^XUSEC(3,ZNUM,0))
+4 ;
LKDEL(ZNUM) ;Delete LOCKED IP
+1 ;419
NEW DIK,DA
+2 SET DIK="^XUSEC(3,"
SET DA=ZNUM
DO ^DIK
+3 QUIT
+4 ;
LKWAIT(%) ;How long to wait
+1 NEW T1,T2,IP
+2 SET IP=$$IP()
if '$LENGTH(IP)
QUIT %
+3 SET T1=$$LKREC(IP)
+4 QUIT $$FMDIFF^XLFDT($PIECE(T1,U,2),$$NOW^XLFDT,2)
+5 ;
TSCHK(IP) ;Check if IP is for a TERMINAL SERVER.
+1 ;is this IP for a teriminal server.
+2 NEW ZNUM
SET ZNUM=$ORDER(^XTV(8989.3,1,405.2,"B",IP,0))
+3 QUIT ZNUM
+4 ;
IPCHECK(IP) ;Check if IP should be LOCKED. Called from XUSTZ, and others.
+1 ;Return 1 if should lock, 0 if No.
+2 IF '$$ON
QUIT 0
+3 SET IP=$$IP
if '$LENGTH(IP)
QUIT 0
+4 NEW LIMIT,TSIEN,ZEND,ZNUM,ZLST,SLK,TFAC,TSREC,Z10
+5 ;If the IP is locked, Don't relock. Could cause an endless lock.
+6 IF $$LKCHECK(IP)
QUIT 0
+7 ;is this the IP of a teriminal server. if not lock
+8 ;Returns TS ien.
SET TSIEN=$$TSCHK(IP)
+9 ;If TSIEN<1 lock the IP.
+10 if TSIEN<1
QUIT 1
+11 ;count # of failures for this TS in last 10 minutes and compare that
+12 ;against the established limit. if no limit set, use 2. maybe cut
+13 ;some slack.
+14 ;NOW-10
SET Z10=$$HTFM^XLFDT($$HADD^XLFDT($HOROLOG,0,0,-10))
+15 ;Get TS record
SET TSREC=$GET(^XTV(8989.3,1,405.2,TSIEN,0))
+16 ;Last reset
SET ZLST=$PIECE(TSREC,"^",3)
+17 ;stop at last reset or NOW-10.
SET ZEND=$SELECT(ZLST>Z10:ZLST,1:Z10)
+18 SET ZNUM="A"
SET TFAC=0
SET Y=$SELECT(IP["/":"/",1:":")
+19 FOR
SET ZNUM=$ORDER(^%ZUA(3.05,ZNUM),-1)
if ZNUM'>0!(ZEND>ZNUM)
QUIT
Begin DoDot:1
+20 IF $PIECE($PIECE(^%ZUA(3.05,ZNUM,0),"^",7),Y)=$PIECE(IP,Y)
SET TFAC=TFAC+1
End DoDot:1
+21 SET LIMIT=$PIECE($GET(^XTV(8989.3,1,405)),"^",6)
if 'LIMIT
SET LIMIT=2
+22 ;
SET SLK=$$SLACK(Z10)
+23 QUIT $SELECT(SLK:TFAC>SLK,1:TFAC>LIMIT)
+24 ;
SLACK(TEND) ;SLACK CALCULATOR
+1 ;if this TS has been reset in last 10 minutes allow 100 tries.
+2 ;Normal hours return 0, after hours use TS Slack value
+3 NEW HRMIN,X,NOW,TS
+4 ;Last Reset
SET X=$PIECE(TSREC,"^",3)
+5 ;TEND is Now-10 min
IF X>TEND
QUIT 100
+6 ;if now is during normal work hours 8am to 4:30 pm, cut no slack
+7 SET HRMIN=$PIECE($HOROLOG,",",2)
+8 ; 8am is 28800 and 4:30 pm is 59400
+9 ; If Normal hours don't give slack unless user locking is on.
+10 IF (HRMIN>28800&(HRMIN<59400))
QUIT $SELECT($PIECE($GET(^XTV(8989.3,1,405)),"^",4)="y":10,1:0)
+11 ;if TS param says to cut slack, cut amount of slack set up in param.
+12 QUIT $SELECT($PIECE(TSREC,"^",2):$PIECE(TSREC,"^",2),1:0)
+13 ;
ON() ;ON OR OFF
+1 QUIT $PIECE($GET(^XTV(8989.3,1,405)),"^",1)="y"
+2 ;
H3(%H) ;Make seconds
+1 if '$GET(%H)
SET %H=$HOROLOG
+2 QUIT %H*86400+$PIECE(%H,",",2)
+3 ;
H0(%H) ;
+1 if '$GET(%H)
SET %H=0
+2 QUIT (%H\86400)_","_(%H#86400)
+3 ;
DSPTME(%H) ;Convert seconds to display format
+1 QUIT $$HTE^XLFDT($$H0(%H),"1P")
+2 ;
WATCH ;Watch the globals
+1 NEW TIME,C,I,X
WT2 SET TIME=$$HTE^XLFDT($HOROLOG)
+1 WRITE @IOF,"Failed access attempts count. Current time: ",TIME
+2 SET I=0
SET C=0
+3 FOR
SET I=$ORDER(^XUSEC(4,I))
if I'>0
QUIT
SET X=^(I,0)
SET C=1
WRITE !,I,?5,"IP: ",$PIECE(X,U,1),?25,"Count: ",$PIECE(X,U,2),?35,"Until: ",$$HTE^XLFDT($PIECE(X,U,3))
+4 IF C=0
WRITE !,?10,"None"
+5 WRITE !,"Locked IP's. Current time: ",TIME
+6 SET I=0
SET C=0
+7 FOR
SET I=$ORDER(^XUSEC(3,I))
if I'>0
QUIT
SET X=^(I,0)
SET C=1
WRITE !,I,?5,"IP: ",$PIECE(X,U,1),?25,"Until: ",$$FMTE^XLFDT($PIECE(X,U,2))
+8 IF C=0
WRITE !,?10,"None"
+9 READ !,"Refresh: Yes// ",X:30
if '$TEST
SET X="Y"
if "Yy"[$EXTRACT(X)
GOTO WT2
+10 IF $EXTRACT(X)="?"
WRITE !,"Enter 'Yes' or return to refresh, anyother key will exit"
HANG 2
GOTO WT2
+11 QUIT
