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

XUSTZIP.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. ;The subfiles in KSP file.
  1. ;405.2 List of Terminal Servers, slack, last reset
  1. ;
  1. ;^XUSEC(3, (File 3.083) Locked IP's, lock until
  1. ;^XUSEC(4, (File 3.084) Failed attempts count
  1. ;$P(^VA(200,DUZ,1.1),U,5) Locked Users
  1. ;
  1. CLEAN ;CLEAN UP OLD LOCKED IP NODES, ^XUSEC(3,
  1. N ZNUM,NOW
  1. S ZNUM=0,NOW=$$NOW^XLFDT
  1. L +^XUSEC(3,0):10
  1. F S ZNUM=$O(^XUSEC(3,ZNUM)) Q:ZNUM'>0 D
  1. .I $P(^XUSEC(3,ZNUM,0),"^",2)'>NOW D LKDEL(ZNUM)
  1. L -^XUSEC(3,0),+^XUSEC(4,0):10
  1. N XUFAC,OV
  1. S ZNUM=0,NOW=$$H3-90
  1. F S ZNUM=$O(^XUSEC(4,ZNUM)) Q:ZNUM'>0 D
  1. .S OV=$$H3($P(^XUSEC(4,ZNUM,0),"^",3)) I OV'>NOW D
  1. ..N DIK,DA
  1. ..S DA=ZNUM,DIK="^XUSEC(4," D ^DIK
  1. L -^XUSEC(4,0)
  1. Q
  1. X6IP ;EXAMINE AND ALLOW RESET OF LOCKED IPS
  1. N I,ZFDA,DIR,XUNOW,ZNM,ZNUM,Y S ZNM="",I=0
  1. I '$D(^XUSEC(3,"B")) W !,"There are no IP's to Clear" Q
  1. F S ZNM=$O(^XUSEC(3,"B",ZNM)) Q:ZNM']"" S ZNUM=$O(^XUSEC(3,"B",ZNM,"")) D
  1. . I '$D(^XUSEC(3,ZNUM,0)) K ^XUSEC(3,"B",ZNM) Q ;419
  1. . S I=I+1,ZNM(I)=ZNUM_"^"_ZNM
  1. . W !,I_". ",ZNM," lock out till: ",$$FMTE^XLFDT($P(^XUSEC(3,ZNUM,0),"^",2))
  1. . Q
  1. S DIR(0)="N^1:"_I,DIR("A")="Choose the number of the IP to reset" D ^DIR Q:$D(DIRUT)
  1. S ZNM=$P(ZNM(Y),"^",2),ZNUM=+ZNM(Y)
  1. ;Call with IEN
  1. D LKDEL(ZNUM)
  1. W !,ZNM," Cleared"
  1. ;Call with IP
  1. D CLRFAC^XUS3(ZNM) ;Clear access count
  1. ;if this is a ts reset and then set reset date in site param file
  1. S ZIEN=$$TSCHK(ZNM)
  1. I ZIEN>0 S ZFDA(8989.305,ZIEN_",1,",2)=$$NOW D UPDATE^DIE("","ZFDA")
  1. K DIR,DIRUT
  1. Q
  1. ;
  1. LKSET(IP) ;Set IP Lock Node
  1. N ZNUM,ZFDA,ZIEN
  1. Q:'$$ON 0
  1. S ZIEN="?+2,",ZFDA(3.083,ZIEN,.01)=IP
  1. S ZFDA(3.083,ZIEN,2)=$$LKTL
  1. D UPDATE^DIE("","ZFDA","ZIEN")
  1. D CLRFAC^XUS3(IP) ;Clear the access count
  1. Q 1
  1. LKTL() ;Lock until
  1. Q $$HTFM^XLFDT($$HADD^XLFDT($H,0,0,0,$$LKTME))
  1. ;
  1. NOW() ;
  1. I $G(XUNOW) Q XUNOW
  1. S XUNOW=$$NOW^XLFDT
  1. Q XUNOW
  1. ;
  1. IP() ;Get a device IP.
  1. Q $S($D(IP):IP,$D(IO("IP")):IO("IP"),$D(IO("ZIO")):IO("ZIO"),1:"")
  1. ;
  1. LKTME() ;Get lock-out time
  1. I $D(XOPT) Q $P(XOPT,U,3)
  1. Q $P(^XTV(8989.3,1,"XUS"),U,3)
  1. ;
  1. LKCHECK(IP) ;Check if IP is LOCKED
  1. I '$$ON Q 0 ;Are we doing IP/device locking
  1. S IP=$$IP() Q:'$L(IP) 0
  1. N ZREC S ZREC=$$LKREC(IP)
  1. Q:'$L(ZREC) 0
  1. ;Found a LOCK record, Check time
  1. S X=$P(ZREC,"^",2)>$$NOW
  1. Q X
  1. ;
  1. LKREC(IP) ;Get the Lock record
  1. N ZNUM
  1. S ZNUM=+$O(^XUSEC(3,"B",IP,0))
  1. Q $G(^XUSEC(3,ZNUM,0))
  1. ;
  1. LKDEL(ZNUM) ;Delete LOCKED IP
  1. N DIK,DA ;419
  1. S DIK="^XUSEC(3,",DA=ZNUM D ^DIK
  1. Q
  1. ;
  1. LKWAIT(%) ;How long to wait
  1. N T1,T2,IP
  1. S IP=$$IP() Q:'$L(IP) %
  1. S T1=$$LKREC(IP)
  1. Q $$FMDIFF^XLFDT($P(T1,U,2),$$NOW^XLFDT,2)
  1. ;
  1. TSCHK(IP) ;Check if IP is for a TERMINAL SERVER.
  1. ;is this IP for a teriminal server.
  1. N ZNUM S ZNUM=$O(^XTV(8989.3,1,405.2,"B",IP,0))
  1. Q ZNUM
  1. ;
  1. IPCHECK(IP) ;Check if IP should be LOCKED. Called from XUSTZ, and others.
  1. ;Return 1 if should lock, 0 if No.
  1. I '$$ON Q 0
  1. S IP=$$IP Q:'$L(IP) 0
  1. N LIMIT,TSIEN,ZEND,ZNUM,ZLST,SLK,TFAC,TSREC,Z10
  1. ;If the IP is locked, Don't relock. Could cause an endless lock.
  1. I $$LKCHECK(IP) Q 0
  1. ;is this the IP of a teriminal server. if not lock
  1. S TSIEN=$$TSCHK(IP) ;Returns TS ien.
  1. ;If TSIEN<1 lock the IP.
  1. Q:TSIEN<1 1
  1. ;count # of failures for this TS in last 10 minutes and compare that
  1. ;against the established limit. if no limit set, use 2. maybe cut
  1. ;some slack.
  1. S Z10=$$HTFM^XLFDT($$HADD^XLFDT($H,0,0,-10)) ;NOW-10
  1. S TSREC=$G(^XTV(8989.3,1,405.2,TSIEN,0)) ;Get TS record
  1. S ZLST=$P(TSREC,"^",3) ;Last reset
  1. S ZEND=$S(ZLST>Z10:ZLST,1:Z10) ;stop at last reset or NOW-10.
  1. S ZNUM="A",TFAC=0,Y=$S(IP["/":"/",1:":")
  1. F S ZNUM=$O(^%ZUA(3.05,ZNUM),-1) Q:ZNUM'>0!(ZEND>ZNUM) D
  1. . I $P($P(^%ZUA(3.05,ZNUM,0),"^",7),Y)=$P(IP,Y) S TFAC=TFAC+1
  1. S LIMIT=$P($G(^XTV(8989.3,1,405)),"^",6) S:'LIMIT LIMIT=2
  1. S SLK=$$SLACK(Z10) ;
  1. Q $S(SLK:TFAC>SLK,1:TFAC>LIMIT)
  1. ;
  1. SLACK(TEND) ;SLACK CALCULATOR
  1. ;if this TS has been reset in last 10 minutes allow 100 tries.
  1. ;Normal hours return 0, after hours use TS Slack value
  1. N HRMIN,X,NOW,TS
  1. S X=$P(TSREC,"^",3) ;Last Reset
  1. I X>TEND Q 100 ;TEND is Now-10 min
  1. ;if now is during normal work hours 8am to 4:30 pm, cut no slack
  1. S HRMIN=$P($H,",",2)
  1. ; 8am is 28800 and 4:30 pm is 59400
  1. ; If Normal hours don't give slack unless user locking is on.
  1. I (HRMIN>28800&(HRMIN<59400)) Q $S($P($G(^XTV(8989.3,1,405)),"^",4)="y":10,1:0)
  1. ;if TS param says to cut slack, cut amount of slack set up in param.
  1. Q $S($P(TSREC,"^",2):$P(TSREC,"^",2),1:0)
  1. ;
  1. ON() ;ON OR OFF
  1. Q $P($G(^XTV(8989.3,1,405)),"^",1)="y"
  1. ;
  1. H3(%H) ;Make seconds
  1. S:'$G(%H) %H=$H
  1. Q %H*86400+$P(%H,",",2)
  1. ;
  1. H0(%H) ;
  1. S:'$G(%H) %H=0
  1. Q (%H\86400)_","_(%H#86400)
  1. ;
  1. DSPTME(%H) ;Convert seconds to display format
  1. Q $$HTE^XLFDT($$H0(%H),"1P")
  1. ;
  1. WATCH ;Watch the globals
  1. N TIME,C,I,X
  1. WT2 S TIME=$$HTE^XLFDT($H)
  1. W @IOF,"Failed access attempts count. Current time: ",TIME
  1. S I=0,C=0
  1. 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))
  1. I C=0 W !,?10,"None"
  1. W !,"Locked IP's. Current time: ",TIME
  1. S I=0,C=0
  1. 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))
  1. I C=0 W !,?10,"None"
  1. R !,"Refresh: Yes// ",X:30 S:'$T X="Y" G WT2:"Yy"[$E(X)
  1. I $E(X)="?" W !,"Enter 'Yes' or return to refresh, anyother key will exit" H 2 G WT2
  1. Q