- 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 Jan 18, 2025@03:14:18 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