This has been working pretty well, but there was a flaw in recording the main domain name. My regex assumed all domains come in 2 parts as "example.com". This led to a few false positives where there were more than 2 parts to a domain, such as "example.co.uk" which got recorded as simply "co.uk". That's bad, of course. Fortunately, even though that that false positive was recorded into the database, I never got 3 of them alike and therefore never actually rejected any of the false positives. But that was just dumb luck, so I decided to parse the domain name off the public suffix list:
https://publicsuffix.org/list/
I finally worked that out in vbs, so I put it into action. The basic premise is that there are some spammers that are not bots. They have real domains and real matching PTRs, which evade my spam filters that reject connections based on those malformed criteria. Spamhaus usually catches them, but not immediately and they can get a lot of spam out the door before they get listed. The other property of these spammers is that they use multiple valid subdomains (and matching valid PTRs). This is the reason only the "main" domain gets recorded: all of the subdomains share the same "main" domain, so if you trap that, you trap them all.
Furthermore, I test the domain against several whitelists to protect against false positives. You wouldn't want gmail to end up on that list, for example.
A powershell script downloads the public suffix list and outputs the content to a vbs file that contains the list as a regex pattern. Run this weekly or monthly to update the pattern with any changes to the list. The output is like this:
Code: Select all
PubSufRegEx = "^ac$|^com\.ac$|^edu\.ac$|^gov\.ac$|^net\.ac$|^mil\.ac$|^org\.ac$|...REST OF LIST ABRIDGED...|^ad$"
DNS lookup requires RvdH's DNSResolverComponent:
https://d-fault.nl/files/DNSResolverCom ... .3.exe.zip
You can see my results here:
https://firewallban.dynu.net/search.php ... =CatchSpam
Notice how the domain names and subdomains are ridiculous words - easy to spot with a human eye, but since they're valid domains and PTRs, they slip through conventional filters.
The logic flow is as follows:
1) if message server is not whitelisted by any of several public lists, then
2) if spam score greater than delete threshold, then
3) record main domain into hm_catchspam database
4) after 3 spam messages > delete threshold, any future connections from that domain can safely be rejected
5) at OnHELO, check HELO against hm_catchspam database and if hits = 3, then reject connection (plus autoban or whatever else you want)
I have changed the database since the original post so that the script looks at "hits" instead of counting matching domains.
Code: Select all
' MySQL table
'
' CREATE TABLE `hm_catchspam` (
' `timestamp` datetime NOT NULL DEFAULT CURRENT_TIMESTAMP,
' `domain` varchar(25) NOT NULL,
' `hits` int(1) NOT NULL,
' PRIMARY KEY `domain`;
' ) ENGINE=InnoDB DEFAULT CHARSET=utf8;
Function Include(sInstFile)
Dim f, s, oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
If oFSO.FileExists(sInstFile) Then
Set f = oFSO.OpenTextFile(sInstFile)
s = f.ReadAll
f.Close
ExecuteGlobal s
End If
On Error Goto 0
End Function
Function Lookup(strRegEx, strMatch) : Lookup = False
With CreateObject("VBScript.RegExp")
.Pattern = strRegEx
.Global = False
.MultiLine = True
.IgnoreCase = True
If .Test(strMatch) Then Lookup = True
End With
End Function
Function oLookup(strRegEx, strMatch, bGlobal)
If strRegEx = "" Then strRegEx = StrReverse(strMatch)
With CreateObject("VBScript.RegExp")
.Pattern = strRegEx
.Global = bGlobal
.MultiLine = True
.IgnoreCase = True
Set oLookup = .Execute(strMatch)
End With
End Function
Function GetDatabaseObject()
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
Set GetDatabaseObject = oApp.Database
End Function
Function CatchSpam(spamDomain)
Dim strSQL, oDB : Set oDB = GetDatabaseObject
strSQL = "INSERT INTO hm_catchspam (domain,hits) VALUES ('" & spamDomain & "',1) ON DUPLICATE KEY UPDATE hits=(hits+1),timestamp=NOW();"
Call oDB.ExecuteSQL(strSQL)
End Function
Function IsCatchSpam(spamDomain) : IsCatchSpam = False
Dim m_CountDomain
Dim oRecord, oConn : Set oConn = CreateObject("ADODB.Connection")
oConn.Open "Driver={MariaDB ODBC 3.0 Driver}; Server=localhost; Database=hmailserver; User=hmailserver; Password=supersecretpassword;"
If oConn.State <> 1 Then
EventLog.Write( "Function IsCatchSpam - ERROR: Could not connect to database" )
Exit Function
End If
Set oRecord = oConn.Execute("SELECT hits FROM hm_catchspam WHERE domain = '" & spamDomain & "'")
Do Until oRecord.EOF
m_CountDomain = oRecord("hits")
oRecord.MoveNext
Loop
oConn.Close
Set oRecord = Nothing
If (CInt(m_CountDomain) > 2) Then IsCatchSpam = True
End Function
Function GetMainDomain(strDomain)
Dim strRegEx, Match, Matches
Dim SpamDomain
Dim TLDTopLevel, TLDSecondLevel, TLDThirdLevel, TLDFourthLevel, TLDFifthLevel
Include("C:\scripts\hmailserver\FWBan\PublicSuffix\public_suffix_list.vbs") '<-- USE VALID PATH
strRegEx = "[A-Za-z]+$"
Set Matches = oLookup(strRegEx, strDomain, False)
For Each Match In Matches
TLDTopLevel = LCase(Match.Value)
Next
strRegEx = "[A-Za-z0-9-]+\.[a-z]+$"
Set Matches = oLookup(strRegEx, strDomain, False)
For Each Match In Matches
TLDSecondLevel = LCase((Split(Match.Value, "."))(0))
Next
strRegEx = "[A-Za-z0-9-]+\.[A-Za-z0-9-]+\.[a-z]+$"
Set Matches = oLookup(strRegEx, strDomain, False)
For Each Match In Matches
TLDThirdLevel = LCase((Split(Match.Value, "."))(0))
Next
strRegEx = "[A-Za-z0-9-]+\.[A-Za-z0-9-]+\.[A-Za-z0-9-]+\.[a-z]+$"
Set Matches = oLookup(strRegEx, strDomain, False)
For Each Match In Matches
TLDFourthLevel = LCase((Split(Match.Value, "."))(0))
Next
strRegEx = "[A-Za-z0-9-]+\.[A-Za-z0-9-]+\.[A-Za-z0-9-]+\.[A-Za-z0-9-]+\.[a-z]+$"
Set Matches = oLookup(strRegEx, strDomain, False)
For Each Match In Matches
TLDFifthLevel = LCase((Split(Match.Value, "."))(0))
Next
Set Matches = oLookup(PubSufRegEx, TLDTopLevel, False)
For Each Match In Matches
If Match.Value = TLDTopLevel Then
SpamDomain = TLDSecondLevel & "." & TLDTopLevel
End If
Next
Set Matches = oLookup(PubSufRegEx, (TLDSecondLevel & "." & TLDTopLevel), False)
For Each Match In Matches
If Match.Value = TLDSecondLevel & "." & TLDTopLevel Then
SpamDomain = TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel
End If
Next
Set Matches = oLookup(PubSufRegEx, (TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel), False)
For Each Match In Matches
If Match.Value = TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel Then
SpamDomain = TLDFourthLevel & "." & TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel
End If
Next
Set Matches = oLookup(PubSufRegEx, (TLDFourthLevel & "." & TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel), False)
For Each Match In Matches
If Match.Value = TLDFourthLevel & "." & TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel Then
SpamDomain = TLDFifthLevel & "." & TLDFourthLevel & "." & TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel
End If
Next
GetMainDomain = SpamDomain
End Function
Function Whitelisted(strIP) : Whitelisted = 0
Dim a : a = Split(strIP, ".")
Dim strLookup, strRegEx
Dim IsWLMailSpike, IsWLHostKarma, IsWLNSZones, IsWLSPFBL, IsWLSpamDonkey, IsWLIPSWhitelisted
With CreateObject("DNSLibrary.DNSResolver")
strLookup = .DNSLookup(a(3) & "." & a(2) & "." & a(1) & "." & a(0) & ".rep.mailspike.net")
End With
strRegEx = "^127\.0\.0\.(18|19|20)$" '18=Good, 19=Very Good, 20=Excellent Reputation
IsWLMailSpike = Lookup(strRegEx, strLookup)
With CreateObject("DNSLibrary.DNSResolver")
strLookup = .DNSLookup(a(3) & "." & a(2) & "." & a(1) & "." & a(0) & ".hostkarma.junkemailfilter.com")
End With
strRegEx = "^127\.0\.0\.(1|5)$" '1=Good, 5=NoBL
IsWLHostKarma = Lookup(strRegEx, strLookup)
With CreateObject("DNSLibrary.DNSResolver")
strLookup = .DNSLookup(a(3) & "." & a(2) & "." & a(1) & "." & a(0) & ".wl.nszones.com")
End With
strRegEx = "^127\.0\.0\.5$" '5=whitelisted
IsWLNSZones = Lookup(strRegEx, strLookup)
With CreateObject("DNSLibrary.DNSResolver")
strLookup = .DNSLookup(a(3) & "." & a(2) & "." & a(1) & "." & a(0) & ".dnswl.spfbl.net")
End With
strRegEx = "^127\.0\.0\.(2|3|4|5)$" '2=excellent rep, 3=indispensable public service, 4=corp email (no marketing), 5=safe bulk mail
IsWLSPFBL = Lookup(strRegEx, strLookup)
With CreateObject("DNSLibrary.DNSResolver")
strLookup = .DNSLookup(a(3) & "." & a(2) & "." & a(1) & "." & a(0) & ".dnsbl.spamdonkey.com")
End With
strRegEx = "^126\.0\.0\.0$" '126.0.0.0=whitelisted
IsWLSpamDonkey = Lookup(strRegEx, strLookup)
With CreateObject("DNSLibrary.DNSResolver")
strLookup = .DNSLookup(a(3) & "." & a(2) & "." & a(1) & "." & a(0) & ".ips.whitelisted.org")
End With
strRegEx = "^127\.0\.0\.2$" '2=whitelisted
IsWLIPSWhitelisted = Lookup(strRegEx, strLookup)
If (IsWLMailSpike OR IsWLHostKarma OR IsWLNSZones OR IsWLSPFBL OR IsWLSpamDonkey OR IsWLIPSWhitelisted) Then Whitelisted = 1
End Function
Sub OnHELO(oClient)
REM - Exclude local LAN & Backup from test after recording connection
If (Left(oClient.IPAddress, 10) = "192.168.1.") Then Exit Sub
If oClient.IPAddress = "127.0.0.1" Then Exit Sub
REM - Reject on CatchSpam
Dim spamDomain : spamDomain = GetMainDomain(oClient.HELO)
If IsCatchSpam(spamDomain) Then
Result.Value = 2
Result.Message = ". 19 Your access to this mail system has been rejected due to the sending MTA's poor reputation. If you believe that this failure is in error, please contact the intended recipient via alternate means."
Exit Sub
End If
End Sub
Sub OnAcceptMessage(oClient, oMessage)
REM - Exclude local LAN & Backup from test after recording connection
If (Left(oClient.IPAddress, 10) = "192.168.1.") Then Exit Sub
If oClient.IPAddress = "127.0.0.1" Then Exit Sub
REM - Record entries for CatchSpam
Dim strRegEx, Match, Matches
Dim spamDomain, SAScore, SAHeader
If IsWhitelisted = 0 Then
If oMessage.HeaderValue("X-hMailServer-Reason-Score") <> "" Then
SAHeader = oMessage.HeaderValue("X-hMailServer-Reason-Score")
strRegEx = "[0-9]{1,3}"
Set Matches = oLookup(strRegEx, SAHeader, False)
For Each Match In Matches
SAScore = Match.Value
Next
If (CInt(SAScore) > 5) Then '<-- DELETE THRESHOLD MINUS ONE
spamDomain = GetMainDomain(oClient.HELO)
EventLog.Write( "Spam Received: Score = " & CInt(SAScore) & ", HELO = " & oClient.HELO & " Domain = " & spamDomain )
If spamDomain <> "" Then Call CatchSpam(spamDomain)
End If
End If
End If
End Sub
Powershell:
Code: Select all
<#
.SYNOPSIS
Download and format public_suffix_list.dat for use as RegEx pattern
.DESCRIPTION
Download and format public_suffix_list.dat for use as RegEx pattern
.FUNCTIONALITY
* Downloads public_suffix_list.dat
* Converts public_suffix_list.dat to RegEx pattern
* Outputs to vbs file for use with EventHandlers.vbs
.NOTES
Run weekly from task scheduler
.EXAMPLE
#>
<# Set script variables #>
$URL = "https://publicsuffix.org/list/public_suffix_list.dat"
$PubSufFile = "$PSScriptRoot\public_suffix_list.dat"
$CondensedDatList = "$PSScriptRoot\public_suffix_list.vbs"
<# Download latest Public Suffix data #>
<# First, if public_suffix_list.dat exists, get age in hours #>
If (Test-Path $PubSufFile) {
$LastDownloadTime = (Get-Item $PubSufFile).LastWriteTime
$HoursSinceLastDownload = [int](New-Timespan $LastDownloadTime).TotalHours
}
<# If public_suffix_list.dat doesn't exist or file at least 1 day old, then download #>
If (($HoursSinceLastDownload -gt 23) -or (-not(Test-Path $PubSufFile))) {
Try {
Start-BitsTransfer -Source $URL -Destination $PubSufFile -ErrorAction Stop
}
Catch {
Write-Host "Error downloading Public Suffix List: `n$Error[0]"
Exit
}
}
<# Read data file and output list formatted for RegEx (surround each with ^ and $) #>
Get-Content $PubSufFile | Where {((-not([string]::IsNullOrEmpty($_))) -and ($_ -notmatch "^//|^\*|^\!"))} | ForEach {
Write-Output "^$_$"
} | Out-File $CondensedDatList
<# Convert list to RegEx pattern #>
(Get-Content -Path $CondensedDatList) -Replace '$','|' | Set-Content -NoNewline -Path $CondensedDatList
(Get-Content -Path $CondensedDatList) -Replace '\.','\.' | Set-Content -NoNewline -Path $CondensedDatList
(Get-Content -Path $CondensedDatList) -Replace '^','PubSufRegEx = "' | Set-Content -NoNewline -Path $CondensedDatList
(Get-Content -Path $CondensedDatList) -Replace '\|$','' | Set-Content -NoNewline -Path $CondensedDatList
(Get-Content -Path $CondensedDatList) -Replace '$','"' | Set-Content -NoNewline -Path $CondensedDatList