- XUSFACHK ;ISF/RWF - FAILED ACCESS ATTEMPTS LOG MONITOR ;10/15/2003 15:25
- ;;8.0;KERNEL;**265**;July 10, 1995
- Q
- ;Built on work by DAF.
- FAILED ;FAILED ACCESS ATTEMPTS SCAN PROGRAM
- ;This subroutine will watch over file 3.05 and report if it
- ;finds repeated signon attempts from the same IP address
- N DA,DIC,DIE,DIK,DR,%,%Y,ZCNT,WORK,XKT,TCI
- N XLST,LAST,TCNT,NUM,NOW,ZTIO,AODLM,AODBUL,IRMLM,IRMBUL
- K ^TMP($J)
- S NOW=$$NOW^XLFDT,^XTMP("XUSFACHK",0)=$$HTFM^XLFDT($H+3)
- ;Check last time this ran. reset last run time to now.
- S XLST=$$GET1^DIQ(8989.3,"1,",405.15,"I"),DA=1,DIE="^XTV(8989.3,",DR="405.15////"_NOW D ^DIE
- S XKT=$$GET1^DIQ(8989.3,"1,",405.17,"I") ;Get Keep Threshold
- S TCI=$$GET1^DIQ(8989.3,"1,",405.18,"I") ;Get Total Count Increase
- ;loop through failed attempts log. count any that happened since last run time.
- S NUM=XLST-.0000001 S:NUM<0 NUM=0
- F S NUM=$O(^%ZUA(3.05,NUM)) Q:NUM'>0 D
- . S ZTIO=$P(^%ZUA(3.05,NUM,0),"^",7) Q:'$L(ZTIO) S ZTIO=$P(ZTIO,$S(ZTIO["/":"/",1:":"),1)
- . S ^TMP($J,ZTIO)=$G(^TMP($J,ZTIO))+1
- CHKIT ;check to see if number of attempts on any one port is over KEEP THRESHOLD, if so save it.
- S IRMLM=$$GET1^DIQ(8989.3,"1,",405.12,"I"),AODLM=$$GET1^DIQ(8989.3,"1,",405.13,"I"),WORK=$$NBH(NOW)
- S (AODBUL,IRMBUL,TCNT)=0
- S ZTIO="" F S ZTIO=$O(^TMP($J,ZTIO)) Q:'$L(ZTIO) D
- . S TCNT=TCNT+^TMP($J,ZTIO)
- . D:^TMP($J,ZTIO)>XKT SET
- . I WORK,($G(^XTMP("XUSFACHK",2,ZTIO))>IRMLM)!(TCNT>(IRMLM+TCI)) S IRMBUL=1
- . I 'WORK,($G(^XTMP("XUSFACHK",2,ZTIO))>AODLM)!(TCNT>(AODLM+TCI)) S AODBUL=1
- . Q
- D CLEAN
- ;send bulletin to irm if during work hours. if after hours send to irm and aod.
- I IRMBUL!(AODBUL) D BULL
- EXIT Q
- ;clean up and leave.
- CLEAN ;clean up ^XTMP("XUSFACHK" global, If no new failed attempts remove.
- N ZNUM,ZZNUM
- S ZNUM="" F S ZNUM=$O(^XTMP("XUSFACHK",2,ZNUM)) Q:'$L(ZNUM) D
- .I '$D(^TMP($J,ZNUM)) D
- ..K ^XTMP("XUSFACHK",2,ZNUM)
- Q
- SET ;set ^XTMP("XUSFACHK" global.
- S ^XTMP("XUSFACHK",2,ZTIO)=$G(^XTMP("XUSFACHK",2,ZTIO))+^TMP($J,ZTIO)
- Q
- BULL ;send bulletin to irm. if after hours, send to aod and have irm paged.
- N NUM,DTE,X,Y,XMY,XMSUB,XMTEXT,ZCNT,I,XMDUZ,XMZ
- S XMSUB="THERE HAVE BEEN A LARGE NUMBER OF FAILED ACCESS ATTEMPTS!!"
- S XMTEXT="^TMP(""XM"",$J,",XMDUZ=.5,ZCNT=0
- S Y=$$GET1^DIQ(8989.3,"1,",.02,"I") I $L(Y) S XMY(Y)=""
- I AODBUL S Y=$$GET1^DIQ(8989.3,"1,",.03,"I") I $L(Y) S XMY(Y)=""
- I '$D(XMY) S XMY(.5)=""
- S DTE=$$FMTE^XLFDT(XLST,"1P")
- D TXT("Since "_DTE_" there have been "_TCNT_" failed access attempts on VistA")
- S NUM="" F S NUM=$O(^TMP($J,NUM)) Q:NUM']"" I ^TMP($J,NUM)>XKT D
- . D TXT("Device "_NUM_" has had "_$G(^XTMP("XUSFACHK",2,NUM))_" attempts total so far.")
- . Q
- D TXT(" ")
- D TXT("Someone from IRM should check the Failed Access Attempts log.")
- I AODBUL D TXT("AOD PLEASE PAGE THE IRM ON-CALL PERSON")
- N DO,DIX,DIY
- D ^XMD
- Q
- ;
- TXT(S) ;Add text to ^TMP("XM",$J
- S ZCNT=ZCNT+1,^TMP("XM",$J,ZCNT)=S
- Q
- ;
- NBH(DATE) ;FIND OUT IF NOW IS DURING NORMAL BUSINESS HOURS.
- ;SEND DATE/TIME IN FILEMAN FORMAT
- N %,%Y
- S %Y=$$DOW^XLFDT(DATE,1)
- Q:%Y<1!(%Y>5) 0
- Q:$D(^HOLIDAY($P(DATE,".",1))) 0
- Q:$E($P(DATE,".",2)_"0000",1,4)>1630!($E($P(DATE,".",2)_"0000",1,4)<0800) 0
- Q 1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSFACHK 3246 printed Apr 23, 2025@18:27:02 Page 2
- XUSFACHK ;ISF/RWF - FAILED ACCESS ATTEMPTS LOG MONITOR ;10/15/2003 15:25
- +1 ;;8.0;KERNEL;**265**;July 10, 1995
- +2 QUIT
- +3 ;Built on work by DAF.
- FAILED ;FAILED ACCESS ATTEMPTS SCAN PROGRAM
- +1 ;This subroutine will watch over file 3.05 and report if it
- +2 ;finds repeated signon attempts from the same IP address
- +3 NEW DA,DIC,DIE,DIK,DR,%,%Y,ZCNT,WORK,XKT,TCI
- +4 NEW XLST,LAST,TCNT,NUM,NOW,ZTIO,AODLM,AODBUL,IRMLM,IRMBUL
- +5 KILL ^TMP($JOB)
- +6 SET NOW=$$NOW^XLFDT
- SET ^XTMP("XUSFACHK",0)=$$HTFM^XLFDT($HOROLOG+3)
- +7 ;Check last time this ran. reset last run time to now.
- +8 SET XLST=$$GET1^DIQ(8989.3,"1,",405.15,"I")
- SET DA=1
- SET DIE="^XTV(8989.3,"
- SET DR="405.15////"_NOW
- DO ^DIE
- +9 ;Get Keep Threshold
- SET XKT=$$GET1^DIQ(8989.3,"1,",405.17,"I")
- +10 ;Get Total Count Increase
- SET TCI=$$GET1^DIQ(8989.3,"1,",405.18,"I")
- +11 ;loop through failed attempts log. count any that happened since last run time.
- +12 SET NUM=XLST-.0000001
- if NUM<0
- SET NUM=0
- +13 FOR
- SET NUM=$ORDER(^%ZUA(3.05,NUM))
- if NUM'>0
- QUIT
- Begin DoDot:1
- +14 SET ZTIO=$PIECE(^%ZUA(3.05,NUM,0),"^",7)
- if '$LENGTH(ZTIO)
- QUIT
- SET ZTIO=$PIECE(ZTIO,$SELECT(ZTIO["/":"/",1:":"),1)
- +15 SET ^TMP($JOB,ZTIO)=$GET(^TMP($JOB,ZTIO))+1
- End DoDot:1
- CHKIT ;check to see if number of attempts on any one port is over KEEP THRESHOLD, if so save it.
- +1 SET IRMLM=$$GET1^DIQ(8989.3,"1,",405.12,"I")
- SET AODLM=$$GET1^DIQ(8989.3,"1,",405.13,"I")
- SET WORK=$$NBH(NOW)
- +2 SET (AODBUL,IRMBUL,TCNT)=0
- +3 SET ZTIO=""
- FOR
- SET ZTIO=$ORDER(^TMP($JOB,ZTIO))
- if '$LENGTH(ZTIO)
- QUIT
- Begin DoDot:1
- +4 SET TCNT=TCNT+^TMP($JOB,ZTIO)
- +5 if ^TMP($JOB,ZTIO)>XKT
- DO SET
- +6 IF WORK
- IF ($GET(^XTMP("XUSFACHK",2,ZTIO))>IRMLM)!(TCNT>(IRMLM+TCI))
- SET IRMBUL=1
- +7 IF 'WORK
- IF ($GET(^XTMP("XUSFACHK",2,ZTIO))>AODLM)!(TCNT>(AODLM+TCI))
- SET AODBUL=1
- +8 QUIT
- End DoDot:1
- +9 DO CLEAN
- +10 ;send bulletin to irm if during work hours. if after hours send to irm and aod.
- +11 IF IRMBUL!(AODBUL)
- DO BULL
- EXIT QUIT
- +1 ;clean up and leave.
- CLEAN ;clean up ^XTMP("XUSFACHK" global, If no new failed attempts remove.
- +1 NEW ZNUM,ZZNUM
- +2 SET ZNUM=""
- FOR
- SET ZNUM=$ORDER(^XTMP("XUSFACHK",2,ZNUM))
- if '$LENGTH(ZNUM)
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^TMP($JOB,ZNUM))
- Begin DoDot:2
- +4 KILL ^XTMP("XUSFACHK",2,ZNUM)
- End DoDot:2
- End DoDot:1
- +5 QUIT
- SET ;set ^XTMP("XUSFACHK" global.
- +1 SET ^XTMP("XUSFACHK",2,ZTIO)=$GET(^XTMP("XUSFACHK",2,ZTIO))+^TMP($JOB,ZTIO)
- +2 QUIT
- BULL ;send bulletin to irm. if after hours, send to aod and have irm paged.
- +1 NEW NUM,DTE,X,Y,XMY,XMSUB,XMTEXT,ZCNT,I,XMDUZ,XMZ
- +2 SET XMSUB="THERE HAVE BEEN A LARGE NUMBER OF FAILED ACCESS ATTEMPTS!!"
- +3 SET XMTEXT="^TMP(""XM"",$J,"
- SET XMDUZ=.5
- SET ZCNT=0
- +4 SET Y=$$GET1^DIQ(8989.3,"1,",.02,"I")
- IF $LENGTH(Y)
- SET XMY(Y)=""
- +5 IF AODBUL
- SET Y=$$GET1^DIQ(8989.3,"1,",.03,"I")
- IF $LENGTH(Y)
- SET XMY(Y)=""
- +6 IF '$DATA(XMY)
- SET XMY(.5)=""
- +7 SET DTE=$$FMTE^XLFDT(XLST,"1P")
- +8 DO TXT("Since "_DTE_" there have been "_TCNT_" failed access attempts on VistA")
- +9 SET NUM=""
- FOR
- SET NUM=$ORDER(^TMP($JOB,NUM))
- if NUM']""
- QUIT
- IF ^TMP($JOB,NUM)>XKT
- Begin DoDot:1
- +10 DO TXT("Device "_NUM_" has had "_$GET(^XTMP("XUSFACHK",2,NUM))_" attempts total so far.")
- +11 QUIT
- End DoDot:1
- +12 DO TXT(" ")
- +13 DO TXT("Someone from IRM should check the Failed Access Attempts log.")
- +14 IF AODBUL
- DO TXT("AOD PLEASE PAGE THE IRM ON-CALL PERSON")
- +15 NEW DO,DIX,DIY
- +16 DO ^XMD
- +17 QUIT
- +18 ;
- TXT(S) ;Add text to ^TMP("XM",$J
- +1 SET ZCNT=ZCNT+1
- SET ^TMP("XM",$JOB,ZCNT)=S
- +2 QUIT
- +3 ;
- NBH(DATE) ;FIND OUT IF NOW IS DURING NORMAL BUSINESS HOURS.
- +1 ;SEND DATE/TIME IN FILEMAN FORMAT
- +2 NEW %,%Y
- +3 SET %Y=$$DOW^XLFDT(DATE,1)
- +4 if %Y<1!(%Y>5)
- QUIT 0
- +5 if $DATA(^HOLIDAY($PIECE(DATE,".",1)))
- QUIT 0
- +6 if $EXTRACT($PIECE(DATE,".",2)_"0000",1,4)>1630!($EXTRACT($PIECE(DATE,".",2)_"0000",1,4)<0800)
- QUIT 0
- +7 QUIT 1
