Thanks to some scripts I found on various sources, I was able to piece together this script to detect and block ever-increasing dictionary attacks against the Administrator account on my FTP server. Basically, you start the script using WScript at system load. It hooks itself into WMI events for ftp log file entries. When an entry is created, the log file is scanned for any IP address which has 5 or more bad login attempts in the log file. The code then checks to see if that IP has already been assigned the invalid gateway address, and adds the bad routing instruction for that IP if it has not already done so.

This is an enhancement to scripts I originally found at NetNerds.net and VisiMetrics.com, which provided the base code to create the dead route. I’ve added the following:

  • a sink to gracefully handle a Windows shutdown
  • a flag file located in the same folder as the script file, which will cause the script to terminate when deleted. It’s a way to kill a specific WScript process, instead of guessing which one of the umpteen WScript processes to remove in the task manager.
  • Logging to the NT Application Event Log when starting, stopping, or creating bad route entries for attackers.

All you need to do to make the script run is change the values assigned to three variables.

  • fakeGateWayIP = “192.168.1.200” ‘The black hole location in your sub-net to route the packets.
  • xMax = 5 ‘Max number of invalid login attempts
  • LogFiles = 10 ‘Max number of log files to keep in the folder before deleting them.

The beauty of this script is that it does not persist the bad routing instructions in other than the routing table, meaning that they are lost at the next reboot. If the attack occurs again, the bad route is just re-established after 5-10 attempts from the attacker. Truly a remarkably simple and effective technique. Thanks Chrissy and Tim!

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211

REM FtpBlocker.vbs
REM Launch once at system startup. Monitors the ftp activity for bad login attempts (Status Code 530).
REM If more than X failed login attempts are tried by a client, it's IP is added
REM to the routing table, with a fake gateway (dead IP) as the routing target. Designed to thwart
REM dictionary attacks.
REM This script works with Windows 2000 and later.
Dim aIpRoute, bShuttingDown
Function FileExists (sFileName)
	Dim oFSOSet oFSO = CreateObject("Scripting.FileSystemObject")
	FileExists = oFSO.FileExists(sFileName)
	set oFSO = Nothing
End Function
 
Sub DeleteFile (sFileName, bEvenIfReadOnly)
	Dim oFSO
 
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	FileDelete = oFSO.DeleteFile(sFileName, bEvenIfReadOnly)
	set oFSO = Nothing
End Sub
 
Function FileToString (sFileName)
	Dim oFSO, oTS
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set oTS = oFSO.OpenTextFile(sFileName, 1)
 
	FileToString = oTS.ReadAll
	oTS.Close()
 
	set oTS = Nothing
	set oFSO = Nothing
End Function
 
Sub StringToFile (sFileName, sText)
	Dim oFSO, oTS
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set oTS = oFSO.OpenTextFile(sFileName, 2, True)
 
	oTS.Write sText
	oTS.Close()
 
	set oTS = Nothing
	set oFSO = Nothing
End Sub
 
Function RunOutput(cProgram, nWindowType)
	REM -- Obtain a Temporary File Name
	Dim oFS
	Set oFS = CreateObject("Scripting.FileSystemObject")
	Dim cFile
	cFile = oFS.GetSpecialFolder(2).Path & "\" & oFS.GetTempName
 
	REM -- Execute the command and redirect the output to the file
	Dim oShell
	Set oShell = CreateObject( "WScript.Shell" )
	oShell.Run cProgram & " >" & cFile, nWindowType, True
	Set oShell = Nothing
 
	REM -- Read output file and return
	Dim oFile
	Set oFile = oFS.OpenTextFile(cFile, 1, True)
	RunOutput = oFile.ReadAll()
	oFile.Close
 
	REM -- Delete Temporary File
	oFS.DeleteFile cFile
	Set oFS = Nothing
End Function
 
Function GetRoutingEntries()
	REM Capture the content of the current routing table.
	aRaw = Split (RunOutput("%COMSPEC% /C ROUTE PRINT", 0), vbCrLf)
 
	Set o = new RegExp
	o.Pattern = "((\d)+\.){3}(\d)+"
	o.Global = True
	o.MultiLine = False
	o.IgnoreCase = False
	aIP = Empty
	For Each s In aRaw
		Set oMatches = o.Execute (s)
		If oMatches.Count = 4 Then
			If IsArray (aIP) Then
				ReDim Preserve aIP (UBound (aIP, 1) + 1)
			Else
				ReDim aIP (0)
			End If
			aIP (UBound (aIP, 1)) = oMatches.Item(0) & "|" & oMatches.Item(2)
		End If
	Next
	GetRoutingEntries = aIP
End Function
 
REM -- Log the startup to the event log.
Set oWsh = WScript.CreateObject("WScript.Shell")
oWsh.LogEvent 0, "FtpBlocker530.vbs begins"
Set oWsh = WScript.CreateObject("WScript.Shell")
 
REM Load a snapshot of the IP's in the routing table, and use this as the baseline for determining
REM if the IP is in the list already.
 
aIpRoute = GetRoutingEntries()
bShuttingDown = False
 
REM Push Event Viewer Alert
Set objWMIService = GetObject("winmgmts:{(security)}!root/cimv2")
Set eventSink = wscript.CreateObject("WbemScripting.SWbemSink", "EVSINK100_")
strWQL = "Select * from __InstanceCreationEvent where TargetInstance isa 'Win32_NTLogEvent' and TargetInstance.SourceName = 'MSFTPSVC' and TargetInstance.EventCode = 100"
objWMIService.ExecNotificationQueryAsync eventSink,strWQL
 
Set objWMIService1 = GetObject("winmgmts:{(security)}!root/cimv2")
Set eventSink1 = wscript.CreateObject("WbemScripting.SWbemSink", "EVSINK6006_")
strWQL = "Select * from __InstanceCreationEvent where TargetInstance isa 'Win32_NTLogEvent' and TargetInstance.SourceName = 'eventlog' and TargetInstance.EventCode = 6006"
objWMIService.ExecNotificationQueryAsync eventSink1,strWQL
 
REM Create a flag file named FtpBlocker530.flg
REM When this file is not on the system, it is a signal to terminate this application.
 
StringToFile "FtpBlocker530.flg", "*** MARKER FILE ONLY ***"
 
REM Keep it going forever, or until the marker file is missing.
While (FileExists ("FtpBlocker530.flg") And Not bShuttingDown)
	Wscript.Sleep(1000)
Wend
 
If Not bShuttingDown Then
	Set oWsh = WScript.CreateObject("WScript.Shell")
	oWsh.LogEvent 0, "FtpBlocker530.vbs stopped by file removal"
	Set oWsh = Nothing
Else
	DeleteFile "FtpBlocker530.flg", True
End If
Set eventSink = Nothing
Set eventSink1 = Nothing
Set objWMIService = Nothing
Set objWMIService1 = Nothing
 
Sub EVSINK6006_OnObjectReady(objObject, objAsyncContext)
	bShuttingDown = True
End Sub
 
Sub EVSINK100_OnObjectReady(objObject, objAsyncContext)
 
	Set objDictionary = CreateObject("Scripting.Dictionary")
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objLog = CreateObject("MSWC.IISLog")
	Set WshShell = WScript.CreateObject("WScript.Shell")
 
	fakeGateWayIP = "192.168.1.200" 'This is a black hole location on your subnet to route the packets.
	xMax = 5 'Max number of invalid login attempts
	xLogFiles = 10 'Max number of log files to keep in the folder before deleting them
 
	Set objFolder = objFSO.GetFolder(objFSO.GetSpecialFolder(0).Path & "\system32\LogFiles\MSFTPSVC1\")
	Set objFiles = objFolder.Files
	For Each fileName In objFiles
		lastFile = fileName
		Set f = objFSO.GetFile(fileName)
		If f.DateCreated <= Date - xLogFiles Then objFSO.DeleteFile FileName, True
		Set f = Nothing
	Next
	Set objFiles = Nothing
	Set objFolder = Nothing
 
	objLog.OpenLogFile lastFile, 1, "MSFTPSVC", 1, 0
	While NOT objLog.AtEndOfLog
		objLog.ReadLogRecord
		clientIP = trim(objLog.ClientIP)
		xStatus = trim(objLog.ProtocolStatus)
		If xStatus = "530" AND NOT (clientIP = fakeGateWayIP) then
			If objDictionary.Exists(ClientIP) Then
				objDictionary.Item(clientIP) = cStr(Clng(objDictionary.Item(clientIP)) + 1)
			Else
				objDictionary.Add clientIP,"1"
			End If
		End If
	Wend
	objLog.CloseLogFiles 1
 
	xChange = False
	For Each xClient in objDictionary.Keys
		xTest = False
		If Clng(objDictionary.Item(xClient)) < xMax then
			objDictionary.Remove(xClient)
		Else
			xTest = Not IsArray (aIpRoute)
			If Not xTest Then
				xTest = True
				For Each ip In aIpRoute
					If Split (ip, "|")(0) = xClient And Split (ip, "|")(1) = fakeGateWayIP Then
						xTest = False ' Client already exists in the routing table with the fakeGateWayIP as the gateway
						Exit For
					End If
				Next
			End If
			If xTest Then
				xChange = True
				WshShell.Run "%COMSPEC% /C ROUTE ADD " & xClient & " MASK 255.255.255.255 " & fakeGateWayIP, 0, True
				WshShell.LogEvent 1, "BAD ROUTE(s) assigned: FTP max of " & xMax & " occurrences for 530 Event(s) exceeded for " & xClient
			End If
		End If
	Next
 
	Set WshShell = Nothing
	Set objLog = Nothing
	Set objFSO = Nothing
	Set objDictionary = Nothing
 
	If xChange Then
		aIpRoute = GetRoutingEntries()
	End If
End Sub

No Comments
VBScript.Sinks