Spencer Ruport of netortech.com modified my FTP ban script into one that stops dictionary attacks. And he chooses not to ban via the problematic IIS way but instead creating a bad route for the offending IP address. Pretty darn ingenius.
ftpdprotection.vbs
Set objFTPSVC = GetObject("IIS://localhost/MSFTPSVC")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLog = CreateObject("MSWC.IISLog")
Set objDictionary = CreateObject("Scripting.Dictionary")
Dim Attempts(), IP(), LastAttempt(), IPs
Dim AlreadyBanned, InProcess, Session
Dim CutOff, x, i
IPs = 0
'Iterate through each FTP site.
For Each objSITE in objFTPSVC
If lcase(objSITE.class) = "iisftpserver" Then
ftpLogFilePath = objSITE.LogFileDirectory & "\msftpsvc" & objSITE.Name
Set objFolder = objFSO.GetFolder(ftpLogFilePath)
Set objFiles = objFolder.Files
For Each fileName In objFiles
lastFile = fileName
Next
strLogFile = lastFile
Set file = Nothing
Set objFolder = Nothing
'Use the IIS log file parser provided by MSFT
objLog.OpenLogFile strLogFile, 1, "MSFTPSVC", 1, 0
'(FileName,IOMode,ServiceName,ServiceInstance,OutputLogFileFormat)
' 0 = NotApplicable, 1 = ForReading
Do While NOT objLog.AtEndOfLog
objLog.ReadLogRecord
If instr(ucase(objLog.Method), "USER") Then
'Someone is attempting to authenticate with the FTP server
InProcess = False
AlreadyBanned = False
For x = 0 to IPs - 1
'Check to see if this IP address has already attempted to log in.
If objLog.ClientIP = IP(x) Then
'To be nice this code will give the user
'another attempt every minute.
'This is to avoid banning a person who
'attempts to log in multiple times
'in a day but keeps forgetting their password.
Attempts(x) = Attempts(x) + datediff("n", objLog.DateTime, lastattempt(x))
LastAttempt(x) = objLog.DateTime
InProcess = True
End If
Next
If Not InProcess Then
'If we aren't keeping track of this IP
'it's possible the IP has already been
'added to the ban list.
AlreadyBanned = objDictionary.Exists(objLog.ClientIP)
End If
If Not InProcess And Not AlreadyBanned Then
'First authentication attempt by this IP
IPs = IPs + 1
Redim Preserve IP(IPs)
Redim Preserve Attempts(IPs)
Redim Preserve LastAttempt(IPs)
IP(IPs - 1) = objLog.ClientIP
Attempts(IPs - 1) = 1
LastAttempt(IPs - 1) = objLog.DateTime
End If
ElseIf instr(ucase(objLog.Method), "PASS") Then
'The server is responding to an authentication
'attempt.
For x = 0 to IPs - 1
'See if we're keeping track of this IP
If IP(x) = objLog.ClientIP Then
'Increment the authentication attempts
Attempts(x) = Attempts(x) + 1
If Attempts(x) = 10 Then
'Ban if necessary
WScript.Echo "Banning " & objLog.ClientIP & "..."
objDictionary.Add objLog.ClientIP, "255.255.255.255"
AddDeadRoute objLog.ClientIP
For i = x to (IPs - 2)
IP(i) = IP(i + 1)
Attempts(i) = Attempts(i + 1)
Next
IPs = IPs - 1
Redim Preserve IP(IPs)
Redim Preserve Attempts(IPs)
End If
End If
Next
End If
Loop
objLog.CloseLogFiles 1
End If
Next
Set objDictionary = Nothing
Set objLog = Nothing
Set objFSO = Nothing
Set objFTPSVC = Nothing
Function addDeadRoute(IP)
dim adoDBConn, sConnStr, objFSO, objBanBatch, cmdShell, WshShell
Dim fakeGateway
'I've been told that IPSec could be used to block certain IPs
'but 1) I'm not sure WMI can interface with it and 2) I don't
'know how to begin with. Someone gave me a much easier solution
'Simply add a route to the routing table pointing to a gateway
'that doesn't exist.
'Ensure that this IP is on the same subnet as the server
fakeGateway = "192.168.1.101"
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objBanBatch = objFSO.CreateTextFile("W:\config files\blocks\addRoute.bat", True)
objBanBatch.WriteLine "ROUTE ADD " & IP & " MASK 255.255.255.255 " & fakeGateWay
objBanBatch.Close
WshShell.Run """W:\config files\blocks\addRoute.bat""", 1, True
Set objFSO = Nothing
End Function
If you are on Active Directory and your VPN Software does not set the DNS servers to your local Domain Controllers, you may encounter the following error:
The system has detected a possible attempt to compromise security. Please ensure you can contact the server that authenticated you.
This appears to be some sort of problem with cached credentials and the inability to contact the DC even though you are on its subnet. If at all possible, have your administrator configure your VPN software to set your Primary DNS to the IP of the DC on your network. If that can't be done, adding an IP and hostname entry for your DC to LMHOSTS should work. For example
192.168.0.1 CorpDCserver #DOM:corpdomain.com
Near as I can figure, AD automatically sets each DC to sync time with the master DC. In order to make sure the master DC has the proper time and is set to be an available & reliable time source, run the following commands:
NET TIME /SETSNTP:time.windows.com
NET STOP W32TIME
NET START W32TIME
W32TM /config /reliable:YES
W32TM /resync /rediscover
Next, run the following command on the other DCs.
W32TM /resync /rediscover
And you're done!