Parsing Public Suffix List in VBS

Use this forum if you have problems with a hMailServer script, such as hMailServer WebAdmin or code in an event handler.
Post Reply
palinka
Senior user
Senior user
Posts: 2475
Joined: 2017-09-12 17:57

Parsing Public Suffix List in VBS

Post by palinka » 2020-05-09 20:02

I'm trying to parse the public suffix list here: https://publicsuffix.org/list/public_suffix_list.dat

First I created a powershell script to download the list and output it into a regex string like this:

Code: Select all

PubSufRegEx = "^ac$|^com\.ac$|^edu\.ac$|^gov\.ac$|^net\.ac$|^mil\.ac$|^org\.ac$|...REST OF LIST ABRIDGED...|^ad$"
This part works. The string is outputted to public_suffix_list.vbs and then in my VBS test function, I include the file.

The problem I'm having is getting the correct result. I'm split the domain into pieces then test each part against the regex string. This is the part that doesn't work. It seems to match anything. However, if I remove the "function" business and just run the code, then it does work. I'm obviously missing something stupid that I just can't put my finger on.

Here's my vbs test script:

Code: Select all

Option Explicit

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 CheckDomain(strDomain)

	Dim strRegEx, PubSufRegEx, Match, Matches
	Dim TLDTopLevel, TLDSecondLevel, TLDThirdLevel, TLDFourthLevel, TLDFifthLevel, Domain

	Include("C:\scripts\hmailserver\FWBan\PublicSuffix\public_suffix_list.vbs")

	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

	If Lookup(PubSufRegEx, TLDTopLevel) Then 
		Domain = TLDSecondLevel & "." & TLDTopLevel
	End If
	If Lookup(PubSufRegEx, (TLDSecondLevel & "." & TLDTopLevel)) Then 
		Domain = TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel
	End If
	If Lookup(PubSufRegEx, (TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel)) Then 
		Domain = TLDFourthLevel & "." & TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel
	End If
	If Lookup(PubSufRegEx, (TLDFourthLevel & "." & TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel)) Then 
		Domain = TLDFifthLevel & "." & TLDFourthLevel & "." & TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel
	End If

	CheckDomain = Domain
End Function



	Dim strDomain, DomainName
	' strDomain = "pool-72-76-221-125.nwrknj.fios.verizon.net"
	' strDomain = "msnbot-207-46-13-192.search.msn.com"
	' strDomain = "SKNcd-03p13-20.ppp11.odn.ad.jp"
	' strDomain = "v150-95-128-207.a079.g.TyO1.STATIC.cnode.io"
	' strDomain = "230.19.7.186.f.dyn.claro.net.do"
	' strDomain = "hotelbrisamaral.static.gvt.net.br"
	strDomain = "6thLevel.5thLevel.hotelbrisamaral.rs.gov.br"



WScript.Echo CheckDomain(strDomain)


And here is my powershell (working):

Code: Select all

<#

.SYNOPSIS


.DESCRIPTION


.FUNCTIONALITY


.NOTES

	
.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  #>
$LastDownloadTime = (Get-Item $PubSufFile).LastWriteTime
$HoursSinceLastDownload = [int](New-Timespan $LastDownloadTime).TotalHours
If ($HoursSinceLastDownload -gt 23){
	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  #>
 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

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

Re: Parsing Public Suffix List in VBS

Post by palinka » 2020-05-09 20:09

This works - it returns the correct result. But no function. What I want is to turn this working thing into a function. Its the same as above except not in "function form".

Code: Select all

' Function CheckDomain(strDomain)

	Dim strDomain
	' strDomain = "pool-72-76-221-125.nwrknj.fios.verizon.net"
	' strDomain = "msnbot-207-46-13-192.search.msn.com"
	' strDomain = "SKNcd-03p13-20.ppp11.odn.ad.jp"
	' strDomain = "v150-95-128-207.a079.g.TyO1.STATIC.cnode.io"
	' strDomain = "230.19.7.186.f.dyn.claro.net.do"
	' strDomain = "hotelbrisamaral.static.gvt.net.br"
	strDomain = "6thLevel.5thLevel.hotelbrisamaral.rs.gov.br"

	Dim strRegEx, PubSufRegEx, Match, Matches
	Dim TLDTopLevel, TLDSecondLevel, TLDThirdLevel, TLDFourthLevel, TLDFifthLevel, Domain

	Include("C:\scripts\hmailserver\FWBan\PublicSuffix\public_suffix_list.vbs")

	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

	If Lookup(PubSufRegEx, TLDTopLevel) Then 
		Domain = TLDSecondLevel & "." & TLDTopLevel
	End If
	If Lookup(PubSufRegEx, (TLDSecondLevel & "." & TLDTopLevel)) Then 
		Domain = TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel
	End If
	If Lookup(PubSufRegEx, (TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel)) Then 
		Domain = TLDFourthLevel & "." & TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel
	End If
	If Lookup(PubSufRegEx, (TLDFourthLevel & "." & TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel)) Then 
		Domain = TLDFifthLevel & "." & TLDFourthLevel & "." & TLDThirdLevel & "." & TLDSecondLevel & "." & TLDTopLevel
	End If

	WScript.Echo Domain

	' CheckDomain = Domain
' End Function

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

Re: Parsing Public Suffix List in VBS

Post by palinka » 2020-05-13 03:44

Got it working. I knew it was something really stupid. I DIM'd PubSufRegEx, so it was always blank, therefore EVERYTHING MATCHES! YAY!

Anyway, this could be useful for a few things. I have a use for it.

Code: Select all

Option Explicit

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 CheckDomain(strDomain)

	Dim strRegEx, Match, Matches
	Dim SpamDomain
	Dim TLDTopLevel, TLDSecondLevel, TLDThirdLevel, TLDFourthLevel, TLDFifthLevel 

	Include("C:\scripts\hmailserver\FWBan\PublicSuffix\public_suffix_list.vbs")

	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

	CheckDomain = SpamDomain
End Function

' Test a few EHLOs
Dim strDomain
' strDomain = "pool-72-76-221-125.nwrknj.fios.verizon.net"    ' public suffix domain verizon.net
' strDomain = "msnbot-207-46-13-192.search.msn.com"           ' public suffix domain msn.com
' strDomain = "SKNcd-03p13-20.ppp11.odn.ad.jp"                ' public suffix domain odn.ad.jp
' strDomain = "v150-95-128-207.a079.g.TyO1.STATIC.cnode.io"   ' public suffix domain cnode.io
' strDomain = "230.19.7.186.f.dyn.claro.net.do"               ' public suffix domain claro.net.do
' strDomain = "hotelbrisamaral.static.gvt.net.br"             ' public suffix domain gvt.net.br
strDomain = "6thLevel.5thLevel.hotelbrisamaral.rs.gov.br"     ' public suffix domain hotelbrisamaral.rs.gov.br
' strDomain = "expressomx.pr.gov.br"                          ' public suffix domain expressomx.pr.gov.br
' strDomain = "mail.saude.ma.gov.br"                          ' public suffix domain saude.ma.gov.br

Dim RecordSpamDomain : RecordSpamDomain = CheckDomain(strDomain)
If RecordSpamDomain <> "" Then
	WScript.Echo "Record SpamEHLO: " & strDomain & " as Main Domain: " & Chr(34) & RecordSpamDomain & Chr(34)
Else 
	WScript.Echo "Shit's broke, yo!"
End If

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

Re: Parsing Public Suffix List in VBS

Post by palinka » 2020-11-30 06:03

Playing around with this tonight. I changed the vbs to a recursive function so it a) cuts down on the number of lines and b) can test any length of domain.

Code: Select all

Option Explicit

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 GetMainDomain(strDomain)

	Dim strRegEx, Match, Matches
	Dim SpamDomain, TestDomain, DomainParts, a, i, PubSuff
	Include("C:\scripts\hmailserver\FWBan\PublicSuffix\public_suffix_list.vbs")
	
	DomainParts = Split(strDomain,".")
	a = UBound(DomainParts)
	If a > 1 Then
		TestDomain = DomainParts(1)
		For i = 2 to a
			TestDomain = TestDomain & "." & DomainParts(i)
		Next
	ElseIf a = 1 Then
		TestDomain = DomainParts(1)
	Else
		Exit Function
	End If

	Set Matches = oLookup(PubSufRegEx, TestDomain, False)
	For Each Match In Matches
		PubSuff = 1
	Next

	If PubSuff <> 1 Then 
		GetMainDomain = GetMainDomain(TestDomain)
	Else
		GetMainDomain = DomainParts(0) & "." & TestDomain
	End If
	
End Function


Dim strDomain
' strDomain = "pool-72-76-221-125.nwrknj.fios.verizon.net"    ' public suffix domain verizon.net
' strDomain = "msnbot-207-46-13-192.search.msn.com"           ' public suffix domain msn.com
' strDomain = "SKNcd-03p13-20.ppp11.odn.ad.jp"                ' public suffix domain odn.ad.jp
' strDomain = "v150-95-128-207.a079.g.TyO1.STATIC.cnode.io"   ' public suffix domain cnode.io
' strDomain = "230.19.7.186.f.dyn.claro.net.do"               ' public suffix domain claro.net.do
' strDomain = "hotelbrisamaral.static.gvt.net.br"             ' public suffix domain gvt.net.br
' strDomain = "6thLevel.5thLevel.hotelbrisamaral.rs.gov.br"   ' public suffix domain hotelbrisamaral.rs.gov.br
strDomain = "expressomx.pr.gov.br"                          ' public suffix domain expressomx.pr.gov.br
' strDomain = "mail.saude.ma.gov.br"                          ' public suffix domain saude.ma.gov.br
' strDomain = "foofoo.foofoobarbar"                           ' no public suffix exists


' WScript.Echo GetMainDomain(strDomain)

Dim RecordSpamDomain : RecordSpamDomain = GetMainDomain(strDomain)
If RecordSpamDomain <> "" Then
	WScript.Echo "Record SpamEHLO: " & strDomain & " as Main Domain: " & Chr(34) & RecordSpamDomain & Chr(34)
Else 
	WScript.Echo "Shit's broke, yo!"
End If

' WScript.Echo "RecordSpamDomain: " & RecordSpamDomain

gotspatel
Normal user
Normal user
Posts: 86
Joined: 2013-10-08 05:42
Location: INDIA

Re: Parsing Public Suffix List in VBS

Post by gotspatel » 2020-12-30 09:07

palinka wrote:
2020-11-30 06:03
Playing around with this tonight. I changed the vbs to a recursive function so it a) cuts down on the number of lines and b) can test any length of domain.

Code: Select all

Option Explicit

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 GetMainDomain(strDomain)

	Dim strRegEx, Match, Matches
	Dim SpamDomain, TestDomain, DomainParts, a, i, PubSuff
	Include("C:\scripts\hmailserver\FWBan\PublicSuffix\public_suffix_list.vbs")
	
	DomainParts = Split(strDomain,".")
	a = UBound(DomainParts)
	If a > 1 Then
		TestDomain = DomainParts(1)
		For i = 2 to a
			TestDomain = TestDomain & "." & DomainParts(i)
		Next
	ElseIf a = 1 Then
		TestDomain = DomainParts(1)
	Else
		Exit Function
	End If

	Set Matches = oLookup(PubSufRegEx, TestDomain, False)
	For Each Match In Matches
		PubSuff = 1
	Next

	If PubSuff <> 1 Then 
		GetMainDomain = GetMainDomain(TestDomain)
	Else
		GetMainDomain = DomainParts(0) & "." & TestDomain
	End If
	
End Function


Dim strDomain
' strDomain = "pool-72-76-221-125.nwrknj.fios.verizon.net"    ' public suffix domain verizon.net
' strDomain = "msnbot-207-46-13-192.search.msn.com"           ' public suffix domain msn.com
' strDomain = "SKNcd-03p13-20.ppp11.odn.ad.jp"                ' public suffix domain odn.ad.jp
' strDomain = "v150-95-128-207.a079.g.TyO1.STATIC.cnode.io"   ' public suffix domain cnode.io
' strDomain = "230.19.7.186.f.dyn.claro.net.do"               ' public suffix domain claro.net.do
' strDomain = "hotelbrisamaral.static.gvt.net.br"             ' public suffix domain gvt.net.br
' strDomain = "6thLevel.5thLevel.hotelbrisamaral.rs.gov.br"   ' public suffix domain hotelbrisamaral.rs.gov.br
strDomain = "expressomx.pr.gov.br"                          ' public suffix domain expressomx.pr.gov.br
' strDomain = "mail.saude.ma.gov.br"                          ' public suffix domain saude.ma.gov.br
' strDomain = "foofoo.foofoobarbar"                           ' no public suffix exists


' WScript.Echo GetMainDomain(strDomain)

Dim RecordSpamDomain : RecordSpamDomain = GetMainDomain(strDomain)
If RecordSpamDomain <> "" Then
	WScript.Echo "Record SpamEHLO: " & strDomain & " as Main Domain: " & Chr(34) & RecordSpamDomain & Chr(34)
Else 
	WScript.Echo "Shit's broke, yo!"
End If

' WScript.Echo "RecordSpamDomain: " & RecordSpamDomain
Hello Sir,

Trying to implement it,

First got error WScript not defined so DIM WScript, but after that

Getting error

Object required at this line.

Code: Select all

WScript.Echo "Record SpamEHLO: " & strDomain & " as Main Domain: " & Chr(34) & RecordSpamDomain & Chr(34)


Any help please.


By the way this is not included in your hMailServer-Firewall-Ban. Also Implemented it and working fine. Thanks for that wonderful Share. Though not implemented Apache/IIS as no experience in it but atleast got the server secured.

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

Re: Parsing Public Suffix List in VBS

Post by palinka » 2020-12-30 16:14

How are you running it? Are you running it from cscript?

User avatar
SorenR
Senior user
Senior user
Posts: 4194
Joined: 2006-08-21 15:38
Location: Denmark

Re: Parsing Public Suffix List in VBS

Post by SorenR » 2020-12-30 17:10

gotspatel wrote:
2020-12-30 09:07
Object required at this line.

Code: Select all

WScript.Echo "Record SpamEHLO: " & strDomain & " as Main Domain: " & Chr(34) & RecordSpamDomain & Chr(34)


Any help please.


By the way this is not included in your hMailServer-Firewall-Ban. Also Implemented it and working fine. Thanks for that wonderful Share. Though not implemented Apache/IIS as no experience in it but atleast got the server secured.
You can't do that... EventHandlers.vbs is run in an embedded CScript interpreter. You can only use VBScript commands that do not require a command shell.
SørenR.

Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.

gotspatel
Normal user
Normal user
Posts: 86
Joined: 2013-10-08 05:42
Location: INDIA

Re: Parsing Public Suffix List in VBS

Post by gotspatel » 2020-12-30 17:18

palinka wrote:
2020-12-30 16:14
How are you running it? Are you running it from cscript?
Yes I tried running it with Eventhandlers.vbs

gotspatel
Normal user
Normal user
Posts: 86
Joined: 2013-10-08 05:42
Location: INDIA

Re: Parsing Public Suffix List in VBS

Post by gotspatel » 2020-12-30 17:19

SorenR wrote:
2020-12-30 17:10

You can't do that... EventHandlers.vbs is run in an embedded CScript interpreter. You can only use VBScript commands that do not require a command shell.
Thank you for the pointer. I learnt it now.

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

Re: Parsing Public Suffix List in VBS

Post by palinka » 2020-12-30 20:37

gotspatel wrote:
2020-12-30 17:18
palinka wrote:
2020-12-30 16:14
How are you running it? Are you running it from cscript?
Yes I tried running it with Eventhandlers.vbs
The one posted is just the test script. When i get back to my computer, I'll copy what i use in my eventhandlers.vbs.

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

Re: Parsing Public Suffix List in VBS

Post by palinka » 2020-12-30 22:10

Here's what I have in my eventhandlers.vbs.

Function here:

Code: Select all

Function GetMainDomain(strDomain)
	Dim strRegEx, Match, Matches
	Dim TestDomain, DomainParts, a, i, PubSuffMatch
	Include("C:\scripts\hmailserver\FWBan\PublicSuffix\public_suffix_list.vbs")
	
	DomainParts = Split(strDomain,".")
	a = UBound(DomainParts)
	If a > 1 Then
		TestDomain = DomainParts(1)
		For i = 2 to a
			TestDomain = TestDomain & "." & DomainParts(i)
		Next
	ElseIf a = 1 Then
		TestDomain = DomainParts(1)
	Else
		Exit Function
	End If

	Set Matches = oLookup(PubSufRegEx, TestDomain, False)
	For Each Match In Matches
		PubSuffMatch = True
	Next

	If PubSuffMatch Then 
		GetMainDomain = DomainParts(0) & "." & TestDomain
	Else
		GetMainDomain = GetMainDomain(TestDomain)
	End If
End Function

Then you can use it for whatever you want. I use it in my "catchspam" routine.

In Sub OnHelo:

Code: Select all

	REM	- Reject on CatchSpam
	Dim spamDomain : spamDomain = GetMainDomain(oClient.HELO)  ' Also can use PTR, which is probably a better method.
	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."
		'
		' Do whatever else you want to do to SMASH SPAMMERS
		'
	End If	
"GetMainDomain" is just a means of obtaining the highest level FQDN (without subdomains)

gotspatel
Normal user
Normal user
Posts: 86
Joined: 2013-10-08 05:42
Location: INDIA

Re: Parsing Public Suffix List in VBS

Post by gotspatel » 2020-12-31 07:13

palinka wrote:
2020-12-30 22:10
Here's what I have in my eventhandlers.vbs.

Function here:



"GetMainDomain" is just a means of obtaining the highest level FQDN (without subdomains)
Many Thanks and Happy new year there

Post Reply