Alert for Failed Login

[lpopejoy]

Re: Alert for Failed Login

Well... Any junior tech could root around and find any of it I guess. Is that a problem? Yeah, definitely get the updates.

[BDTECHRob]

Re: Alert for Failed Login

Hi Guys I thought I would share a script I use to email the failed logon attempts to you. It will only email new attempts each time as it logs each line of text scanned in the registry
I have marked the lines you need to edit clearly so you should all be able to work it out.
copy and paste it to notepad, and save it as a .vbs, MAKE Sure you execute it with administrative privileges or it wont be able to write to the registry.
hope you enjoy:

Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing", _
cdoSendUsingPort = 2, _
cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const ForReading = 1

Dim intStartAtLine, strFileCreateddate, i, strResults, strTextToScanFor

'who are you mailing to?
strMailto = "EMAILADDRESS GOES HERE"

'default email address the message will be from
strMailFrom = "EMAILFROMADDRESS GOES HERE"

'set SMTP email server address here
strSMTPServer = "MAILSERVER IP GOES HERE"

'full path to the file you wish to monitor
FileToRead = "\\SERVERNAME\<replace-with-the-path-to-the-failed-logins-log-file>"

Set WshShell = WScript.CreateObject("WScript.Shell")

On Error Resume Next
strLastFileCheckedCreateDate = WshShell.RegRead("HKLM\Software\RDScripts\CheckTXT File\CreateDate")
strLastFileLastLineChecked = WshShell.RegRead("HKLM\Software\RDScripts\CheckTXT File\LastLineChecked")

On Error GoTo 0

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set varFile = objFSO.GetFile(FileToRead)

'add more text to scan for by adding ,"item" to the array below
' for example, to search for two strings:
' array("text1","text2")
arrTextToScanFor = Array("Invalid User Name or Password","error")

strFileCreateDate = varfile.datecreated

If CStr(strFileCreateDate) = CStr(strLastFileCheckedCreateDate) Then
'if the date when the current file was created DOES equal
' the date of the file that was checked last time - it's
' the same file.
'
'so, we would want to CONTINUE the search from where we
' last left off.
'MsgBox "TEST!"
intStartAtLine = strLastFileLastLineChecked


ElseIf strFileCreateDate <> strLastFileCheckedCreateDate Then
'if the date when the current file was created does not equal
' the date of the file that was checked last time - it's
' a new file that has been created.
'
'so, we would want to begin the search from the beginning of
' the file.

intStartAtLine = 0

End If

i = 0
Dim strNextLine
'MsgBox intStartAtLine



Set objTextFile = objFSO.OpenTextFile(FileToRead, ForReading)
Do While objTextFile.AtEndOfStream <> True
If i < CInt(intStartAtLine) Then
objTextFile.skipline
Else
'MsgBox i
strNextLine = objTextFile.Readline
For each strItem in arrTextToScanFor

If InStr(LCase(strNextLine),LCase(strItem)) Then
strResults = strNextLine & vbcrlf & strResults
'MsgBox strResults
End If
Next
End If
i = i + 1

Loop
'MsgBox strResults
objTextFile.close

set WshShell = CreateObject("WScript.Shell")
WshShell.RegWrite "HKLM\Software\RDScripts\CheckTXTFile\FileChecked" , FileToRead, "REG_SZ"
WshShell.RegWrite "HKLM\Software\RDScripts\CheckTXTFile\CreateDa te", strFileCreateDate, "REG_SZ"
WshShell.RegWrite "HKLM\Software\RDScripts\CheckTXTFile\LastLineChec ked", i, "REG_SZ"
WshShell.RegWrite "HKLM\Software\RDScripts\CheckTXTFile\LastScanned" , Now, "REG_SZ"
set WshShell = nothing

If strResults <> "" Then Call sendmail(strMailFrom,strMailTo,"CommitCRM Web Failed Logon alert",strResults)

'------------------------------------------------------------------------
'Function EmailFile - email the warning file
'------------------------------------------------------------------------
Function SendMail(strFrom,strTo,strSubject,strMessage)
Dim iMsg, iConf, Flds
On Error GoTo 0

'// Create the CDO connections.
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields


'// SMTP server configuration.
With Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort

'// Set the SMTP server address here.
.Item(cdoSMTPServer) = strSMTPServer
.Update
End With

'// Set the message properties.
With iMsg
Set .Configuration = iConf
.To = strMailTo
.From = strMailFrom
.Subject = strSubject
.TextBody = strMessage
End With

'iMsg.HTMLBody = strMessage

'// Send the message.

iMsg.Send ' send the message.

If CStr(err.number) <> 0 Then

Else

End If
End Function

[Support Team]

Re: Alert for Failed Login

Thank you for sharing with the community.

[nattivillin]

Re: Alert for Failed Login

The script works, but it send everyone's usernames and passwords.

Very dangerous.

[nattivillin]

Re: Alert for Failed Login

We didnt know this and had the alerts sent to our shared support email, and now everyone's passwords were exposed to 5+ people.

[northwestmsp]

Re: Alert for Failed Login

Any updates on this? I feel like failed login attempt logging, minimum password complexity and/or automatic account locking is important for such a critical system.

[Support Team]

Re: Alert for Failed Login

Yes, there has been some progress. First IIS can now used for better and more secure SSL connections. In addition, starting with version 16 we've introduced the ability to enable 2FA with the Web interface so hacking employee RangerMSP user credentials isn't enough. Besides, we have several other ideas here that should be added to future versions. Thanks!