Ban spammers based on prior spamming

This section contains scripts that hMailServer has contributed with. hMailServer 5 is needed to use these.
Post Reply
palinka
Senior user
Senior user
Posts: 1964
Joined: 2017-09-12 17:57

Ban spammers based on prior spamming

Post by palinka » 2019-12-04 22:56

I noticed a pattern for certain types of spammers. I do not believe they are bots. They have a real domain and PTR. I think they just blast out as much as they can for a day or 2 until spamhaus and others pick them up and they start getting blocked all over the place. But for that day or 2 they can get mucho spam out the door.

The other thing is that they use subdomains on other IPs, so they can send from many IPs using the same domain - and all of them have valid PTRs. I've been using Soren's xml solution to filter these guys out using regex for the main domain, but that requires a manual entry after noticing a flood of spam. I wanted to automate it, but I couldn't figure out how to programmatically write to xml. I also tried json but had issues with that as well. Finally, I settled on a database solution because its simpler for me to create.

The script works in 2 parts:

1) If a message is marked as spam, add "domain.tld" (not the full subdomain.domain.tld) to the database.
2) Check HELO against the database - if the domain.tld portion of the HELO matches the database AND there are at least 3 entries for domain.tld (3 bonafide spams), the reject the connection.

I think it probably still needs some fine tuning to protect against false positives, but the concept is sound.

MySQL:

Code: Select all

CREATE TABLE `hm_catchspam` (
  `timestamp` datetime NOT NULL DEFAULT CURRENT_TIMESTAMP,
  `domain` varchar(25) NOT NULL
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
COMMIT;

Eventhandlers.vbs:

Code: Select all

Function CatchSpam(spamDomain)
	Dim strSQL, oDB : Set oDB = GetDatabaseObject
	strSQL = "INSERT INTO hm_catchspam (domain) VALUES (spamDomain);"
	Call oDB.ExecuteSQL(strSQL)
End Function

Function IsCatchSpam(spamDomain) : IsCatchSpam = False
    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 COUNT(domain) AS countdomain FROM hm_catchspam WHERE domain = '" & spamDomain & "'")
    Do Until oRecord.EOF
        m_CountDomain = oRecord("countdomain")
        oRecord.MoveNext
    Loop
    oConn.Close
    Set oRecord = Nothing
	If (CInt(m_CountDomain) > 2) Then IsCatchSpam = True
End Function

Sub OnHELO(oClient)

	'	Reject on CatchSpam
	strRegEx = "[a-z0-9]+\.[a-z]{2,12}$"
	Set Matches = oLookup(strRegEx, oClient.HELO, False)
	For Each Match In Matches
	   spamDomain = Match.Value
	Next
	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."
		Call AutoBan(oClient.IPAddress, "CatchSpam - " & oClient.IpAddress, 1, "h") ' https://www.hmailserver.com/forum/viewtopic.php?p=186868#p186868
		Exit Sub
	End If	

End Sub

Sub OnAcceptMessage(oClient, oMessage)

	'	Record entries for CatchSpam
	If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then 
		strRegEx = "[a-z0-9]+\.[a-z]{2,12}$"
		Set Matches = oLookup(strRegEx, oClient_HELO, False)
		For Each Match In Matches
		   spamDomain = Match.Value
		Next
		Call CatchSpam(spamDomain)
	End If

End Sub

palinka
Senior user
Senior user
Posts: 1964
Joined: 2017-09-12 17:57

Re: Ban spammers based on prior spamming

Post by palinka » 2019-12-05 03:27

oops.... some remnants from testing it. Here is adjusted script:

EventHandlers.vbs:

Code: Select all

Function CatchSpam(spamDomain)
	Dim strSQL, oDB : Set oDB = GetDatabaseObject
	strSQL = "INSERT INTO hm_catchspam (domain) VALUES ('" & spamDomain & "');"
	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 COUNT(domain) AS countdomain FROM hm_catchspam WHERE domain = '" & spamDomain & "'")
    Do Until oRecord.EOF
        m_CountDomain = oRecord("countdomain")
        oRecord.MoveNext
    Loop
    oConn.Close
    Set oRecord = Nothing
	If (CInt(m_CountDomain) > 2) Then IsCatchSpam = True
End Function

Sub OnHELO(oClient)

	'	Reject on CatchSpam
	Dim spamDomain
	strRegEx = "[a-z0-9]+\.[a-z]{2,12}$"
	Set Matches = oLookup(strRegEx, oClient.HELO, False)
	For Each Match In Matches
	   spamDomain = Match.Value
	Next
	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."
		Call AutoBan(oClient.IPAddress, "CatchSpam - " & oClient.IpAddress, 1, "h") ' https://www.hmailserver.com/forum/viewtopic.php?p=186868#p186868
		Exit Sub
	End If	

End Sub

Sub OnAcceptMessage(oClient, oMessage)

	'	Record entries for CatchSpam
	Dim spamDomain
	If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then 
		strRegEx = "[a-z0-9]+\.[a-z]{2,12}$"
		Set Matches = oLookup(strRegEx, oClient.HELO, False)
		For Each Match In Matches
		   spamDomain = Match.Value
		Next
		Call CatchSpam(spamDomain)
	End If

End Sub

palinka
Senior user
Senior user
Posts: 1964
Joined: 2017-09-12 17:57

Re: Ban spammers based on prior spamming

Post by palinka » 2019-12-05 16:16

I want to trap the spamassassin score because I think its a better predictor of true spam. Is spamassassin always "Reason-1" in the header?

Code: Select all

X-hMailServer-Reason-1: Tagged as Spam by SpamAssassin - (Score: 7)
Is there a better way to obtain the score?

palinka
Senior user
Senior user
Posts: 1964
Joined: 2017-09-12 17:57

Re: Ban spammers based on prior spamming

Post by palinka » 2019-12-05 20:31

Here's what I have in OnAcceptMessage. It seems to be working - at least I don't have any errors. Haven't received any spam yet since setting it up.

Code: Select all

	'	Record entries for CatchSpam
	Dim spamDomain, SAScore, SAHeader
	If oMessage.HeaderValue("X-hMailServer-Reason-1") <> "" Then 
		SAHeader = oMessage.HeaderValue("X-hMailServer-Reason-1")
		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 
			strRegEx = "[a-z0-9]+\.[a-z]{2,12}$"
			Set Matches = oLookup(strRegEx, oClient.HELO, False)
			For Each Match In Matches
			   spamDomain = Match.Value
			Next
		End If
		Call CatchSpam(spamDomain)
	End If
The idea behind only using spamassassin score is that I get plenty of false positives from spamcop surbl. Spamassassin makes more sense when it comes to relying on a rejection policy.

palinka
Senior user
Senior user
Posts: 1964
Joined: 2017-09-12 17:57

Re: Ban spammers based on prior spamming

Post by palinka » 2019-12-06 21:23

This has been hard to test because I don't get much spam thanks to all my rejection filters, so I disabled them all. Found a little logic issue, fixed below:

OnAcceptMessage:

Code: Select all

	'	Record entries for CatchSpam
	Dim spamDomain, SAScore, SAHeader
	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 
			strRegEx = "[a-z0-9]+\.[a-z]{2,12}$"
			Set Matches = oLookup(strRegEx, oClient.HELO, False)
			For Each Match In Matches
			   spamDomain = Match.Value
			Next
			EventLog.Write( "Spam Received: SA Score = " & CInt(SAScore) & ", HELO = " & oClient.HELO & " Domain = " & spamDomain )
			If spamDomain <> "" Then Call CatchSpam(spamDomain)
		End If
	End If
Moved "Call CatchSpam(spamDomain)" to within the IF statement for if SAScore > 5. That way it only gets called if SAScore > 5. Duh.... :roll:

Now I just have to wait for bona fide spammers to show up. Could be a few weeks.

Also, I was wrong about spamassassin score being only X-hMailServer-Reason-1 so I changed it to total spam score. But even if I get a FP hit from spamcop, the score (2) is too low to trigger by itself. In most cases, a spamassassin score will be required to push it over the (6) threshold. Most outliers would have already been rejected by my reject filters, so its unlikely anything other than a spamassassin score would get the total score up to 6 or higher. But.... even if you don't have a bunch of reject filters, a combined score of other tests should suffice to prevent hitting false positives.

palinka
Senior user
Senior user
Posts: 1964
Joined: 2017-09-12 17:57

Re: Ban spammers based on prior spamming

Post by palinka » 2019-12-11 15:58

Screenshot_20191211-081529_Brave.jpg
BAM! Gotcha, spammer!

First catch "in the wild". It worked exactly as intended.

This spammer was first seen yesterday and sent exactly 3 spams. I was a little disappointed because rejections don't begin until the 4th instance. Well, that happened this morning. As you can see, since my firewall ban tracks dropped connections, this spammer failed to send at least 12 spams. So far... :mrgreen:

Eventually this spammer will be listed at spamhaus. The whole point of this project is to trap the ones that haven't yet been listed at spamhaus, and it works very well.

palinka
Senior user
Senior user
Posts: 1964
Joined: 2017-09-12 17:57

Re: Ban spammers based on prior spamming

Post by palinka » 2019-12-12 15:45

Screenshot_20191212-084137_Brave.jpg
Continuing to work very well. 2 more IPs caught on the same model, as predicted, and 117 spams NOT received. :mrgreen:

palinka
Senior user
Senior user
Posts: 1964
Joined: 2017-09-12 17:57

Re: Ban spammers based on prior spamming

Post by palinka » 2020-05-13 11:42

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

Post Reply