VBScript: Stop Dictionary FTP Attacks in IIS using VBScript

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.

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