INDEX
#1 How to become really annoying to spammers without using GreyListing. --> viewtopic.php?p=209542#p209542
#2 How to only allow client access from specific GEO locations. --> viewtopic.php?p=209543#p209543
#3 How to stop the annoying half-connections from BOT's and misconfigured spammers. --> viewtopic.php?p=209545#p209545
#4 How does a fully functioning system look like? PART 1! --> viewtopic.php?p=209546#p209546
#5 How does a fully functioning system look like? PART 2! --> viewtopic.php?p=209546#p209547
NOTE:
Some of the solutions refer to external functions that require implementing:
Sub OnHELO(oClient) is NOT available in the original compilation.
If you wish to make use of this added trigger please see viewtopic.php?p=206039#p206039
ActiveX object DNSLibrary can be obtained from https://d-fault.nl/files/DNSResolverCom ... .3.exe.zip
Hardening hMailServer - The ongoing saga!
Hardening hMailServer - The ongoing saga!
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
#1 How to become really annoying to spammers without using GreyListing.
Face it, GreyListing is brilliant - but it sucks when you are in a hurry to receive mail.
Adding delays to deter the "always busy" SPAM sender is known as SMTP Transaction Delays and it simply means waiting a number of seconds before answering the sender. In the SPAM world, time is money and spammers do NOT like to wait, so they cut their losses short and move on to the next victim. This is actually a primitive form of teergrubing. http://altlasten.lutz.donnerhacke.de/mi ... be.en.html
In this example we expect all communication with *WORLD* is done on SMTP port 25.
NOTE:
Sub OnHELO(oClient) is NOT available in the original compilation.
If you wish to make use of this added trigger please see viewtopic.php?p=206039#p206039
Face it, GreyListing is brilliant - but it sucks when you are in a hurry to receive mail.
Adding delays to deter the "always busy" SPAM sender is known as SMTP Transaction Delays and it simply means waiting a number of seconds before answering the sender. In the SPAM world, time is money and spammers do NOT like to wait, so they cut their losses short and move on to the next victim. This is actually a primitive form of teergrubing. http://altlasten.lutz.donnerhacke.de/mi ... be.en.html
In this example we expect all communication with *WORLD* is done on SMTP port 25.
Code: Select all
Option Explicit
'******************************************************************************************************************************
'********** Settings **********
'******************************************************************************************************************************
'
' COM authentication
'
Private Const ADMIN = "Administrator"
Private Const PASSWORD = "########"
'******************************************************************************************************************************
'********** Functions **********
'******************************************************************************************************************************
Function Wait(sec)
With CreateObject("WScript.Shell")
.Run "timeout /T " & Int(sec), 0, True ' Use with Windows 7/2003/2008 or later
' .Run "sleep -m " & Int(sec * 1000), 0, True ' Use with Windows 2003 Resource Kit
' .Run "powershell Start-Sleep -Milliseconds " & Int(sec * 1000), 0, True
End With
End Function
'******************************************************************************************************************************
'********** hMailServer Triggers **********
'******************************************************************************************************************************
Sub OnClientConnect(oClient)
'
' Filter out "impatient" servers. Alternative to GreyListing.
'
If (oClient.Port = 25) Then Wait(20)
End Sub
Sub OnHELO(oClient)
'
' Filter out "impatient" servers. Alternative to GreyListing.
'
If (oClient.Port = 25) Then Wait(20)
End Sub
'*
'* ********** SPAM test: DNSBlackLists, HeloHost, MXRecords, SPF
'*
Sub OnSMTPData(oClient, oMessage)
'
' Filter out "impatient" servers. Alternative to GreyListing.
'
If (oClient.Port = 25) Then Wait(20)
End Sub
'*
'* ********** SPAM test: SURBL, DKIM, SpamAssassin
'*
'* Sub OnAcceptMessage(oClient, oMessage)
'* End Sub
'*
'* ********** Saving EML to DATA
'*
'* Sub OnDeliveryStart(oMessage)
'* End Sub
'*
'* ********** Antivirus check, Global rules
'*
'* Sub OnDeliverMessage(oMessage)
'* End Sub
'*
'* ********** Local rules, Message delivered to recipient(s)
'*
'* Sub OnDeliveryFailed(oMessage, sRecipient, sErrorMessage)
'* End Sub
'* Sub OnExternalAccountDownload(oFetchAccount, oMessage, sRemoteUID)
'* End Sub
'* Sub OnBackupFailed(sReason)
'* End Sub
'* Sub OnBackupCompleted()
'* End Sub
'* Sub OnError(iSeverity, iCode, sSource, sDescription)
'* End Sub
'******************************************************************************************************************************
'********** END **********
'******************************************************************************************************************************
Sub OnHELO(oClient) is NOT available in the original compilation.
If you wish to make use of this added trigger please see viewtopic.php?p=206039#p206039
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
#2 How to only allow client access from specific GEO locations.
The majority of us run small installations serving only a handfull domains and/or friends and family. Installing expensive firewalls with IDS capabilities to monitor unauthorised login attempts and/or suddenly finding yourself being brute force attacked can be scary.
One solution is to ONLY allow clients accessing from a well-defined realm.
In this example access is only granted to 3 countries (not that there are no villains im my country
) namely Denmark (dk), Greenland (gl) and Faroe Islands (fo).
The country codes used are ISO standard.
I acknowledge that there may be some challenges when clients need to access mail from OUTSIDE the realm. I have for this purpose installed WEBMAIL to enable clients access to their email worldwide.
Another solution is to use VPN to gain access to mail.
NOTE:
Sub OnHELO(oClient) is NOT available in the original compilation.
If you wish to make use of this added trigger please see viewtopic.php?p=206039#p206039
ActiveX object DNSLibrary can be obtained from https://d-fault.nl/files/DNSResolverCom ... .3.exe.zip
The majority of us run small installations serving only a handfull domains and/or friends and family. Installing expensive firewalls with IDS capabilities to monitor unauthorised login attempts and/or suddenly finding yourself being brute force attacked can be scary.
One solution is to ONLY allow clients accessing from a well-defined realm.
In this example access is only granted to 3 countries (not that there are no villains im my country
) namely Denmark (dk), Greenland (gl) and Faroe Islands (fo).The country codes used are ISO standard.
I acknowledge that there may be some challenges when clients need to access mail from OUTSIDE the realm. I have for this purpose installed WEBMAIL to enable clients access to their email worldwide.
Another solution is to use VPN to gain access to mail.
Code: Select all
Option Explicit
'******************************************************************************************************************************
'********** Settings **********
'******************************************************************************************************************************
'
' COM authentication
'
Private Const ADMIN = "Administrator"
Private Const PASSWORD = "########"
'******************************************************************************************************************************
'********** Functions **********
'******************************************************************************************************************************
Function GeoLookup(strIP) : GeoLookup = "zz"
Dim a, element, group, strLookup
a = Split(strIP, ".")
With CreateObject("DNSLibrary.DNSResolver")
strLookup = .TXT(a(3) & "." & a(2) & "." & a(1) & "." & a(0) & ".zz.countries.nerd.dk")
End With
If Trim(strLookup) = "" Then
EventLog.Write( "- GeoLookup(" & strIP & ") = " & GeoLookup )
Exit Function
End If
group = Split(strLookup, vbCrLf)
If UBound(group) > 0 Then
For Each element In group
If (Trim(element) <> "") Then EventLog.Write( "- GeoLookup(" & strIP & ") = " & element )
Next
Else
GeoLookup = group(0)
End If
End Function
'******************************************************************************************************************************
'********** hMailServer Triggers **********
'******************************************************************************************************************************
Sub OnClientConnect(oClient)
'
' Exclude local LAN from test
'
If (Left(oClient.IPAddress, 10) = "192.168.0.") Then Exit Sub
'
' Only allow non-SMTP connect from "Rigsfællesskabet"/"Naalagaaffeqatigiit"/"Ríkisfelagsskapurin" = The Danish Realm.
' zz = N/A, dk = Denmark, gl = Greenland, fo = Faroe Islands
'
If (oClient.Port <> 25) Then
If (InStr("|dk|gl|fo|", GeoLookup(oClient.IPAddress)) = 0) Then
Result.Value = 1
Exit Sub
End If
End If
End Sub
'* Sub OnHELO(oClient)
'* End Sub
'*
'* ********** SPAM test: DNSBlackLists, HeloHost, MXRecords, SPF
'*
'* Sub OnSMTPData(oClient, oMessage)
'* End Sub
'*
'* ********** SPAM test: SURBL, DKIM, SpamAssassin
'*
'* Sub OnAcceptMessage(oClient, oMessage)
'* End Sub
'*
'* ********** Saving EML to DATA
'*
'* Sub OnDeliveryStart(oMessage)
'* End Sub
'*
'* ********** Antivirus check, Global rules
'*
'* Sub OnDeliverMessage(oMessage)
'* End Sub
'*
'* ********** Local rules, Message delivered to recipient(s)
'*
'* Sub OnDeliveryFailed(oMessage, sRecipient, sErrorMessage)
'* End Sub
'* Sub OnExternalAccountDownload(oFetchAccount, oMessage, sRemoteUID)
'* End Sub
'* Sub OnBackupFailed(sReason)
'* End Sub
'* Sub OnBackupCompleted()
'* End Sub
'* Sub OnError(iSeverity, iCode, sSource, sDescription)
'* End Sub
'******************************************************************************************************************************
'********** END **********
'******************************************************************************************************************************
Sub OnHELO(oClient) is NOT available in the original compilation.
If you wish to make use of this added trigger please see viewtopic.php?p=206039#p206039
ActiveX object DNSLibrary can be obtained from https://d-fault.nl/files/DNSResolverCom ... .3.exe.zip
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
#3 How to stop the annoying half-connections from BOT's and misconfigured spammers
This is an attempt to create some form of IDS (Intrusion Detection System) into hMailServer. It works by using the system database of hMailServer - in this case MySQL.
Functionality:
Case A.
1 - When server connect on port 25, the IP address is added to the IDS registry.
2 - When this connection produces an email, the IP address is removed from IDS registry.
3 - A handler will load data from the database and determine if a BAN on the IP address is needed.
Case B.
1 - A connection from outside the defined Realm is detected, the IP address is added to the IDS registry
2 - A handler will load data from the database and BAN the IP address.
The code is split into two in order to put as little stress on hMailServer mail functionality as possible.
The file Handler.vbs is executed by Windows Scheduler every 1 minute and will do the banning and housekeeping of the IDS registry.
Banning criteria:
1: Violation of Realm = immediate BAN
2: 3 "half-connections" within 180 minutes.
File: EventHandlers.vbs
File: Handler.vbs
NOTE:
Sub OnHELO(oClient) is NOT available in the original compilation.
If you wish to make use of this added trigger please see viewtopic.php?p=206039#p206039
ActiveX object DNSLibrary can be obtained from https://d-fault.nl/files/DNSResolverCom ... .3.exe.zip
This is an attempt to create some form of IDS (Intrusion Detection System) into hMailServer. It works by using the system database of hMailServer - in this case MySQL.
Functionality:
Case A.
1 - When server connect on port 25, the IP address is added to the IDS registry.
2 - When this connection produces an email, the IP address is removed from IDS registry.
3 - A handler will load data from the database and determine if a BAN on the IP address is needed.
Case B.
1 - A connection from outside the defined Realm is detected, the IP address is added to the IDS registry
2 - A handler will load data from the database and BAN the IP address.
The code is split into two in order to put as little stress on hMailServer mail functionality as possible.
The file Handler.vbs is executed by Windows Scheduler every 1 minute and will do the banning and housekeeping of the IDS registry.
Banning criteria:
1: Violation of Realm = immediate BAN
2: 3 "half-connections" within 180 minutes.
File: EventHandlers.vbs
Code: Select all
Option Explicit
'******************************************************************************************************************************
'********** Settings **********
'******************************************************************************************************************************
'
' COM authentication
'
Private Const ADMIN = "Administrator"
Private Const PASSWORD = "########"
'******************************************************************************************************************************
'********** hMailServer IDS Client Code (MySQL) **********
'******************************************************************************************************************************
Private Const idsTable = "hm_ids"
'
' DRIVER={MySQL ODBC 5.3 Unicode Driver};Server=localhost;Port=3306;Database=%idsdb%;Uid=%idsuid%;Pwd=%idspwd%;Option=3;
'
' Table: CREATE TABLE %idsTable% (
' timestamp DATETIME,
' ipaddress VARCHAR (192) PRIMARY KEY,
' port INTEGER,
' hits INTEGER);
'
Function idsAddIP(sIPAddress, iPort)
Dim strSQL, oDB : Set oDB = GetDatabaseObject
strSQL = "INSERT INTO " & idsTable & " (timestamp,ipaddress,port,hits) VALUES (NOW(),'" & sIPAddress & "'," & iPort & ",1) ON DUPLICATE KEY UPDATE hits=(hits+1),timestamp=NOW();"
Call oDB.ExecuteSQL(strSQL)
End Function
Function idsDelIP(sIPAddress)
Dim strSQL, oDB : Set oDB = GetDatabaseObject
strSQL = "DELETE FROM " & idsTable & " WHERE ipaddress = '" & sIPAddress & "';"
Call oDB.ExecuteSQL(strSQL)
End Function
'******************************************************************************************************************************
'********** Functions **********
'******************************************************************************************************************************
Function GetDatabaseObject()
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
Set GetDatabaseObject = oApp.Database
End Function
Function GeoLookup(strIP) : GeoLookup = "zz"
Dim a, element, group, strLookup
a = Split(strIP, ".")
With CreateObject("DNSLibrary.DNSResolver")
strLookup = .TXT(a(3) & "." & a(2) & "." & a(1) & "." & a(0) & ".zz.countries.nerd.dk")
End With
If Trim(strLookup) = "" Then
EventLog.Write( "- GeoLookup(" & strIP & ") = " & GeoLookup )
Exit Function
End If
group = Split(strLookup, vbCrLf)
If UBound(group) > 0 Then
For Each element In group
If (Trim(element) <> "") Then EventLog.Write( "- GeoLookup(" & strIP & ") = " & element )
Next
Else
GeoLookup = group(0)
End If
End Function
'******************************************************************************************************************************
'********** hMailServer Triggers **********
'******************************************************************************************************************************
Sub OnClientConnect(oClient)
'
' Exclude local LAN from test
'
If (Left(oClient.IPAddress, 10) = "192.168.0.") Then Exit Sub
'
' Only allow non-SMTP connect from "Rigsfællesskabet"/"Naalagaaffeqatigiit"/"Ríkisfelagsskapurin" = The Danish Realm.
' zz = N/A, dk = Denmark, gl = Greenland, fo = Faroe Islands
'
If (oClient.Port <> 25) Then
If (InStr("|dk|gl|fo|", GeoLookup(oClient.IPAddress)) = 0) Then
'
' Add unauthorized access to IDS registry
'
Call idsAddIP(oClient.IPAddress, oClient.Port)
Result.Value = 1
Exit Sub
End If
End If
'
' Only test SMTP traffic on defined ports 25, 587 and 465.
' Register IP address in IDS registry.
'
If (InStr("|25|587|465|", oClient.Port) > 0) Then Call idsAddIP(oClient.IPAddress, 0)
End Sub
'* Sub OnHELO(oClient)
'* End Sub
'*
'* ********** SPAM test: DNSBlackLists, HeloHost, MXRecords, SPF
'*
'* Sub OnSMTPData(oClient, oMessage)
'* End Sub
'*
'* ********** SPAM test: SURBL, DKIM, SpamAssassin
'*
Sub OnAcceptMessage(oClient, oMessage)
'
' Unregister IP address from IDS registry
'
Call idsDelIP(oClient.IPAddress)
End Sub
'*
'* ********** Saving EML to DATA
'*
'* Sub OnDeliveryStart(oMessage)
'* End Sub
'*
'* ********** Antivirus check, Global rules
'*
'* Sub OnDeliverMessage(oMessage)
'* End Sub
'*
'* ********** Local rules, Message delivered to recipient(s)
'*
'* Sub OnDeliveryFailed(oMessage, sRecipient, sErrorMessage)
'* End Sub
'* Sub OnExternalAccountDownload(oFetchAccount, oMessage, sRemoteUID)
'* End Sub
'* Sub OnBackupFailed(sReason)
'* End Sub
'* Sub OnBackupCompleted()
'* End Sub
'* Sub OnError(iSeverity, iCode, sSource, sDescription)
'* End Sub
'******************************************************************************************************************************
'********** END **********
'******************************************************************************************************************************
Code: Select all
Option Explicit
'******************************************************************************************************************************
'********** Settings **********
'******************************************************************************************************************************
'
' COM authentication
'
Private Const ADMIN = "Administrator"
Private Const PASSWORD = "########"
'
' MySQL
'
Private Const DBNAME = "hmailserver"
Private Const DBUID = "hmsuser"
Private Const DBPW = "########"
Private Const idsTable = "hm_ids"
Private Const idsHits = 3
Private Const idsMinutes = 180
Dim idsDBDrv : idsDBDrv = "DRIVER={MySQL ODBC 5.3 Unicode Driver};Database="&DBNAME&";Uid="&DBUID&";Pwd="&DBPW&";Option=3;"
'
' DRIVER={MySQL ODBC 5.3 Unicode Driver};Server=localhost;Port=3306;Database=%idsdb%;Uid=%idsuid%;Pwd=%idspwd%;Option=3;
'
' Table: CREATE TABLE %idsTable% (
' timestamp DATETIME,
' ipaddress VARCHAR (192) PRIMARY KEY,
' port INTEGER,
' hits INTEGER);
'
'******************************************************************************************************************************
'********** Classes **********
'******************************************************************************************************************************
Class LogWriter
Private m_oApp, m_LogID, m_LogFile, m_LogType, m_LogDir
Private i, t, temp, strDay, strMonth, strTime, strLogFile, strLogDate
Private Sub Class_Initialize()
Set m_oApp = CreateObject("hMailServer.Application")
Call m_oApp.Authenticate(ADMIN, PASSWORD)
m_LogFile = "LogWriter"
m_LogType = "M"
m_LogDir = m_oApp.Settings.Directories.LogDirectory
m_LogID = CStr(m_oApp.Status.ProcessedMessages)
End Sub
Private Sub Class_Terminate()
'
' Termination code goes here.
'
End Sub
Public Property Let LogFile(strFile)
m_LogFile = Trim(strFile)
End Property
Public Property Let LogDir(strDir)
If (Right(strDir, 1) = "\") Then
m_LogDir = Trim(Left(strDir, Len(strDir) - 1))
Else
m_LogDir = Trim(strDir)
End If
End Property
Public Property Let LogType(strType)
m_LogType = Trim(strType)
End Property
Public Function Wait(sec)
With CreateObject("WScript.Shell")
.Run "timeout /T " & Int(sec), 0, True ' Windows 7/2003/2008 or later
' .Run "sleep -m " & Int(sec * 1000), 0, True ' Windows 2003 Resource Kit
' .Run "powershell Start-Sleep -Milliseconds " & Int(sec * 1000), 0, True
End With
End Function
Public Function OpenFile(strPath)
Const Append = 8
Const Unicode = -1
With CreateObject("Scripting.FileSystemObject")
Dim oFile
For i = 0 To 30
On Error Resume Next
Set oFile = .OpenTextFile(strPath, Append, True, Unicode)
If Not (Err.Number = 70) Then
Set OpenFile = oFile
On Error Goto 0
Exit For
End If
On Error Goto 0
Wait(1)
Next
End With
If (Err.Number = 70) Then
EventLog.Write( "ERROR: VBScript Class LogWriter" )
EventLog.Write( "File " & strPath & " is locked and timeout was exceeded." )
Err.Clear
ElseIf (Err.Number <> 0) Then
EventLog.Write( "ERROR: VBScript Class LogWriter : Function OpenFile" )
EventLog.Write( "Error : " & Err.Number )
EventLog.Write( "Error (hex) : 0x" & Hex(Err.Number) )
EventLog.Write( "Source : " & Err.Source )
EventLog.Write( "Description : " & Err.Description )
Err.Clear
End If
End Function
Public Function Write(strText)
t = Timer
temp = Int(t)
strMonth = DatePart("yyyy",Date) & "-" & Right("0" & DatePart("m",Date), 2)
strDay = strMonth & "-" & Right("0" & DatePart("d",Date), 2)
strTime = Right("0" & Hour(Now), 2) & ":" &_
Right("0" & Minute(Now), 2) & ":" &_
Right("0" & Second(Now), 2) & "." &_
Right("00" & (Int((t-temp) * 1000)), 3)
strLogDate = strDay & " " & strTime
If (m_LogType = "M") Then
strLogFile = m_LogDir & "\" & m_LogFile & "_" & strMonth & ".log"
Else
strLogFile = m_LogDir & "\" & m_LogFile & "_" & strDay & ".log"
End If
With OpenFile(strLogFile)
.WriteLine(m_LogID & vbTab & Chr(34) & strLogDate & Chr(34) & vbTab & Chr(34) & strText & Chr(34))
.Close
End With
Write = Err.Number
End Function
End Class
'******************************************************************************************************************************
'********** Functions **********
'******************************************************************************************************************************
Function AutoBan(sIPAddress, sReason, iDuration, sType) : AutoBan = False
'
' sType can be one of the following;
' "yyyy" Year, "m" Month, "d" Day, "h" Hour, "n" Minute, "s" Second
'
On Error Resume Next
If (oApp.Settings.SecurityRanges.ItemByName("(" & sReason & ") " & sIPAddress) Is Nothing) Then
With oApp.Settings.SecurityRanges.Add
.Name = "(" & sReason & ") " & sIPAddress
.LowerIP = sIPAddress
.UpperIP = sIPAddress
.Priority = 20
.Expires = True
.ExpiresTime = DateAdd(sType, iDuration, Now())
.Save
End With
AutoBan = True
End If
oApp.Settings.SecurityRanges.Refresh
On Error Goto 0
End Function
'******************************************************************************************************************************
'********** CODE **********
'******************************************************************************************************************************
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
Dim EventLog : Set EventLog = CreateObject("hMailServer.EventLog")
Dim EventLogX : Set EventLogX = New LogWriter
'
' Name of the logfile.
' Default is monthly logs, for daily logs add: EventLogX.LogType = "D"
'
EventLogX.LogFile = "handler"
Dim strPort
Dim oRecord, oConn : Set oConn = CreateObject("ADODB.Connection")
oConn.Open idsDBDrv
If oConn.State <> 1 Then
EventLog.Write( "Handler - ERROR: Could not connect to database" )
WScript.Quit 1
End If
Set oRecord = oConn.Execute("SELECT * FROM " & idsTable & " WHERE hits > " & idsHits & " AND port = 0;")
If Err.Number <> 0 Then
EventLog.Write( "Handler - ERROR: Table " & idsTable & " does not exist!" )
WScript.Quit 1
End If
If Not oRecord.BOF And Not oRecord.EOF Then
While Not oRecord.EOF
EventLogX.Write( "Wohoo... IPAddress: " & oRecord("ipaddress") & " Port: " & oRecord("port") & " Hits: " & oRecord("hits") )
If (DateDiff("n", oRecord("timestamp"), Now()) < idsMinutes) Then
If AutoBan(oRecord("ipaddress"), "IDS", 7, "d") Then _
EventLogX.Write( "AutoBan(" & oRecord("ipaddress") & ", IDS, 7, d)" )
End If
oConn.Execute "DELETE FROM " & idsTable & " WHERE ipaddress = '" & oRecord("ipaddress") & "';"
oRecord.MoveNext
Wend
End If
Set oRecord = oConn.Execute("SELECT * FROM " & idsTable & " WHERE hits > " & idsHits & " AND port > 0;")
If Not oRecord.BOF And Not oRecord.EOF Then
While Not oRecord.EOF
EventLogX.Write( "Wohoo... IPAddress: " & oRecord("ipaddress") & " Port: " & oRecord("port") & " Hits: " & oRecord("hits") )
If (DateDiff("n", oRecord("timestamp"), Now()) < idsMinutes) Then
strPort = Trim(Mid("SMTP IMAP SMTPSSUBM IMAPS", InStr("25 143 465 587 993 ", oRecord("port")), 5))
If AutoBan(oRecord("ipaddress"), "GEOBLOCK - " & strPort, 7, "d") Then _
EventLogX.Write( "AutoBan(" & oRecord("ipaddress") & ", GEOBLOCK - " & strPort & ", 7, d)" )
End If
oConn.Execute "DELETE FROM " & idsTable & " WHERE ipaddress = '" & oRecord("ipaddress") & "';"
oRecord.MoveNext
Wend
End If
oConn.Execute "DELETE FROM " & idsTable & " WHERE DATE_ADD(timestamp, INTERVAL 1 DAY) < NOW();"
oConn.Close
'******************************************************************************************************************************
'********** END **********
'******************************************************************************************************************************
Sub OnHELO(oClient) is NOT available in the original compilation.
If you wish to make use of this added trigger please see viewtopic.php?p=206039#p206039
ActiveX object DNSLibrary can be obtained from https://d-fault.nl/files/DNSResolverCom ... .3.exe.zip
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
#4 How does a fully functioning system look like? PART 1!
Well... Since this is all Open Source I thought I might as well disclose it all
All files have been annonymized and scrubbed so I cannot guarantee that it all works (disclaimer: use at your own risc!).
- EventHandlers.vbs goes into .\hMailServer\Events
- Handler.vbs is called by Windows Scheduler every 1 minute
- Check-State.vbs is called by Windows Scheduler every 30 minutes
- RunBackup.vbs is called by Windows Scheduler every sunday at 5 AM
- hMailServer.xml goes into .\hMailServer\Events and contains a dynamic list of RegEx expressions used to 1: reject mail, 2: blacklist mail and 3: whitelist mail.
The XML handling was added only a few days ago and may/may not need adjusting at some point in the future.
File: EvenHandlers.vbs
NOTE:
Sub OnHELO(oClient) is NOT available in the original compilation.
If you wish to make use of this added trigger please see viewtopic.php?p=206039#p206039
Well... Since this is all Open Source I thought I might as well disclose it all
All files have been annonymized and scrubbed so I cannot guarantee that it all works (disclaimer: use at your own risc!).
- EventHandlers.vbs goes into .\hMailServer\Events
- Handler.vbs is called by Windows Scheduler every 1 minute
- Check-State.vbs is called by Windows Scheduler every 30 minutes
- RunBackup.vbs is called by Windows Scheduler every sunday at 5 AM
- hMailServer.xml goes into .\hMailServer\Events and contains a dynamic list of RegEx expressions used to 1: reject mail, 2: blacklist mail and 3: whitelist mail.
The XML handling was added only a few days ago and may/may not need adjusting at some point in the future.
File: EvenHandlers.vbs
Code: Select all
Option Explicit
'******************************************************************************************************************************
'********** Settings **********
'******************************************************************************************************************************
'
' COM authentication
'
Private Const ADMIN = "Administrator"
Private Const PASSWORD = "########"
Private Const XMLDATA = "hMailServer.xml"
'******************************************************************************************************************************
'********** Includes **********
'******************************************************************************************************************************
'* Include("C:\hMailServer\Events\VbsJson.vbs")
'* 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
'* Set f = Nothing
'* Set oFSO = Nothing
'* End Function
'******************************************************************************************************************************
'********** Classes **********
'******************************************************************************************************************************
Class LogWriter
Private m_oApp, m_LogID, m_LogFile, m_LogType, m_LogDir
Private i, t, temp, strDay, strMonth, strTime, strLogFile, strLogDate
Private Sub Class_Initialize()
Set m_oApp = CreateObject("hMailServer.Application")
Call m_oApp.Authenticate(ADMIN, PASSWORD)
m_LogFile = "LogWriter"
m_LogType = "M"
m_LogDir = m_oApp.Settings.Directories.LogDirectory
m_LogID = CStr(m_oApp.Status.ProcessedMessages)
End Sub
Private Sub Class_Terminate()
'
' Termination code goes here.
'
End Sub
Public Property Let LogFile(strFile)
m_LogFile = Trim(strFile)
End Property
Public Property Let LogDir(strDir)
If (Right(strDir, 1) = "\") Then
m_LogDir = Trim(Left(strDir, Len(strDir) - 1))
Else
m_LogDir = Trim(strDir)
End If
End Property
Public Property Let LogType(strType)
m_LogType = Trim(strType)
End Property
Public Function Wait(sec)
With CreateObject("WScript.Shell")
.Run "timeout /T " & Int(sec), 0, True ' Windows 7/2003/2008 or later
' .Run "sleep -m " & Int(sec * 1000), 0, True ' Windows 2003 Resource Kit
' .Run "powershell Start-Sleep -Milliseconds " & Int(sec * 1000), 0, True
End With
End Function
Public Function OpenFile(strPath)
Const Append = 8
Const Unicode = -1
With CreateObject("Scripting.FileSystemObject")
Dim oFile
For i = 0 To 30
On Error Resume Next
Set oFile = .OpenTextFile(strPath, Append, True, Unicode)
If Not (Err.Number = 70) Then
Set OpenFile = oFile
On Error Goto 0
Exit For
End If
On Error Goto 0
Wait(1)
Next
End With
If (Err.Number = 70) Then
EventLog.Write( "ERROR: VBScript Class LogWriter" )
EventLog.Write( "File " & strPath & " is locked and timeout was exceeded." )
Err.Clear
ElseIf (Err.Number <> 0) Then
EventLog.Write( "ERROR: VBScript Class LogWriter : Function OpenFile" )
EventLog.Write( "Error : " & Err.Number )
EventLog.Write( "Error (hex) : 0x" & Hex(Err.Number) )
EventLog.Write( "Source : " & Err.Source )
EventLog.Write( "Description : " & Err.Description )
Err.Clear
End If
End Function
Public Function Write(strText)
t = Timer
temp = Int(t)
strMonth = DatePart("yyyy",Date) & "-" & Right("0" & DatePart("m",Date), 2)
strDay = strMonth & "-" & Right("0" & DatePart("d",Date), 2)
strTime = Right("0" & Hour(Now), 2) & ":" &_
Right("0" & Minute(Now), 2) & ":" &_
Right("0" & Second(Now), 2) & "." &_
Right("00" & (Int((t-temp) * 1000)), 3)
strLogDate = strDay & " " & strTime
If (m_LogType = "M") Then
strLogFile = m_LogDir & "\" & m_LogFile & "_" & strMonth & ".log"
Else
strLogFile = m_LogDir & "\" & m_LogFile & "_" & strDay & ".log"
End If
With OpenFile(strLogFile)
.WriteLine(m_LogID & vbTab & Chr(34) & strLogDate & Chr(34) & vbTab & Chr(34) & strText & Chr(34))
.Close
End With
Write = Err.Number
End Function
End Class
'******************************************************************************************************************************
'********** hMailServer IDS Client Code (MySQL) **********
'******************************************************************************************************************************
Private Const idsTable = "hm_ids"
'
' DRIVER={MySQL ODBC 5.3 Unicode Driver};Server=localhost;Port=3306;Database=%idsdb%;Uid=%idsuid%;Pwd=%idspwd%;Option=3;
'
' Table: CREATE TABLE %idsTable% (
' timestamp DATETIME,
' ipaddress VARCHAR (192) PRIMARY KEY,
' port INTEGER,
' hits INTEGER);
'
Function idsAddIP(sIPAddress, iPort)
Dim strSQL, oDB : Set oDB = GetDatabaseObject
strSQL = "INSERT INTO " & idsTable & " (timestamp,ipaddress,port,hits) VALUES (NOW(),'" & sIPAddress & "'," & iPort & ",1) ON DUPLICATE KEY UPDATE hits=(hits+1),timestamp=NOW();"
Call oDB.ExecuteSQL(strSQL)
End Function
Function idsDelIP(sIPAddress)
Dim strSQL, oDB : Set oDB = GetDatabaseObject
strSQL = "DELETE FROM " & idsTable & " WHERE ipaddress = '" & sIPAddress & "';"
Call oDB.ExecuteSQL(strSQL)
End Function
'******************************************************************************************************************************
'********** Functions **********
'******************************************************************************************************************************
Function Wait(sec)
With CreateObject("WScript.Shell")
.Run "timeout /T " & Int(sec), 0, True ' Windows 7/2003/2008 or later
' .Run "sleep -m " & Int(sec * 1000), 0, True ' Windows 2003 Resource Kit
' .Run "powershell Start-Sleep -Milliseconds " & Int(sec * 1000), 0, True
End With
End Function
Function LockFile(strPath)
Const Append = 8
Const Unicode = -1
With CreateObject("Scripting.FileSystemObject")
Dim oFile, i
For i = 0 To 30
On Error Resume Next
Set oFile = .OpenTextFile(strPath, Append, True, Unicode)
If Not (Err.Number = 70) Then
Set LockFile = oFile
On Error Goto 0
Exit For
End If
On Error Goto 0
Wait(1)
Next
End With
If (Err.Number = 70) Then
EventLog.Write( "ERROR: EventHandlers.vbs" )
EventLog.Write( "File " & strPath & " is locked and timeout was exceeded." )
Err.Clear
ElseIf (Err.Number <> 0) Then
EventLog.Write( "ERROR: EventHandlers.vbs : Function LockFile" )
EventLog.Write( "Error : " & Err.Number )
EventLog.Write( "Error (hex) : 0x" & Hex(Err.Number) )
EventLog.Write( "Source : " & Err.Source )
EventLog.Write( "Description : " & Err.Description )
Err.Clear
End If
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)
With CreateObject("VBScript.RegExp")
.Pattern = strRegEx
.Global = bGlobal
.MultiLine = True
.IgnoreCase = True
Set oLookup = .Execute(strMatch)
End With
End Function
Function IsSnowShoe(strIP) : IsSnowShoe = False
Dim a, strLookup
a = Split(strIP, ".")
With CreateObject("DNSLibrary.DNSResolver")
strLookup = .DNSLookup(a(3) & "." & a(2) & "." & a(1) & "." & a(0) & ".sbl.spamhaus.org")
End With
If (strLookup = "127.0.0.3") Then IsSnowShoe = True
End Function
Function GeoLookup(strIP) : GeoLookup = "zz"
Dim a, element, group, strLookup
a = Split(strIP, ".")
With CreateObject("DNSLibrary.DNSResolver")
strLookup = .TXT(a(3) & "." & a(2) & "." & a(1) & "." & a(0) & ".zz.countries.nerd.dk")
End With
If Trim(strLookup) = "" Then
EventLog.Write( "- GeoLookup(" & strIP & ") = " & GeoLookup )
Exit Function
End If
group = Split(strLookup, vbCrLf)
If UBound(group) > 0 Then
For Each element In group
If (Trim(element) <> "") Then EventLog.Write( "- GeoLookup(" & strIP & ") = " & element )
Next
Else
GeoLookup = group(0)
End If
End Function
Function AutoBan(sIPAddress, sReason, iDuration, sType) : AutoBan = False
'
' sType can be one of the following;
' "yyyy" Year, "m" Month, "d" Day, "h" Hour, "n" Minute, "s" Second
'
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
With LockFile(oApp.Settings.Directories.TempDirectory & "\autoban.lck")
On Error Resume Next
oApp.Settings.SecurityRanges.Refresh
If (oApp.Settings.SecurityRanges.ItemByName("(" & sReason & ") " & sIPAddress) Is Nothing) Then
With oApp.Settings.SecurityRanges.Add
.Name = "(" & sReason & ") " & sIPAddress
.LowerIP = sIPAddress
.UpperIP = sIPAddress
.Priority = 20
.Expires = True
.ExpiresTime = DateAdd(sType, iDuration, Now())
.Save
End With
AutoBan = True
End If
oApp.Settings.SecurityRanges.Refresh
On Error Goto 0
.Close
End With
End Function
Function isBanned(oMessage) : isBanned = False
Dim strRegEx, i, a, Match, Matches, strIP, strLowerIP, strUpperIP, strReceivedBy
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
'
' Backup-MX/Relay-Host.
'
strReceivedBy = "backup-mx.post.tele.dk"
'
' RegEx to locate IPv4 address in string.
'
strRegEx = "(?:[0-9]{1,3}\.){3}[0-9]{1,3}"
For i = 0 To oMessage.Headers.Count-1
If (oMessage.Headers(i).Name = "Received") Then
If Lookup("by " & strReceivedBy, oMessage.Headers(i).Value) Then
Set Matches = oLookup(strRegEx, oMessage.Headers(i).Value, False)
For Each Match In Matches
oMessage.HeaderValue("X-Envelope-IPAddress") = Match.Value
oMessage.Save
strIP = Match.Value
For a = 0 To oApp.Settings.SecurityRanges.Count-1
If (oApp.Settings.SecurityRanges.Item(a).Priority = 20) Then
strLowerIP = oApp.Settings.SecurityRanges.Item(a).LowerIP
strUpperIP = oApp.Settings.SecurityRanges.Item(a).UpperIP
If (strUpperIP >= strIP >= strLowerIP) Then
EventLog.Write( "Wohoo (isBanned), " & strIP & " in range of " & strLowerIP & "-" & strUpperIP )
isBanned = True
Exit Function
End If
End If
Next
Next
Exit Function
End If
End If
Next
End Function
Function GetDatabaseObject()
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
Set GetDatabaseObject = oApp.Database
End Function
Function LoadXML(XMLFile)
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
Dim oXML : Set oXML = CreateObject("MSXML2.DOMDocument")
oXML.Load(oApp.Settings.Directories.EventDirectory & "\" & XMLFile)
If oXML.parseError <> 0 Then
EventLog.Write( "XML ERROR - errorCode - " & oXML.parseError.errorCode ) ' Returns a long integer error code
EventLog.Write( "XML ERROR - reason - " & oXML.parseError.reason ) ' Returns a string explaining the reason for the error
EventLog.Write( "XML ERROR - line - " & oXML.parseError.line ) ' Returns a long integer representing the line number for the error
EventLog.Write( "XML ERROR - linePos - " & oXML.parseError.linePos ) ' Returns a long integer representing the line position for the error
EventLog.Write( "XML ERROR - srcText - " & oXML.parseError.srcText ) ' Returns a string containing the line that caused the error
EventLog.Write( "XML ERROR - url - " & oXML.parseError.url ) ' Returns the url pointing the loaded document
EventLog.Write( "XML ERROR - filePos - " & oXML.parseError.filePos ) ' Returns a long integer file position of the error
End If
Set LoadXML = oXML
End Function
Function LoadXMLNode(oXML, MyNode) : LoadXMLNode = ""
Dim Match, Matches, strTXT
Set Matches = oXML.selectNodes(MyNode)
strTXT = ""
For Each Match In Matches
strTXT = strTXT & Match.text & "|"
Next
If (Trim(strTXT) <> "") Then
LoadXMLNode = Left(strTXT,Len(strTXT)-1)
Else
EventLog.Write( "ERROR: Empty string from LoadXMLNode(oXML, " & MyNode & ")" )
End If
End Function
'******************************************************************************************************************************
'********** Subroutines **********
'******************************************************************************************************************************
Sub XEnvelope(oMessage)
Dim i, strEnvelope1, strEnvelope2
For i = 0 To oMessage.Recipients.Count-1
If (i = 0) Then
strEnvelope1 = oMessage.Recipients(i).Address
strEnvelope2 = oMessage.Recipients(i).OriginalAddress
Else
strEnvelope1 = strEnvelope1 & ", " & oMessage.Recipients(i).Address
strEnvelope2 = strEnvelope2 & ", " & oMessage.Recipients(i).OriginalAddress
End If
Next
oMessage.HeaderValue("X-Envelope-To") = strEnvelope1
oMessage.HeaderValue("X-Envelope-OriginalTo") = strEnvelope2
oMessage.HeaderValue("X-Envelope-From") = oMessage.FromAddress
oMessage.Save
End Sub
Sub SPAMList(oMessage, strMatch)
Dim i
If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then
i = CInt(oMessage.HeaderValue("X-hMailServer-Reason-Score"))
Else
oMessage.HeaderValue("X-hMailServer-Spam") = "YES"
i = 0
End If
oMessage.HeaderValue("X-hMailServer-Reason-0") = "SPAMlisted - (Score: 5)"
oMessage.HeaderValue("X-hMailServer-Reason-Score") = 5 + i
oMessage.HeaderValue("X-Blacklist-RegEx") = strMatch
oMessage.Save
End Sub
Sub WhiteList(oMessage, strMatch)
Dim i
If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then
oMessage.HeaderValue("X-Whitelist-RegEx") = strMatch
oMessage.Headers.ItemByName("X-hMailServer-Spam").Delete
For i = 0 To 10
If (oMessage.HeaderValue("X-hMailServer-Reason-" & i) <> "") Then _
oMessage.Headers.ItemByName("X-hMailServer-Reason-" & i).Delete
Next
oMessage.Headers.ItemByName("X-hMailServer-Reason-Score").Delete
oMessage.Save
End If
End Sub
Sub RansomWare(oMessage)
Dim i
If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then
i = CInt(oMessage.HeaderValue("X-hMailServer-Reason-Score"))
Else
oMessage.HeaderValue("X-hMailServer-Spam") = "YES"
i = 0
End If
oMessage.HeaderValue("X-hMailServer-Reason-0") = "RansomWare - (Score: 5)"
oMessage.HeaderValue("X-hMailServer-Reason-Score") = 5 + i
oMessage.Subject = ":!: RansomWare :!: " & oMessage.Subject
oMessage.Save
End Sub
'******************************************************************************************************************************
'********** hMailServer Triggers **********
'******************************************************************************************************************************
Sub OnClientConnect(oClient)
'
' Exclude Backup-MX & local LAN from test
'
If (Left(oClient.IPAddress, 10) = "80.160.77.") Then Exit Sub
If (Left(oClient.IPAddress, 10) = "192.168.0.") Then Exit Sub
'
' Only allow non-SMTP connect from "Rigsfællesskabet"/"Naalagaaffeqatigiit"/"Ríkisfelagsskapurin" = The Danish Realm.
' zz = N/A, dk = Denmark, gl = Greenland, fo = Faroe Islands
'
If (oClient.Port <> 25) Then
If (InStr("|dk|gl|fo|", GeoLookup(oClient.IPAddress)) = 0) Then
Call idsAddIP(oClient.IPAddress, oClient.Port)
Result.Value = 1
Exit Sub
End If
End If
'
' Filter out "impatient" servers. Alternative to GreyListing.
'
If (oClient.Port = 25) Then Wait(20)
'
' Only test SMTP traffic
'
If (InStr("|25|587|465|", oClient.Port) > 0) Then Call idsAddIP(oClient.IPAddress, 0)
End Sub
Sub OnHELO(oClient)
Dim oXML : Set oXML = LoadXML(XMLDATA)
Dim strRegEx, Match, Matches
'
' Exclude Backup-MX & local LAN from test
'
If (Left(oClient.IPAddress, 10) = "80.160.77.") Then Exit Sub
If (Left(oClient.IPAddress, 10) = "192.168.0.") Then Exit Sub
'
' SnowShoe SPAM detection
'
If IsSnowShoe(oClient.IPAddress) Then
Result.Value = 2
Result.Message = "5.7.1 CODE01 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
'
' Filter out "impatient" servers. Alternative to GreyListing.
'
If (oClient.Port = 25) Then Wait(20)
'
' FIX for known anomalities ...
'
strRegEx = "^(VVS-WEB)[0-9]{2}(\.localdomain)$"
If Lookup(strRegEx, oClient.HELO) Then Exit Sub
'
' Deny servers with specific HELO/EHLO greetings
'
strRegEx = LoadXMLNode(oXML, "//Reject/HELO")
Set Matches = oLookup(strRegEx, oClient.HELO, False)
For Each Match In Matches
Result.Value = 2
Result.Message = "5.7.1 CODE02 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, "BLACKLIST - " & oClient.HELO, 7, "d")
Exit Sub
Next
'
' Validate HELO/EHLO greeting
'
Const strFQDN = "^(?=^.{1,254}$)(^(?:(?!\.|-)([a-z0-9\-\*]{1,63}|([a-z0-9\-]{1,62}[a-z0-9]))\.)+(?:[a-z]{2,})$)$"
Const strIPv4 = "^\[(?:[0-9]{1,3}\.){3}[0-9]{1,3}\]$"
Const strIPv6 = "^\[(IPv6)((?:[0-9A-Fa-f]{0,4}:){1,7}(?:(?:(>25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)|[0-9A-Fa-f]{1,4}))\]$"
strRegEx = strFQDN & "|" & strIPv4 & "|" & strIPv6
If (Lookup(strRegEx, oClient.HELO) = False) Then
Result.Value = 2
Result.Message = "5.7.1 CODE03 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, "Bad HELO - " & oClient.HELO, 7, "d")
Exit Sub
End If
End Sub
'*
'* ********** SPAM test: DNSBlackLists, HeloHost, MXRecords, SPF
'*
Sub OnSMTPData(oClient, oMessage)
Dim strRegEx, Match, Matches, i
'
' Exclude Backup-MX & local LAN from test
'
If (Left(oClient.IPAddress, 10) = "80.160.77.") Then Exit Sub
If (Left(oClient.IPAddress, 10) = "192.168.0.") Then Exit Sub
'
' Filter out "impatient" servers. Alternative to GreyListing.
'
If (oClient.Port = 25) Then Wait(20)
End Sub
'*
'* ********** SPAM test: SURBL, DKIM, SpamAssassin
'*
Sub OnAcceptMessage(oClient, oMessage)
Dim oXML : Set oXML = LoadXML(XMLDATA)
Dim i, a, strRegEx, Match, Matches
'
' Placeholder for senders IP Address either direct or via Backup-MX
'
oMessage.HeaderValue("X-Envelope-IPAddress") = oClient.IPAddress
oMessage.Save
'
' Exclude Backup-MX & local LAN from test
'
strRegEx = "^(80\.160\.77\.)[0-9]{1,3}$|^(192\.168\.0\.)[0-9]{1,3}$"
If Not Lookup(strRegEx, oClient.IPAddress) Then
'
' Cleanup IDS registry
'
Call idsDelIP(oClient.IPAddress)
End If
'
' Exclude authenticated users test
'
If (oClient.Username <> "") Then Exit Sub
'
' Banned sender via Backup-MX ?
'
If (Left(oClient.IPAddress, 10) = "80.160.77.") Then
If isBanned(oMessage) Then
Result.Value = 2
Result.Message = "5.7.1 CODE08 The SMTP service on IP address (" & oMessage.HeaderValue("X-Envelope-IPAddress") & ") is not welcome here."
Exit Sub
End If
End If
'
' Reject "List-Unsubscribe:"
'
strRegEx = LoadXMLNode(oXML, "//Reject/List-Unsubscribe")
Set Matches = oLookup(strRegEx, oMessage.HeaderValue("List-Unsubscribe"), False)
For Each Match In Matches
Result.Value = 2
Result.Message = "5.7.1 CODE09 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
Next
'
' Reject "X-Envelope-From:"
'
strRegEx = LoadXMLNode(oXML, "//Reject/X-Envelope-From")
Set Matches = oLookup(strRegEx, oMessage.FromAddress, False)
For Each Match In Matches
Result.Value = 2
Result.Message = "5.7.1 CODE04 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
Next
'
' Reject "From:"
'
strRegEx = LoadXMLNode(oXML, "//Reject/From")
Set Matches = oLookup(strRegEx, oMessage.From, False)
For Each Match In Matches
Result.Value = 2
Result.Message = "5.7.1 CODE05 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
Next
'
' Reject "Subject:"
'
strRegEx = LoadXMLNode(oXML, "//Reject/Subject")
If (oMessage.HeaderValue("X-Blacklist-RegEx") = "") Then
Set Matches = oLookup(strRegEx, oMessage.Subject, False)
For Each Match In Matches
Result.Value = 2
Result.Message = "5.7.1 CODE06 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
Next
End If
'
' Reject "Body:"
'
strRegEx = LoadXMLNode(oXML, "//Reject/Bodytxt")
If Lookup(strRegEx, oMessage.Body) Or Lookup(strRegEx, oMessage.HTMLBody) Then
Result.Value = 2
Result.Message = "5.7.1 CODE07 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
'
' RansomWare - Body text/URL check
'
strRegEx = LoadXMLNode(oXML, "//Ransomeware/Bodytxt")
If Lookup(strRegEx, oMessage.Body) Or Lookup(strRegEx, oMessage.HTMLBody) Then Call RansomWare(oMessage)
'
' Additional SPAM processing
'
Dim Done : Done = False
If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then Done = True
Do Until Done
'
' Blacklist IP Range
' http://www.analyticsmarket.com/freetools/ipregex
' 216.82.240.0 - 216.82.255.255 = MessageLabs Inc. (Symantec Inc.)
' ^216\.82\.(2(4[0-9]|5[0-5]))\.([0-9]|[1-9][0-9]|1([0-9][0-9])|2([0-4][0-9]|5[0-5]))$
'
strRegEx = LoadXMLNode(oXML, "//Blacklist/IPRange")
Set Matches = oLookup(strRegEx, oClient.IPAddress, False)
For Each Match In Matches
Call SPAMList(oMessage, "BlackList oClient.IPAddress: Value '" & Match.Value & "'")
Exit Do
Next
'
' Blacklist "X-Envelope-From:"
'
strRegEx = LoadXMLNode(oXML, "//Blacklist/X-Envelope-From")
Set Matches = oLookup(strRegEx, oMessage.FromAddress, False)
For Each Match In Matches
Call SPAMList(oMessage, "BlackList oMessage.FromAddress: Value '" & Match.Value & "'")
Exit Do
Next
'
' Blacklist "From:"
'
strRegEx = LoadXMLNode(oXML, "//Blacklist/From")
Set Matches = oLookup(strRegEx, oMessage.From, False)
For Each Match In Matches
Call SPAMList(oMessage, "BlackList oMessage.From: Value '" & Match.Value & "'")
Exit Do
Next
'
' Blacklist "Subject:"
'
strRegEx = LoadXMLNode(oXML, "//Blacklist/Subject")
Set Matches = oLookup(strRegEx, oMessage.Subject, False)
For Each Match In Matches
Call SPAMList(oMessage, "BlackList oMessage.Subject: Value '" & Match.Value & "'")
Exit Do
Next
'
' Blacklist Body - iPhone SPECIAL
'
strRegEx = LoadXMLNode(oXML, "//Blacklist/Bodytxt")
Set Matches = oLookup(strRegEx, oMessage.Body, False)
For Each Match In Matches
Call SPAMList(oMessage, "BlackList oMessage.Body: Value '" & Match.Value & "'")
Exit Do
Next
'
' <!-- ... --> PHP: "(<!--[^>]*-->)" JavaScript: "(<!--[\s\S]*?-->)"
' /* ... */ PHP: "(\/\*)[^>]*(\*\/)" JavaScript: "(\/\*)[\s\S]*?(\*\/)"
' <!--[\\s\\S]*?(?:-->)?<!---+>?|<!(?![dD][oO][cC][tT][yY][pP][eE]|\\[CDATA\\])[^>]*>?|<[?][^>]*>?
'
Dim strHTMLBody : strHTMLBody = oMessage.HTMLBody
With CreateObject("VBScript.RegExp")
.Pattern = "(\/\*[\s\S]*?\*\/)|(<[\s\S]*?>)"
.Global = True
.MultiLine = True
.IgnoreCase = True
strHTMLBody = .Replace(strHTMLBody, "")
End With
Set Matches = oLookup(strRegEx, strHTMLBody, False)
For Each Match In Matches
Call SPAMList(oMessage, "BlackList oMessage.HTMLBody: Value '" & Match.Value & "'")
Exit Do
Next
Done = True
Loop
If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then
'
' Whitelist "X-Envelope-From:"
'
If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then
strRegEx = LoadXMLNode(oXML, "//Whitelist/X-Envelope-From")
Set Matches = oLookup(strRegEx, oMessage.FromAddress, False)
For Each Match In Matches
Call WhiteList(oMessage, "WhiteList oMessage.FromAddress: Value '" & Match.Value & "'")
Next
End If
'
' Whitelist "From:"
'
If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then
strRegEx = LoadXMLNode(oXML, "//Whitelist/From")
Set Matches = oLookup(strRegEx, oMessage.From, False)
For Each Match In Matches
Call WhiteList(oMessage, "WhiteList oMessage.From: Value '" & Match.Value & "'")
Next
End If
End If
'
' Add X-Envelope... headers
'
Call XEnvelope(oMessage)
End Sub
'*
'* ********** Saving EML to DATA
'*
'* Sub OnDeliveryStart(oMessage)
'* End Sub
'*
'* ********** Antivirus check, Global rules
'*
'* Sub OnDeliverMessage(oMessage)
'* End Sub
'*
'* ********** Local rules, Message delivered to recipient(s)
'*
'* Sub OnDeliveryFailed(oMessage, sRecipient, sErrorMessage)
'* End Sub
'* Sub OnExternalAccountDownload(oFetchAccount, oMessage, sRemoteUID)
'* End Sub
Sub OnBackupFailed(sReason)
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
If (oApp.ServerState = 1) Then
EventLog.Write( "" )
EventLog.Write( "EventHandlers: Starting server AFTER backup FAILED! Error: " & sReason )
EventLog.Write( "" )
Call oApp.Start
End If
End Sub
Sub OnBackupCompleted()
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
If (oApp.ServerState = 1) Then
EventLog.Write( "" )
EventLog.Write( "EventHandlers: Starting server after backup COMPLETED." )
EventLog.Write( "" )
Call oApp.Start
End If
End Sub
Sub OnError(iSeverity, iCode, sSource, sDescription)
Dim EventLogX : Set EventLogX = New LogWriter
'
' Name of the logfile.
' Default is monthly logs, for daily logs add: EventLogX.LogType = "D"
'
EventLogX.LogFile = "error"
EventLogX.Write( "" )
EventLogX.Write( "iSeverity: " & iSeverity )
EventLogX.Write( "iCode: " & iCode )
EventLogX.Write( "sSource: " & sSource )
EventLogX.Write( "sDescription: " & sDescription )
End Sub
'******************************************************************************************************************************
'********** hMailServer Rules **********
'******************************************************************************************************************************
'
' Rules test ...
'
' True: Mon-Thu 00:00 - 06:59 & 17:00 - 23:59
' (?i:^.*\;.(Mon|Tue|Wed|Thu).*.(([0][0-6])|([1][7-9])|([2][0-3]))\:.*$)
'
' True: Fri 00:00 - 06:59 & 16:00 - 23:59
' (?i:^.*\;.(Fri).*.(([0][0-6])|([1][6-9])|([2][0-3]))\:.*$)
'
' True: Sat-Sun
' (?i:^.*\;.(Sat|Sun).*$)
'
' True: Mon-Fri 00:00 - 06:59 & 17:00 - 23:59 & Sun & Sat
' (?i:^(.*\;.)((Sat|Sun)|((Mon|Tue|Wed|Thu|Fri)(.*\x20)(([0][0-6])|([1][7-9])|([2][0-3]))\:))(.*)$)
'
' True: 25 Dec 07:00 - 16:59
' (?i:^.*\,.(25 Dec).*.(([0][7-9])|([1][0-6]))\:.*$)
'
Sub Unsubscribe(oMessage)
'
' RFC6068 The 'mailto' URI Scheme: subject, cc, bcc, in-reply-to, body etc.. ?first &second &third etc...
'
Const m_To = "Donald J. Trump"
Const m_Sender = "Wile E. Coyote"
Const m_SenderAddress = "wile.e.coyote@acme.inc"
Dim a, b, strRegEx, Match, Matches, sMailTo, sURL, m_Subject, m_Body, doMail, doURL
strRegEx = "^[0-1]:[0-1]$"
If Lookup(strRegEx, oMessage.HeaderValue("X-hMailServer-Unsubscribe")) Then
a = Split(oMessage.HeaderValue("X-hMailServer-Unsubscribe"), ":")
doMail = a(0)
doURL = a(1)
Else
doMail = True
doURL = True
End If
If doMail Then
strRegEx = "([^\<]*?)(mailto:[\s\S]*?)(?=\>)"
Set Matches = oLookup(strRegEx, oMessage.HeaderValue("List-Unsubscribe"), True)
For Each Match In Matches
sMailTo = Mid(Trim(Match.Value), 8)
a = Split(sMailTo, "?")
If (UBound(a) > 0) Then
b = Split(a(1), "&")
If (InStr(1, b(0), "subject=", 1) > 0) Then m_Subject = Replace(b(0), "subject=", "")
If (InStr(1, b(0), "body=", 1) > 0) Then m_Body = Replace(b(0), "body=", "")
If (UBound(b) > 0) Then
If (InStr(1, b(1), "subject=", 1) > 0) Then m_Subject = Replace(b(1), "subject=", "")
If (InStr(1, b(1), "body=", 1) > 0) Then m_Body = Replace(b(1), "body=", "")
End If
End If
With CreateObject("hMailServer.Message")
.From = Chr(34) & m_Sender & Chr(34) & " <" & m_SenderAddress & ">"
.FromAddress = m_SenderAddress
.AddRecipient a(0), a(0)
.AddRecipient m_Sender, m_SenderAddress
.HeaderValue("To") = Chr(34) & m_To & Chr(34) & " <" & a(0) & ">"
.HeaderValue("CC") = Chr(34) & m_Sender & Chr(34) & " <" & m_SenderAddress & ">"
.Subject = "Unsubscribe"
If Not (m_Subject = Empty) Then .Subject = m_Subject
.Body = "Unsubscribe"
If Not (m_Body = Empty) Then .Body = m_Body
.Save
End With
If (Err.Number <> 0) Then
EventLog.Write( "ERROR: Sub Unsubscribe(oMessage)" )
EventLog.Write( "Error : " & Err.Number )
EventLog.Write( "Error (hex) : 0x" & Hex(Err.Number) )
EventLog.Write( "Source : " & Err.Source )
EventLog.Write( "Description : " & Err.Description )
Err.Clear
Exit Sub
End If
Next
End If
If doURL Then
strRegEx = "([^\<]*?)((http|https):[\s\S]*?)(?=\>)"
Set Matches = oLookup(strRegEx, oMessage.HeaderValue("List-Unsubscribe"), True)
For Each Match In Matches
sURL = Trim(Match.Value)
On Error Resume Next
With CreateObject("MSXML2.ServerXMLHTTP.6.0")
.setoption(2) = (.getoption(2) & " - SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS")
.open "GET", sURL, False
.setrequestheader "User-Agent", "online link validator (http://www.dead-links.com/)"
.send ("")
End With
On Error Goto 0
If (Err.Number <> 0) Then
EventLog.Write( "ERROR: Sub Unsubscribe(oMessage)" )
EventLog.Write( "Error : " & Err.Number )
EventLog.Write( "Error (hex) : 0x" & Hex(Err.Number) )
EventLog.Write( "Source : " & Err.Source )
EventLog.Write( "Description : " & Err.Description )
Err.Clear
Exit Sub
End If
Next
End If
End Sub
'******************************************************************************************************************************
'********** END **********
'******************************************************************************************************************************
Sub OnHELO(oClient) is NOT available in the original compilation.
If you wish to make use of this added trigger please see viewtopic.php?p=206039#p206039
Last edited by SorenR on 2019-01-28 18:20, edited 1 time in total.
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
#5 How does a fully functioning system look like? PART 2!
File: Handler.vbs
File: Check-State.vbs
File: RunBackup.vbs
File: hMailServer.xml
File: Handler.vbs
Code: Select all
Option Explicit
'******************************************************************************************************************************
'********** Settings **********
'******************************************************************************************************************************
'
' COM authentication
'
Private Const ADMIN = "Administrator"
Private Const PASSWORD = "########"
'
' MySQL
'
Private Const DBNAME = "hmailserver"
Private Const DBUID = "hmsuser"
Private Const DBPW = "########"
Private Const idsTable = "hm_ids"
Private Const idsHits = 3
Private Const idsMinutes = 180
Dim idsDBDrv : idsDBDrv = "DRIVER={MySQL ODBC 5.3 Unicode Driver};Database="&DBNAME&";Uid="&DBUID&";Pwd="&DBPW&";Option=3;"
'
' DRIVER={MySQL ODBC 5.3 Unicode Driver};Server=localhost;Port=3306;Database=%idsdb%;Uid=%idsuid%;Pwd=%idspwd%;Option=3;
'
' Table: CREATE TABLE %idsTable% (
' timestamp DATETIME,
' ipaddress VARCHAR (192) PRIMARY KEY,
' port INTEGER,
' hits INTEGER);
'
'******************************************************************************************************************************
'********** Classes **********
'******************************************************************************************************************************
Class LogWriter
Private m_oApp, m_LogID, m_LogFile, m_LogType, m_LogDir
Private i, t, temp, strDay, strMonth, strTime, strLogFile, strLogDate
Private Sub Class_Initialize()
Set m_oApp = CreateObject("hMailServer.Application")
Call m_oApp.Authenticate(ADMIN, PASSWORD)
m_LogFile = "LogWriter"
m_LogType = "M"
m_LogDir = m_oApp.Settings.Directories.LogDirectory
m_LogID = CStr(m_oApp.Status.ProcessedMessages)
End Sub
Private Sub Class_Terminate()
'
' Termination code goes here.
'
End Sub
Public Property Let LogFile(strFile)
m_LogFile = Trim(strFile)
End Property
Public Property Let LogDir(strDir)
If (Right(strDir, 1) = "\") Then
m_LogDir = Trim(Left(strDir, Len(strDir) - 1))
Else
m_LogDir = Trim(strDir)
End If
End Property
Public Property Let LogType(strType)
m_LogType = Trim(strType)
End Property
Public Function Wait(sec)
With CreateObject("WScript.Shell")
.Run "timeout /T " & Int(sec), 0, True ' Windows 7/2003/2008 or later
' .Run "sleep -m " & Int(sec * 1000), 0, True ' Windows 2003 Resource Kit
' .Run "powershell Start-Sleep -Milliseconds " & Int(sec * 1000), 0, True
End With
End Function
Public Function OpenFile(strPath)
Const Append = 8
Const Unicode = -1
With CreateObject("Scripting.FileSystemObject")
Dim oFile
For i = 0 To 30
On Error Resume Next
Set oFile = .OpenTextFile(strPath, Append, True, Unicode)
If Not (Err.Number = 70) Then
Set OpenFile = oFile
On Error Goto 0
Exit For
End If
On Error Goto 0
Wait(1)
Next
End With
If (Err.Number = 70) Then
EventLog.Write( "ERROR: VBScript Class LogWriter" )
EventLog.Write( "File " & strPath & " is locked and timeout was exceeded." )
Err.Clear
ElseIf (Err.Number <> 0) Then
EventLog.Write( "ERROR: VBScript Class LogWriter : Function OpenFile" )
EventLog.Write( "Error : " & Err.Number )
EventLog.Write( "Error (hex) : 0x" & Hex(Err.Number) )
EventLog.Write( "Source : " & Err.Source )
EventLog.Write( "Description : " & Err.Description )
Err.Clear
End If
End Function
Public Function Write(strText)
t = Timer
temp = Int(t)
strMonth = DatePart("yyyy",Date) & "-" & Right("0" & DatePart("m",Date), 2)
strDay = strMonth & "-" & Right("0" & DatePart("d",Date), 2)
strTime = Right("0" & Hour(Now), 2) & ":" &_
Right("0" & Minute(Now), 2) & ":" &_
Right("0" & Second(Now), 2) & "." &_
Right("00" & (Int((t-temp) * 1000)), 3)
strLogDate = strDay & " " & strTime
If (m_LogType = "M") Then
strLogFile = m_LogDir & "\" & m_LogFile & "_" & strMonth & ".log"
Else
strLogFile = m_LogDir & "\" & m_LogFile & "_" & strDay & ".log"
End If
With OpenFile(strLogFile)
.WriteLine(m_LogID & vbTab & Chr(34) & strLogDate & Chr(34) & vbTab & Chr(34) & strText & Chr(34))
.Close
End With
Write = Err.Number
End Function
End Class
'******************************************************************************************************************************
'********** Functions **********
'******************************************************************************************************************************
Function AutoBan(sIPAddress, sReason, iDuration, sType) : AutoBan = False
'
' sType can be one of the following;
' "yyyy" Year, "m" Month, "d" Day, "h" Hour, "n" Minute, "s" Second
'
On Error Resume Next
If (oApp.Settings.SecurityRanges.ItemByName("(" & sReason & ") " & sIPAddress) Is Nothing) Then
With oApp.Settings.SecurityRanges.Add
.Name = "(" & sReason & ") " & sIPAddress
.LowerIP = sIPAddress
.UpperIP = sIPAddress
.Priority = 20
.Expires = True
.ExpiresTime = DateAdd(sType, iDuration, Now())
.Save
End With
AutoBan = True
End If
oApp.Settings.SecurityRanges.Refresh
On Error Goto 0
End Function
'******************************************************************************************************************************
'********** CODE **********
'******************************************************************************************************************************
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
Dim EventLog : Set EventLog = CreateObject("hMailServer.EventLog")
Dim EventLogX : Set EventLogX = New LogWriter
'
' Name of the logfile.
' Default is monthly logs, for daily logs add: EventLogX.LogType = "D"
'
EventLogX.LogFile = "handler"
Dim strPort
Dim oRecord, oConn : Set oConn = CreateObject("ADODB.Connection")
oConn.Open idsDBDrv
If oConn.State <> 1 Then
EventLog.Write( "Handler - ERROR: Could not connect to database" )
WScript.Quit 1
End If
Set oRecord = oConn.Execute("SELECT * FROM " & idsTable & " WHERE hits > " & idsHits & " AND port = 0;")
If Err.Number <> 0 Then
EventLog.Write( "Handler - ERROR: Table " & idsTable & " does not exist!" )
WScript.Quit 1
End If
If Not oRecord.BOF And Not oRecord.EOF Then
While Not oRecord.EOF
EventLogX.Write( "Wohoo... IPAddress: " & oRecord("ipaddress") & " Port: " & oRecord("port") & " Hits: " & oRecord("hits") )
If (DateDiff("n", oRecord("timestamp"), Now()) < idsMinutes) Then
If AutoBan(oRecord("ipaddress"), "IDS", 7, "d") Then _
EventLogX.Write( "AutoBan(" & oRecord("ipaddress") & ", IDS, 7, d)" )
End If
oConn.Execute "DELETE FROM " & idsTable & " WHERE ipaddress = '" & oRecord("ipaddress") & "';"
oRecord.MoveNext
Wend
End If
Set oRecord = oConn.Execute("SELECT * FROM " & idsTable & " WHERE hits > " & idsHits & " AND port > 0;")
If Not oRecord.BOF And Not oRecord.EOF Then
While Not oRecord.EOF
EventLogX.Write( "Wohoo... IPAddress: " & oRecord("ipaddress") & " Port: " & oRecord("port") & " Hits: " & oRecord("hits") )
If (DateDiff("n", oRecord("timestamp"), Now()) < idsMinutes) Then
strPort = Trim(Mid("SMTP IMAP SMTPSSUBM IMAPS", InStr("25 143 465 587 993 ", oRecord("port")), 5))
If AutoBan(oRecord("ipaddress"), "GEOBLOCK - " & strPort, 7, "d") Then _
EventLogX.Write( "AutoBan(" & oRecord("ipaddress") & ", GEOBLOCK - " & strPort & ", 7, d)" )
End If
oConn.Execute "DELETE FROM " & idsTable & " WHERE ipaddress = '" & oRecord("ipaddress") & "';"
oRecord.MoveNext
Wend
End If
oConn.Execute "DELETE FROM " & idsTable & " WHERE DATE_ADD(timestamp, INTERVAL 1 DAY) < NOW();"
oConn.Close
'******************************************************************************************************************************
'********** END **********
'******************************************************************************************************************************
Code: Select all
Option Explicit
'******************************************************************************************************************************
'********** Settings **********
'******************************************************************************************************************************
'
' COM authentication
'
Private Const ADMIN = "Administrator"
Private Const PASSWORD = "########"
'******************************************************************************************************************************
'********** Classes **********
'******************************************************************************************************************************
Class LogWriter
Private m_oApp, m_LogID, m_LogFile, m_LogType, m_LogDir
Private i, t, temp, strDay, strMonth, strTime, strLogFile, strLogDate
Private Sub Class_Initialize()
Set m_oApp = CreateObject("hMailServer.Application")
Call m_oApp.Authenticate(ADMIN, PASSWORD)
m_LogFile = "LogWriter"
m_LogType = "M"
m_LogDir = m_oApp.Settings.Directories.LogDirectory
m_LogID = CStr(m_oApp.Status.ProcessedMessages)
End Sub
Private Sub Class_Terminate()
'
' Termination code goes here
'
End Sub
Public Property Let LogFile(strFile)
m_LogFile = Trim(strFile)
End Property
Public Property Let LogDir(strDir)
If Right(strDir, 1) = "\" Then
m_LogDir = Trim(Left(strDir, Len(strDir) - 1))
Else
m_LogDir = Trim(strDir)
End If
End Property
Public Property Let LogType(strType)
m_LogType = Trim(strType)
End Property
Public Function Wait(sec)
With CreateObject("WScript.Shell")
.Run "timeout /T " & Int(sec), 0, True
' .Run "sleep -m " & Int(sec * 1000), 0, True
' .Run "powershell Start-Sleep -Milliseconds " & Int(sec * 1000), 0, True
End With
End Function
Public Function OpenFile(strPath)
Const Append = 8
Const Unicode = -1
With CreateObject("Scripting.FileSystemObject")
Dim oFile
For i = 0 To 30
On Error Resume Next
Set oFile = .OpenTextFile(strPath, Append, True, Unicode)
If Not (Err.Number = 70) Then
Set OpenFile = oFile
On Error Goto 0
Exit For
End If
On Error Goto 0
Wait(1)
Next
End With
If (Err.Number = 70) Then
EventLog.Write( "ERROR: VBScript Class LogWriter" )
EventLog.Write( "File " & strPath & " is locked and timeout was exceeded." )
Err.Clear
ElseIf (Err.Number <> 0) Then
EventLog.Write( "ERROR: VBScript Class LogWriter : Function OpenFile" )
EventLog.Write( "Error : " & Err.Number )
EventLog.Write( "Error (hex) : 0x" & Hex(Err.Number) )
EventLog.Write( "Source : " & Err.Source )
EventLog.Write( "Description : " & Err.Description )
Err.Clear
End If
End Function
Public Function Write(strText)
t = Timer
temp = Int(t)
strMonth = DatePart("yyyy",Date) & "-" & Right("0" & DatePart("m",Date), 2)
strDay = strMonth & "-" & Right("0" & DatePart("d",Date), 2)
strTime = Right("0" & Hour(Now), 2) & ":" &_
Right("0" & Minute(Now), 2) & ":" &_
Right("0" & Second(Now), 2) & "." &_
Right("00" & (Int((t-temp) * 1000)), 3)
strLogDate = strDay & " " & strTime
If (m_LogType = "M") Then
strLogFile = m_LogDir & "\" & m_LogFile & "_" & strMonth & ".log"
Else
strLogFile = m_LogDir & "\" & m_LogFile & "_" & strDay & ".log"
End If
With OpenFile(strLogFile)
.WriteLine(m_LogID & vbTab & Chr(34) & strLogDate & Chr(34) & vbTab & Chr(34) & strText & Chr(34))
.Close
End With
Write = Err.Number
End Function
End Class
'******************************************************************************************************************************
'********** CODE **********
'******************************************************************************************************************************
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
Dim EventLog : Set EventLog = CreateObject("hMailServer.EventLog")
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
Dim EventLogX : Set EventLogX = New LogWriter
'
' Name of the logfile.
' Default is monthly logs, for daily logs add: EventLogX.LogType = "D"
'
EventLogX.LogFile = "checkstate"
If oApp.ServerState = 1 Then
If (FSO.FolderExists(oApp.Settings.Backup.Destination & "\DataBackup")) Then
EventLogX.Write("CheckState: Server is currently doing backup...")
Else
EventLogX.Write("CheckState: Server was stopped for no reason, starting...")
Call oApp.Start
End If
End If
'******************************************************************************************************************************
'********** END **********
'******************************************************************************************************************************
Code: Select all
Option Explicit
'******************************************************************************************************************************
'********** Settings **********
'******************************************************************************************************************************
'
' COM authentication
'
Private Const ADMIN = "Administrator"
Private Const PASSWORD = "########"
'******************************************************************************************************************************
'********** Functions **********
'******************************************************************************************************************************
Function Wait(sec)
With CreateObject("WScript.Shell")
.Run "timeout /T " & Int(sec), 0, True ' Windows 7/2003/2008 or later
' .Run "sleep -m " & Int(sec * 1000), 0, True ' Windows 2003 Resource Kit
' .Run "powershell Start-Sleep -Milliseconds " & Int(sec * 1000), 0, True
End With
End Function
'******************************************************************************************************************************
'********** CODE **********
'******************************************************************************************************************************
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
Dim EventLog : Set EventLog = CreateObject("hMailServer.EventLog")
'******************************************************************************************************************************
'********** RunBackup **********
'******************************************************************************************************************************
Dim LoopCount : LoopCount = 0
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
EventLog.Write("")
If (oApp.ServerState = 1) Then
If FSO.FolderExists(oApp.Settings.Backup.Destination & "\DataBackup") Then
EventLog.Write("RunBackup: Server is currently doing backup...")
Else
EventLog.Write("RunBackup: Server is stopped for no reason, aborting backup...")
End If
Else
EventLog.Write("RunBackup: Stopping server for Backup")
Call oApp.Stop
EventLog.Write("RunBackup: Waiting for server to stop")
Do While (oApp.ServerState = 4 And LoopCount < 6)
EventLog.Write("RunBackup: Waiting...")
Wait(5)
LoopCount = LoopCount + 1
Loop
If (LoopCount > 5) Then EventLog.Write("RunBackup: Something went wrong - timeout waiting for server to stop.")
Call oApp.BackupManager.StartBackup()
EventLog.Write("RunBackup: Backup started")
End If
'******************************************************************************************************************************
'********** END **********
'******************************************************************************************************************************
'* '
'* ' Triggers for EventHandlers.vbs
'* '
'*
'* Sub OnBackupFailed(sReason)
'* Dim oApp : Set oApp = CreateObject("hMailServer.Application")
'* Call oApp.Authenticate(ADMIN, PASSWORD)
'* If (oApp.ServerState = 1) Then
'* EventLog.Write( "" )
'* EventLog.Write( "EventHandlers: Starting server AFTER backup FAILED! Error: " & sReason )
'* EventLog.Write( "" )
'* Call oApp.Start
'* End If
'* End Sub
'*
'* Sub OnBackupCompleted()
'* Dim oApp : Set oApp = CreateObject("hMailServer.Application")
'* Call oApp.Authenticate(ADMIN, PASSWORD)
'* If (oApp.ServerState = 1) Then
'* EventLog.Write( "" )
'* EventLog.Write( "EventHandlers: Starting server after backup COMPLETED." )
'* EventLog.Write( "" )
'* Call oApp.Start
'* End If
'* End Sub
Code: Select all
<?xml version="1.0" encoding="utf-8" standalone="yes"?>
<Parameters>
<Reject>
<HELO>^(\[123\.123\.123\.123\])$<!--This is your public IP address.--></HELO>
<HELO>^(acme\.inc)$<!--This is your public DOMAIN.--></HELO>
<HELO>^(mx\.acme\.inc)$<!--This is your public SERVER address.--></HELO>
<HELO>^(.*\.[a-z]{4,})$<!--WILL MATCH ANY 4+ LETTER TLD, USE WITH CAUTION!--></HELO>
<HELO>(0\.0\.0\.0)</HELO>
<HELO>(127(?:\.[0-9]{1,3}){3})</HELO>
<List-Unsubscribe>(\<http:\/\/(.*)\/unsubscribe\.php\?M=(.*)&C=(.*)&L=(.*)&N=(.*)\>)</List-Unsubscribe>
<X-Envelope-From>^(.*\@dcs-dz\.com)$</X-Envelope-From>
<X-Envelope-From>^(.*\@dozura\.com)$</X-Envelope-From>
<X-Envelope-From>^(.*\@danzamor\.com)$</X-Envelope-From>
<X-Envelope-From>^(.*\@twoomail\.com)$</X-Envelope-From>
<X-Envelope-From>^(.*\@vrshoesale\.com)$</X-Envelope-From>
<X-Envelope-From>^(.*\@danmarkmail\.com)$</X-Envelope-From>
<X-Envelope-From>^(.*\@epsp-telagh\.com)$</X-Envelope-From>
<X-Envelope-From>(\.tw|\.bid|\.kim|\.men|\.top|\.win|\.xyz|\.zip)$</X-Envelope-From>
<From>(Sweetme)|(Kira Johns)|(July Girl)|(Hot Mama)|(Little Miss)</From>
<From>(Baby Boobs)|(Booby Girl)|(Booby Booms)</From>
<From>(\.tw|\.bid|\.kim|\.men|\.top|\.win|\.xyz|\.zip)(|\>)$</From>
<Subject>^(yo|hi|sup|hello|greets|hey t?here)(!?)(.?)(8?-?\)?)?$</Subject>
<Bodytxt>(\.xyz\/)</Bodytxt>
<Bodytxt>(thisemailwillchangeyourlife)</Bodytxt>
<Bodytxt>(Please sign the contract)</Bodytxt>
</Reject>
<Blacklist>
<X-Envelope-From>^(.*\@.*\.[a-z]{4,})$<!--WILL MATCH ANY 4+ LETTER TLD, USE WITH CAUTION!--></X-Envelope-From>
<X-Envelope-From>^(return\@.*)$</X-Envelope-From>
<X-Envelope-From>^(job\@.*)$</X-Envelope-From>
<X-Envelope-From>^(login@gaijin.net)$</X-Envelope-From>
<X-Envelope-From>^(.*\@.*bitcoin.*)$</X-Envelope-From>
<From>(\<.*\@.*\.[a-z]{4,}\>)$<!--WILL MATCH ANY 4+ LETTER TLD, USE WITH CAUTION!--></From>
<Subject>(Fakta Gavekort)</Subject>
<Subject>(Vi inviterer dig til at tilslutte dig)</Subject>
<Subject>(Dette er ikke en reklame)</Subject>
<Subject>(Blockchain-momentum)</Subject>
<Subject>(du vil finde rigtig meget brugbar information herinde)</Subject>
<Subject>(ringede til dig, men du tog den ikke)</Subject>
<Subject>(Noget helt fantastisk er ved at ske)</Subject>
<Subject>((iPhone)(\x20(3G|4|5|6|SE|7|8|9|X))?(C|S|R)?(\x20(Plus|Max))?)</Subject>
<Bodytxt>(Du har fået denne mail tilsendt angående et jobtilbud)</Bodytxt>
<Bodytxt>(Vi har registreret, at du har et overskydende)</Bodytxt>
<Bodytxt>(I øjeblikket tildeler vi alle nyopstartede brugere)</Bodytxt>
<Bodytxt>(Din konto er i risiko for at blive suspenderet)</Bodytxt>
<Bodytxt>(Vi leder efter en ny person)</Bodytxt>
<Bodytxt>(Leo Vegas er)</Bodytxt>
<Bodytxt>(velkomstbonus til din)</Bodytxt>
<Bodytxt>(beskytte dit kort mod svig)</Bodytxt>
<Bodytxt>(I have a proposal)</Bodytxt>
<Bodytxt>(You are receiving this email because you opted in via our website)</Bodytxt>
<Bodytxt>(Dette er hemmelig information)</Bodytxt>
<Bodytxt>(Denne information er hemmelig og må ikke deles)</Bodytxt>
<Bodytxt>((iPhone)(\x20(3G|4|5|6|SE|7|8|9|X))?(C|S|R)?(\x20(Plus|Max))?)</Bodytxt>
<IPRange>^216\.82\.(2(4[0-9]|5[0-5]))\.([0-9]|[1-9][0-9]|1([0-9][0-9])|2([0-4][0-9]|5[0-5]))$</IPRange>
</Blacklist>
<Whitelist>
<X-Envelope-From>^(bounces\+3390280\-2e2e\-soren\=acme\.inc\@mail\.computerworld\.dk)$</X-Envelope-From>
<X-Envelope-From>^(bounce-mc\.us(\d)_59848553\.[0-9]{7}\-soren\=acme\.inc\@mail(.*))$</X-Envelope-From>
<X-Envelope-From>^(bounce-mc\.us(\d)_26104775\.[0-9]{7}\-jane\=acme\.inc\@mail(.*))$</X-Envelope-From>
<X-Envelope-From>^(bounce-mc\.us(\d)_4390422\.[0-9]{7}\-jane\=acme\.inc\@mail(.*))$</X-Envelope-From>
<X-Envelope-From>^(bounces\+2437332\-cc95\-benjamin\=acme\.inc\@em\.spotify\.com)$</X-Envelope-From>
<X-Envelope-From>^(bounces-633600378734211969\@explore\.pinterest\.com)$</X-Envelope-From>
<X-Envelope-From>^(notification\+)[a-z,0-9,_]{8}(\@facebookmail\.com)$</X-Envelope-From>
<X-Envelope-From>^(transaction\@notice\.aliexpress\.com)$</X-Envelope-From>
<X-Envelope-From>^(tracking-noreply\@webshipr\.com)$</X-Envelope-From>
<X-Envelope-From>^(noreply\@compugroupmedical\.dk)$</X-Envelope-From>
<X-Envelope-From>^(no-reply\@telia\.crm-ts\.com)$</X-Envelope-From>
<X-Envelope-From>^(security\@facebookmail\.com)$</X-Envelope-From>
<X-Envelope-From>^(noreply\@fitnessworld\.com)$</X-Envelope-From>
<X-Envelope-From>^(metin\@srv\.eatonline\.dk)$</X-Envelope-From>
<X-Envelope-From>^(clearpass\@sund\.ku\.dk)$</X-Envelope-From>
<X-Envelope-From>^(mobilprivat\@telia\.dk)$</X-Envelope-From>
<X-Envelope-From>^(bounce\@gjensidige\.no)$</X-Envelope-From>
<X-Envelope-From>^(noreply\@postnord\.dk)$</X-Envelope-From>
<X-Envelope-From>^(info\@email\.dba\.dk)$</X-Envelope-From>
<X-Envelope-From>^(info\@billigvvs\.dk)$</X-Envelope-From>
<X-Envelope-From>(\@(email|insideapple)\.apple\.com)$</X-Envelope-From>
<X-Envelope-From>(\@bounce\.kundemail\.power\.dk)$</X-Envelope-From>
<X-Envelope-From>(\@bloggersdelight\.dk)$</X-Envelope-From>
<X-Envelope-From>(\@hk\.dk)$</X-Envelope-From>
<From>^(Goodreads <no-reply\@mail\.goodreads\.com>)$</From>
<From>^(EasyPark <no-reply\@easypark\.net>)$</From>
<From>(support\@patchingprotocol\.com)</From>
<From>(account-update\@amazon\.com)</From>
<From>(no-reply\@myunidays\.com)</From>
<From>(no_reply\@snapchat\.com)</From>
<From>(help\@epicgames\.com)</From>
<From>(nabohjaelp\@dkr\.dk)</From>
<From>(\@email\.bulkpowders\.com)</From>
<From>(\@id\.apple\.com)</From>
<From>(\@seas-nve\.dk)</From>
<From>(\@yousee\.dk)</From>
</Whitelist>
<Ransomeware>
<Bodytxt>(https://dl.dropboxusercontent.com/s/)</Bodytxt>
<Bodytxt>(https://www.dropbox.com/meta_dl/)</Bodytxt>
</Ransomeware>
</Parameters>SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
Wow this is really awesome stuff. Thank you for sharing all of it! Great job, man!
Re: Hardening hMailServer - The ongoing saga!
One question (for now ). What is the ransomware bit in hMailServer.xml? They appear to be legit URLs.
). What is the ransomware bit in hMailServer.xml? They appear to be legit URLs.Re: Hardening hMailServer - The ongoing saga!
Yes, bad guys use dropbox too
Never caught one though.
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
OK so I finally got around to implementing this stuff. I have basically everything except the IDS stuff. I worked out all my growing pains except for one issue I don't know how to deal with.
Script Error: Source: Microsoft VBScript runtime error - Error: 800A01A8 - Description: Object required: 'oXML' - Line: 315 Column: 3 - Code: (null)"
That corresponds to this:
Any ideas?
I have Function LoadXML(XMLFile) included, and Private Const XMLFile = "hMailServer.xml" also, as well as RvdH's activex thingy installed.
Script Error: Source: Microsoft VBScript runtime error - Error: 800A01A8 - Description: Object required: 'oXML' - Line: 315 Column: 3 - Code: (null)"
That corresponds to this:
Code: Select all
Function LoadXMLNode(oXML, MyNode) : LoadXMLNode = ""
Dim Match, Matches, strTXT
Set Matches = oXML.selectNodes(MyNode) <<<<---------------- LINE 315
strTXT = ""
For Each Match In Matches
strTXT = strTXT & Match.text & "|"
Next
If (Trim(strTXT) <> "") Then
LoadXMLNode = Left(strTXT,Len(strTXT)-1)
Else
EventLog.Write( "ERROR: Empty string from LoadXMLNode(oXML, " & MyNode & ")" )
End If
End Function
I have Function LoadXML(XMLFile) included, and Private Const XMLFile = "hMailServer.xml" also, as well as RvdH's activex thingy installed.
Re: Hardening hMailServer - The ongoing saga!
Code: Select all
Function LoadXML(XMLFile)
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
Dim oXML : Set oXML = CreateObject("MSXML2.DOMDocument") <=== YOU ARE MISSING THIS !!
oXML.Load(oApp.Settings.Directories.EventDirectory & "\" & XMLFile)
If oXML.parseError <> 0 Then
EventLog.Write( "XML ERROR - errorCode - " & oXML.parseError.errorCode ) ' Returns a long integer error code
EventLog.Write( "XML ERROR - reason - " & oXML.parseError.reason ) ' Returns a string explaining the reason for the error
EventLog.Write( "XML ERROR - line - " & oXML.parseError.line ) ' Returns a long integer representing the line number for the error
EventLog.Write( "XML ERROR - linePos - " & oXML.parseError.linePos ) ' Returns a long integer representing the line position for the error
EventLog.Write( "XML ERROR - srcText - " & oXML.parseError.srcText ) ' Returns a string containing the line that caused the error
EventLog.Write( "XML ERROR - url - " & oXML.parseError.url ) ' Returns the url pointing the loaded document
EventLog.Write( "XML ERROR - filePos - " & oXML.parseError.filePos ) ' Returns a long integer file position of the error
End If
Set LoadXML = oXML
End Function
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
Anyways... It has all been slightly changed in the meantime 
My EventHandlers.vbs is not static code for very long. I find other ways to do the same stuff quicker or with less ressources
My EventHandlers.vbs is not static code for very long. I find other ways to do the same stuff quicker or with less ressources
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
Todays flavor
Disclaimer. Not all variables are declared in the sample code....
Function AutoBan is now boolean so that only a successfull ban is True in case of code executing in parallel.
Usage of "On Error" has been minimised to absolute minimum.
Code: Select all
'***** *****
'***** SAMPLE START *****
'***** *****
'
' COM authentication
'
Private Const ADMIN = "Administrator"
Private Const PASSWORD = "very secret!"
'
' Various settings
'
Private Const XMLDATA = "hMailServer.xml"
Private Const EVENTDIR = "C:\hMailServer\Events"
Private Const LOGDIR = "C:\hMailServer\Logs"
Private Const TEMPDIR = "C:\hMailServer\Temp"
'
' Reject HELO
'
strRegEx = GetXMLNode(XMLDATA, "//Reject/HELO")
Set Matches = oLookup(strRegEx, oClient.HELO, False)
For Each Match In Matches
If AutoBan(oClient.IPAddress, "//Reject/HELO/" & Match.Value, 12, "h") Then _
EventLog.Write( LPad("Reject HELO", 15, " ") & vbTab & LPad(oClient.IPAddress, 16, " ") & vbTab & oClient.HELO )
Exit Sub
Next
'***** *****
'***** SAMPLE END *****
'***** *****
Function Wait(sec)
With CreateObject("WScript.Shell")
.Run "timeout /T " & Int(sec), 0, True ' Windows 7/2003/2008 or later
' .Run "sleep -m " & Int(sec * 1000), 0, True ' Windows 2003 Resource Kit
' .Run "powershell Start-Sleep -Milliseconds " & Int(sec * 1000), 0, True
End With
End Function
Function LockFile(strPath)
Const Append = 8
Const Unicode = -1
Dim i
On Error Resume Next
With CreateObject("Scripting.FileSystemObject")
For i = 0 To 30
Err.Clear
Set LockFile = .OpenTextFile(strPath, Append, True, Unicode)
If (Not Err.Number = 70) Then Exit For
Wait(1)
Next
End With
If (Err.Number = 70) Then
EventLog.Write( "ERROR: EventHandlers.vbs" )
EventLog.Write( "File " & strPath & " is locked and timeout was exceeded." )
Err.Clear
ElseIf (Err.Number <> 0) Then
EventLog.Write( "ERROR: EventHandlers.vbs : Function LockFile" )
EventLog.Write( "Error : " & Err.Number )
EventLog.Write( "Error (hex) : 0x" & Hex(Err.Number) )
EventLog.Write( "Source : " & Err.Source )
EventLog.Write( "Description : " & Err.Description )
Err.Clear
End If
On Error Goto 0
End Function
Function AutoBan(sIPAddress, sReason, iDuration, sType) : AutoBan = False
'
' sType can be one of the following;
' "yyyy" Year, "m" Month, "d" Day, "h" Hour, "n" Minute, "s" Second
'
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
With LockFile(TEMPDIR & "\autoban.lck")
On Error Resume Next
Dim oSecurityRange : Set oSecurityRange = oApp.Settings.SecurityRanges.ItemByName("(" & sReason & ") " & sIPAddress)
If Err.Number = 9 Then
With oApp.Settings.SecurityRanges.Add
.Name = "(" & sReason & ") " & sIPAddress
.LowerIP = sIPAddress
.UpperIP = sIPAddress
.Priority = 20
.Expires = True
.ExpiresTime = DateAdd(sType, iDuration, Now())
.Save
End With
AutoBan = True
End If
On Error Goto 0
.Close
End With
Set oApp = Nothing
End Function
Function LPad(str, length, pad)
LPad = Left(CStr(str) & String(length, pad), length)
End Function
Function RPad(str, length, pad)
RPad = Right(String(length, pad) & CStr(str), length)
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 GetXMLNode(XMLFile, MyNode) : GetXMLNode = ""
Dim oXML : Set oXML = CreateObject("MSXML2.DOMDocument")
Dim Match, Matches, strTXT : strTXT = ""
If oXML.Load(EVENTDIR & "\" & XMLFile) Then
Set Matches = oXML.selectNodes(MyNode)
For Each Match In Matches
If (Trim(Match.Text) <> "") Then strTXT = strTXT & Trim(Match.Text) & "|"
Next
If (Trim(strTXT) <> "") Then
GetXMLNode = Left(strTXT,Len(strTXT)-1)
Else
EventLog.Write( "ERROR: Empty string from GetXMLNode(XMLDATA, " & MyNode & ")" )
GetXMLNode = "VOID"
End If
Set Matches = Nothing
Else
EventLog.Write( "Your XML Document " & XMLFile & " failed to load due the following error." & vbCrLf & _
"Error #: " & oXML.ParseError.errorCode & ": " & oXML.ParseError.reason & _
"Line #: " & oXML.ParseError.line & vbCrLf & _
"Line Position: " & oXML.ParseError.linePos & vbCrLf & _
"Position In File: " & oXML.ParseError.filePos & vbCrLf & _
"Source Text: " & oXML.ParseError.srcText & vbCrLf & _
"Document URL: " & oXML.ParseError.url )
End If
Set oXML = Nothing
End Function
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
I just went to copy it in and saw that it was always there. in fact I compared the two and both functions were verbatim the same.SorenR wrote: ↑2019-05-04 20:12Code: Select all
Dim oXML : Set oXML = CreateObject("MSXML2.DOMDocument") <=== YOU ARE MISSING THIS !!
I did find one thing that I assumed was a typo. In the function in your example eventhandlers.vbs above, you have this (same as the one you just posted):
Function LoadXML(XMLFile)
Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMIN, PASSWORD)
Dim oXML : Set oXML = CreateObject("MSXML2.DOMDocument")
oXML.Load(oApp.Settings.Directories.EventDirectory & "\" & XMLFile)
But everywhere else, its referenced as XMLDATA:
Private Const XMLDATA = "hMailServer.xml"
Sub OnHELO(oClient)
Dim oXML : Set oXML = LoadXML(XMLDATA)
Sub OnAcceptMessage(oClient, oMessage)
Dim oXML : Set oXML = LoadXML(XMLDATA)
That gave me an error (forgot exactly what the error was) but it went away when I changed them all to XMLFile. I assumed that was a typo.
Re: Hardening hMailServer - The ongoing saga!
oops. I think I found the error. Somehow this got deleted.
I loaded in your new stuff, fixed the missing dim above and now I'm going to All American Burger with the wife and wee one. I'll check the logs when I get back. Hopefully this fixes the errors.
I have a ton of questions too, but I'll throw them at you after I stop getting errors.
Re: Hardening hMailServer - The ongoing saga!
One more thing - I added this to the top of eventhandlers. Very handy when looking at the logs! 
CODE 01 :: Snowshoe Spam
CODE 02 :: Deny servers with specific HELO/EHLO greetings
CODE 03 :: Invalid HELO/EHLO greeting
CODE 04 :: Reject specific X-Envelope-From
CODE 05 :: Reject specific From addresses
CODE 06 :: Reject specific Subject lines
CODE 07 :: Reject specific text found within message Body
CODE 08 ::
CODE 09 :: Reject specific <List-Unsubscribe> entries
CODE 10 :: Bots using residential ddns
CODE 11 ::
CODE 01 :: Snowshoe Spam
CODE 02 :: Deny servers with specific HELO/EHLO greetings
CODE 03 :: Invalid HELO/EHLO greeting
CODE 04 :: Reject specific X-Envelope-From
CODE 05 :: Reject specific From addresses
CODE 06 :: Reject specific Subject lines
CODE 07 :: Reject specific text found within message Body
CODE 08 ::
CODE 09 :: Reject specific <List-Unsubscribe> entries
CODE 10 :: Bots using residential ddns
CODE 11 ::
Re: Hardening hMailServer - The ongoing saga!
Wow. Incredible decrease in spam. Mostly due to the spamhaus thing. Ever worry about false positives?
No errors in several hours so i think it's all going well.
One sneaky bastard snuck through.
SMTPD – 1717 – 176.58.160.41 ?
2019-05-04 20:29:44.158 RECEIVED: EHLO adsl-41.176.58.160.tellas.gr
Is there a regex for random order?
Also, is helo = ip only ok? I see you let them through. Ther only ones i see that are ip only helo are spam or password guessers or "half connections".
No errors in several hours so i think it's all going well.
One sneaky bastard snuck through.
SMTPD – 1717 – 176.58.160.41 ?
2019-05-04 20:29:44.158 RECEIVED: EHLO adsl-41.176.58.160.tellas.gr
Is there a regex for random order?
Also, is helo = ip only ok? I see you let them through. Ther only ones i see that are ip only helo are spam or password guessers or "half connections".
Re: Hardening hMailServer - The ongoing saga!
the helo check is RFC compliant and it's not "just" an IP, it has to be [ip] in square brackets. if you want to be completely anal then oclient.ipaddress must match ip address in oclient.helo 
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
I'm using this (another of yours ) to check for residential IPs/bots.
It didn't work on the example I posted above because the IP address was randomized in the domain:
IP = 176.58.160.41
HELO = adsl-41.176.58.160.tellas.gr
This appears to me to be a residential or business hostname that a bot is using to present a bonafide looking HELO. I have a test script to randomize using OR but I can't make it work. I'm getting "type mismatch", error message is this:
Type Mismatch: '[string: "(176"]'
What am I doing wrong?
) to check for residential IPs/bots.Code: Select all
' Filter bots using residential ddns
Dim a, b(3), i
a = Split(oClient.IPAddress, ".")
For i = 0 to 3
b(i) = Right("00" & a(i),3)
Next
strRegEx = "(" & a(0) & "-" & a(1) & "-" & a(2) & "-" & a(3) & ")|" &_
"(" & b(0) & "-" & b(1) & "-" & b(2) & "-" & b(3) & ")|" &_
"(" & a(3) & "-" & a(2) & "-" & a(1) & "-" & a(0) & ")|" &_
"(" & b(3) & "-" & b(2) & "-" & b(1) & "-" & b(0) & ")|" &_
"(" & a(0) & "." & a(1) & "." & a(2) & "." & a(3) & ")|" &_
"(" & b(0) & "." & b(1) & "." & b(2) & "." & b(3) & ")|" &_
"(" & a(3) & "." & a(2) & "." & a(1) & "." & a(0) & ")|" &_
"(" & b(3) & "." & b(2) & "." & b(1) & "." & b(0) & ")"
If Lookup(strRegEx, oClient.HELO) Then
Result.Value = 2
Result.Message = "530 CODE10 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, "Residential IP - " & oClient.HELO, 7, "d")
End If
IP = 176.58.160.41
HELO = adsl-41.176.58.160.tellas.gr
This appears to me to be a residential or business hostname that a bot is using to present a bonafide looking HELO. I have a test script to randomize using OR but I can't make it work. I'm getting "type mismatch", error message is this:
Type Mismatch: '[string: "(176"]'
Code: Select all
strRegEx = "(" & a(0) OR a(1) OR a(2) OR a(3) & ") "-" " &_
"(" & a(0) OR a(1) OR a(2) OR a(3) & ") "-" " &_
"(" & a(0) OR a(1) OR a(2) OR a(3) & ") "-" " &_
"(" & a(0) OR a(1) OR a(2) OR a(3) & ")"
Re: Hardening hMailServer - The ongoing saga!
Got it.
Code: Select all
strRegEx = "((" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")-" &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")-" &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")-" &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & "))|" &_
"((" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")." &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")." &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")." &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & "))"
Re: Hardening hMailServer - The ongoing saga!
OK, now that everything is running smoothly, I have a couple of questions.
I don't understand this one.
Also, for this:
What kind of variable are you using there? An unsubscribe address? There was no entry for it in your sample xml file.
By the way, not a single spam made it through today where I was getting around 20/day before. SA does a good job processing them - users didn't receive spam, but my server did. Now, spam isn't even getting received.
I don't understand this one.
Code: Select all
OnAcceptMessage
' Banned sender via Backup-MX ?
If (Left(oClient.IPAddress, 10) = "80.160.77.") Then
If isBanned(oMessage) Then
Result.Value = 2
Result.Message = "5.7.1 CODE08 The SMTP service on IP address (" & oMessage.HeaderValue("X-Envelope-IPAddress") & ") is not welcome here."
Exit Sub
End If
End If
Code: Select all
' Reject "List-Unsubscribe:"
strRegEx = LoadXMLNode(oXML, "//Reject/List-Unsubscribe")
By the way, not a single spam made it through today where I was getting around 20/day before. SA does a good job processing them - users didn't receive spam, but my server did. Now, spam isn't even getting received.
Re: Hardening hMailServer - The ongoing saga!
If you are not using a Backup-MX forget that section. I use a Backup-MX and when I ban servers they try via my Backup-MX service (which I don't control) and so I made a function to extract originating server and check if banned.palinka wrote: ↑2019-05-05 20:40OK, now that everything is running smoothly, I have a couple of questions.
I don't understand this one.
Also, for this:Code: Select all
OnAcceptMessage ' Banned sender via Backup-MX ? If (Left(oClient.IPAddress, 10) = "80.160.77.") Then If isBanned(oMessage) Then Result.Value = 2 Result.Message = "5.7.1 CODE08 The SMTP service on IP address (" & oMessage.HeaderValue("X-Envelope-IPAddress") & ") is not welcome here." Exit Sub End If End If
What kind of variable are you using there? An unsubscribe address? There was no entry for it in your sample xml file.Code: Select all
' Reject "List-Unsubscribe:" strRegEx = LoadXMLNode(oXML, "//Reject/List-Unsubscribe")
By the way, not a single spam made it through today where I was getting around 20/day before. SA does a good job processing them - users didn't receive spam, but my server did. Now, spam isn't even getting received.
The "List-Unsubscribe" is one that is haunting me and have been doing for a long time. It's the only true identifier I can find in all these particular SPAM messages so that's it.
Use with caution, you might catch some HAM with it
Code: Select all
<List-Unsubscribe>(\<http(s?):\/\/(.*)\/unsubscribe\.php\?M=(.*)&C=(.*)&L=(.*)&N=(.*)\>)</List-Unsubscribe>SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
OK thanks. I do have a backup-mx service and in fact there is something strange going on with it that I don't recall seeing before.
Code: Select all
"DEBUG" 11620 "2019-05-05 13:42:46.896" "Creating session 1397"
"TCPIP" 11620 "2019-05-05 13:42:48.192" "TCP - 184.105.182.145 connected to 192.168.1.2:25."
"DEBUG" 11620 "2019-05-05 13:42:48.192" "Executing event OnClientConnect"
"DEBUG" 11620 "2019-05-05 13:42:48.224" "Event completed"
"DEBUG" 11620 "2019-05-05 13:42:48.224" "TCP connection started for session 1397"
"SMTPD" 11620 1397 "2019-05-05 13:42:48.224" "184.105.182.145" "SENT: 220 mydomain.tld"
"SMTPD" 8356 1397 "2019-05-05 13:42:48.302" "184.105.182.145" "RECEIVED: EHLO 145-he.filtered.junkemailfilter.com"
"DEBUG" 8356 "2019-05-05 13:42:48.302" "Executing event OnHELO"
"DEBUG" 8356 "2019-05-05 13:42:48.317" "Event completed"
"SMTPD" 8356 1397 "2019-05-05 13:42:48.333" "184.105.182.145" "SENT: 250-mydomain.tld[nl]250-SIZE 20480000[nl]250-STARTTLS[nl]250 HELP"
"SMTPD" 11620 1397 "2019-05-05 13:42:48.396" "184.105.182.145" "RECEIVED: STARTTLS"
"SMTPD" 11620 1397 "2019-05-05 13:42:48.396" "184.105.182.145" "SENT: 220 Ready to start TLS"
"DEBUG" 8356 "2019-05-05 13:42:48.396" "Performing SSL/TLS handshake for session 1397. Verify certificate: False"
"TCPIP" 8356 "2019-05-05 13:42:48.583" "TCPConnection - TLS/SSL handshake completed. Session Id: 1397, Remote IP: 184.105.182.145, Version: TLSv1.2, Cipher: ECDHE-RSA-AES256-GCM-SHA384, Bits: 256"
"SMTPD" 8356 1397 "2019-05-05 13:42:48.646" "184.105.182.145" "RECEIVED: EHLO 145-he.filtered.junkemailfilter.com"
"DEBUG" 8356 "2019-05-05 13:42:48.646" "Executing event OnHELO"
"DEBUG" 8356 "2019-05-05 13:42:48.677" "Event completed"
"SMTPD" 8356 1397 "2019-05-05 13:42:48.677" "184.105.182.145" "SENT: 250-mydomain.tld[nl]250-SIZE 20480000[nl]250 HELP"
"SMTPD" 8356 1397 "2019-05-05 13:42:48.755" "184.105.182.145" "RECEIVED: MAIL FROM:<fabianmdbnypbbeck@bmunboxing.icu>"
"TCPIP" 8356 "2019-05-05 13:42:48.786" "DNS lookup: 145.182.105.184.zen.spamhaus.org, 0 addresses found: (none), Match: False"
"TCPIP" 8356 "2019-05-05 13:42:48.880" "DNS lookup: 145.182.105.184.bl.spamcop.net, 0 addresses found: (none), Match: False"
"DEBUG" 8356 "2019-05-05 13:42:48.880" "Spam test: SpamTestDNSBlackLists, Score: 0"
"DEBUG" 8356 "2019-05-05 13:42:48.958" "Spam test: SpamTestHeloHost, Score: 0"
"DEBUG" 8356 "2019-05-05 13:42:49.161" "Spam test: SpamTestMXRecords, Score: 0"
"DEBUG" 8356 "2019-05-05 13:42:49.599" "Spam test: SpamTestSPF, Score: 0"
"DEBUG" 8356 "2019-05-05 13:42:49.599" "Total spam score: 0"
"SMTPD" 8356 1397 "2019-05-05 13:42:49.614" "184.105.182.145" "SENT: 250 OK"
"SMTPD" 11620 1397 "2019-05-05 13:42:49.677" "184.105.182.145" "RECEIVED: RCPT TO:<barb@mydomain.tld>"
"SMTPD" 11620 1397 "2019-05-05 13:42:49.692" "184.105.182.145" "SENT: 250 OK"
"SMTPD" 7288 1397 "2019-05-05 13:42:49.755" "184.105.182.145" "RECEIVED: QUIT"
"DEBUG" 7288 "2019-05-05 13:42:49.755" "Deleting message file."
"SMTPD" 7288 1397 "2019-05-05 13:42:49.755" "184.105.182.145" "SENT: 221 goodbye"
"DEBUG" 8356 "2019-05-05 13:42:49.755" "Ending session 1397"
I'm pretty sure this has nothing to do whatsoever with the changes I made over the last few days or hmailserver at all, but what do you think?
Re: Hardening hMailServer - The ongoing saga!
Gonna need some help with this one.
"ERROR" 4544 "2019-05-05 22:28:49.718" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A01C2 - Description: Wrong number of arguments or invalid property assignment: 'GetXMLNode' - Line: 583 Column: 14 - Code: (null)"
"ERROR" 2736 "2019-05-05 22:28:50.608" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A01C2 - Description: Wrong number of arguments or invalid property assignment: 'GetXMLNode' - Line: 667 Column: 14 - Code: (null)"
Code: Select all
Private Const XMLDATA = "hMailServer.xml"Code: Select all
Function GetXMLNode(XMLDATA, MyNode) : GetXMLNode = ""
Dim oXML : Set oXML = CreateObject("MSXML2.DOMDocument")
Dim Match, Matches, strTXT : strTXT = ""
If oXML.Load(EVENTDIR & "\" & XMLDATA) Then
Set Matches = oXML.selectNodes(MyNode)
For Each Match In Matches
If (Trim(Match.Text) <> "") Then strTXT = strTXT & Trim(Match.Text) & "|"
Next
If (Trim(strTXT) <> "") Then
GetXMLNode = Left(strTXT,Len(strTXT)-1)
Else
EventLog.Write( "ERROR: Empty string from GetXMLNode(XMLDATA, " & MyNode & ")" )
GetXMLNode = "VOID"
End If
Set Matches = Nothing
Else
EventLog.Write( "Your XML Document " & XMLDATA & " failed to load due the following error." & vbCrLf & _
"Error #: " & oXML.ParseError.errorCode & ": " & oXML.ParseError.reason & _
"Line #: " & oXML.ParseError.line & vbCrLf & _
"Line Position: " & oXML.ParseError.linePos & vbCrLf & _
"Position In File: " & oXML.ParseError.filePos & vbCrLf & _
"Source Text: " & oXML.ParseError.srcText & vbCrLf & _
"Document URL: " & oXML.ParseError.url )
End If
Set oXML = Nothing
End Function
Code: Select all
Sub OnHELO(oClient)
Dim oXML : Set oXML = GetXMLNode(XMLDATA)
Code: Select all
strRegEx = GetXMLNode(XMLDATA, "//Reject/HELO")
Set Matches = oLookup(strRegEx, oClient.HELO, False)
For Each Match In Matches
If AutoBan(oClient.IPAddress, "//Reject/HELO/" & Match.Value, 12, "h") Then _
EventLog.Write( LPad("Reject HELO", 15, " ") & vbTab & LPad(oClient.IPAddress, 16, " ") & vbTab & oClient.HELO )
Exit Sub
Next
Code: Select all
Sub OnAcceptMessage(oClient, oMessage)
Dim oXML : Set oXML = GetXMLNode(XMLDATA)
Re: Hardening hMailServer - The ongoing saga!
No longer needed. When you remove "Dim oXML : Set oXML = LoadXML(XMLDATA)" also remove "Set oXML = Nothing" or you will get another error.palinka wrote: ↑2019-05-06 04:41Line 583 is Dim...
Line 667 is the Dim...Code: Select all
Sub OnHELO(oClient) Dim oXML : Set oXML = LoadXML(XMLDATA)
Code: Select all
Sub OnAcceptMessage(oClient, oMessage) Dim oXML : Set oXML = LoadXML(XMLDATA)
Old code:
Code: Select all
Sub OnSomeEvent(oClient)
Dim oXML : Set oXML = LoadXML(XMLDATA)
Dim strRegEx, Match, Matches
'
' Reject HELO
'
strRegEx = LoadXMLNode(oXML, "//Reject/HELO")
Set Matches = oLookup(strRegEx, oClient.HELO, False)
For Each Match In Matches
EventLog.Write( LPad("Reject HELO", 15, " ") & vbTab & oClient.IPAddress )
Call AutoBan(oClient.IPAddress, "//Reject/HELO/" & Match.Value, 12, "h")
Set oXML = Nothing
Exit Sub
Next
End Sub
Code: Select all
Sub OnSomeEvent(oClient)
Dim strRegEx, Match, Matches
'
' Reject HELO
'
strRegEx = GetXMLNode(XMLDATA, "//Reject/HELO")
Set Matches = oLookup(strRegEx, oClient.HELO, False)
For Each Match In Matches
EventLog.Write( LPad("Reject HELO", 15, " ") & vbTab & oClient.IPAddress )
Call AutoBan(oClient.IPAddress, "//Reject/HELO/" & Match.Value, 12, "h")
Exit Sub
Next
End Sub
Code: Select all
Call AutoBan(oClient.IPAddress, "Scum of the earth " & Match.Value, 12, "h")
Code: Select all
If AutoBan(oClient.IPAddress, "Scum of the earth " & Match.Value, 12, "h") Then
EventLog.Write( "Successful ban, wohoo!" )
Else
EventLog.Write( "Ban exists, Another thread/session got there before me" )
End If
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
Awesome! Thanks, man!
One question - I successfully banned google during testing (using //Reject/Subject).
I removed the autoban from IP Ranges, but now its in the ban db, I think. What will happen on next connect? Obviously, I don't want to block google no matter how evil they are... 
Too many friendly connections to blast away like this:
YOU'VE BEEN TERMINATED!
One question - I successfully banned google during testing (using //Reject/Subject).
I removed the autoban from IP Ranges, but now its in the ban db, I think. What will happen on next connect? Obviously, I don't want to block google no matter how evil they are... Too many friendly connections to blast away like this:YOU'VE BEEN TERMINATED!
Re: Hardening hMailServer - The ongoing saga!
One more thing. To give back in the tiny way that I can, I have (more) perfected the search string for bots on residential FQDN.
As far as I'm concerned, HELO = IP is spam even if its presented in brackets per the "code".
Code: Select all
' Filter bots using residential FQDN
Dim a, b(3), i
a = Split(oClient.IPAddress, ".")
For i = 0 to 3
b(i) = Right("00" & a(i),3)
Next
strRegEx = "((" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & "|" & b(0) & "|" & b(1) & "|" & b(2) & "|" & b(3) & ")(-|\.)" &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & "|" & b(0) & "|" & b(1) & "|" & b(2) & "|" & b(3) & ")(-|\.)" &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & "|" & b(0) & "|" & b(1) & "|" & b(2) & "|" & b(3) & ")(-|\.)" &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & "|" & b(0) & "|" & b(1) & "|" & b(2) & "|" & b(3) & "))"
If Lookup(strRegEx, oClient.HELO) Then
Result.Value = 2
Result.Message = "530 CODE10 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, "BOT using Res FQDN - " & oClient.HELO, 7, "d")
End If
Re: Hardening hMailServer - The ongoing saga!
The HELO check for [IPv4], [IPv6] or FQDN is to satisfy RFC, not anti-SPAM. It will however filter out various bots using malformed FQDN or simple IP greetings.
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
-
Gordonh1970
- Normal user
- Posts: 42
- Joined: 2016-01-29 13:50
- Location: UK
- Contact:
Re: Hardening hMailServer - The ongoing saga!
SorenR
Thank you for posting this, I'm very interested in trying it out
Unfortunately, with all the discussions that have gone on in the thread I can't work out what the latest EventHandler.vbs and Handler.vbs is (I'm really only interested in bloacking the failed login attempts at the mopment)
There's lots of other bits of code in the ongoing discussion but they're not labelled as to which file they refer to
If you can post the latest EventHandler.vbs and Handler.vbs and mention any dependancies (I'm assuming that MySQL ODBC is a dependancy) then it would be very much appreciated
Thank you for posting this, I'm very interested in trying it out
Unfortunately, with all the discussions that have gone on in the thread I can't work out what the latest EventHandler.vbs and Handler.vbs is (I'm really only interested in bloacking the failed login attempts at the mopment)
There's lots of other bits of code in the ongoing discussion but they're not labelled as to which file they refer to
If you can post the latest EventHandler.vbs and Handler.vbs and mention any dependancies (I'm assuming that MySQL ODBC is a dependancy) then it would be very much appreciated
Re: Hardening hMailServer - The ongoing saga!
Failed logins are handled by hMailServer directly, not by scripting.Gordonh1970 wrote: ↑2019-05-11 21:21SorenR
Thank you for posting this, I'm very interested in trying it out
Unfortunately, with all the discussions that have gone on in the thread I can't work out what the latest EventHandler.vbs and Handler.vbs is (I'm really only interested in bloacking the failed login attempts at the mopment)
There's lots of other bits of code in the ongoing discussion but they're not labelled as to which file they refer to
If you can post the latest EventHandler.vbs and Handler.vbs and mention any dependancies (I'm assuming that MySQL ODBC is a dependancy) then it would be very much appreciated
https://www.hmailserver.com/documentati ... ce_autoban
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
FYI - running Handler.vbs from task manager will "wake up" hmailserver service. I found that from running Jimi's backup script which shuts down hmailserver service during the backup. Something was turning on the service before the backup completed. I finally nailed it down to Handler.vbs running every minute from win task scheduler. All good now. I set it up to not run at the time the backup runs, then resume shortly after.
Re: Hardening hMailServer - The ongoing saga!
I knew that... I have a "CheckState" job running every 5 minutes for that specific reason ...palinka wrote: ↑2019-05-12 14:31FYI - running Handler.vbs from task manager will "wake up" hmailserver service. I found that from running Jimi's backup script which shuts down hmailserver service during the backup. Something was turning on the service before the backup completed. I finally nailed it down to Handler.vbs running every minute from win task scheduler. All good now. I set it up to not run at the time the backup runs, then resume shortly after.
Code: Select all
If oApp.ServerState = 1 Then
If (FSO.FolderExists(oApp.Settings.Backup.Destination & "\DataBackup")) Then
EventLog.Write("CheckState: Server is currently doing backup...")
Else
EventLog.Write("CheckState: Server was stopped for no reason, starting...")
Call oApp.Start
End If
End If
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
I do it in powershell.SorenR wrote: ↑2019-05-12 17:45I knew that... I have a "CheckState" job running every 5 minutes for that specific reason ...palinka wrote: ↑2019-05-12 14:31FYI - running Handler.vbs from task manager will "wake up" hmailserver service. I found that from running Jimi's backup script which shuts down hmailserver service during the backup. Something was turning on the service before the backup completed. I finally nailed it down to Handler.vbs running every minute from win task scheduler. All good now. I set it up to not run at the time the backup runs, then resume shortly after.
Code: Select all
If oApp.ServerState = 1 Then If (FSO.FolderExists(oApp.Settings.Backup.Destination & "\DataBackup")) Then EventLog.Write("CheckState: Server is currently doing backup...") Else EventLog.Write("CheckState: Server was stopped for no reason, starting...") Call oApp.Start End If End If
Code: Select all
$ErrorActionPreference = 'silentlycontinue'
$command = "cmd /C cscript C:\scripts\hmailserver\Handlers.vbs"
$StartTime = (Get-Date 00:30)
$EndTime = (Get-Date 23:45)
$Now = Get-Date
if ($Now -gt $EndTime){exit}
elseif ($Now -lt $StartTime){exit}
else {
invoke-expression $command
Start-Sleep -seconds 60
invoke-expression $command
Start-Sleep -seconds 60
invoke-expression $command
Start-Sleep -seconds 60
invoke-expression $command
}Re: Hardening hMailServer - The ongoing saga!
I have a question. I have lots of autoban entries like this: (GEOBLOCK - IMAPS) 185.100.87.245. I assume this gets called from handlers.vbs because I am not calling autoban from OnClientConnect > geoip lookup. What does "geoblock" mean, exactly? Is it actually blocking by geoIP? If it is, how are the countries specified? I'm using an older version of your geoIP lookup (OnClientConnect) that I modified. I just want to make sure I'm not accidentally blocking the wrong countries. Thanks.SorenR wrote: ↑2019-05-06 11:59Also notice that with the new Bolean AutoBan code you can
or you canCode: Select all
Call AutoBan(oClient.IPAddress, "Scum of the earth " & Match.Value, 12, "h")
The second instance happens if connecting server send a flood of connects. If an active connection exists, it cannot be terminated with autoban until service is returned to core code and issues a "Result.Value = 1" or higher.Code: Select all
If AutoBan(oClient.IPAddress, "Scum of the earth " & Match.Value, 12, "h") Then EventLog.Write( "Successful ban, wohoo!" ) Else EventLog.Write( "Ban exists, Another thread/session got there before me" ) End If
Re: Hardening hMailServer - The ongoing saga!
By the way, here is my modified version of your old geoip lookup. I split it between port 25 and all others. I expect mail from lots of different places, but nobody should be connecting to imap or pop from anywhere but home. I would block imap and pop on the internet range completely except I have one single user that connects via imap and another one that uses a gmail account to pop download mail. Everyone else either uses webmail or horde activesync, which both come across on the localhost.
I just now added the autoban. I'll keep an eye on it for the gmail pop connections. I don't think they connect from anywhere but silly-con valley.
OnClientConnect:
I just now added the autoban. I'll keep an eye on it for the gmail pop connections. I don't think they connect from anywhere but silly-con valley.
OnClientConnect:
Code: Select all
' GEOIP Lookup
Dim ReturnCode, Json, oGeoip, oXML, strPort, strBase
strPort = Trim(Mid("SMTP POP IMAP SMTPSSUBM IMAPSPOPS ", InStr("25 110 143 465 587 993 995 ", oClient.Port), 5))
Set Json = New VbsJson
On Error Resume Next
Set oXML = CreateObject ("Msxml2.XMLHTTP.3.0")
oXML.Open "GET", "http://ip-api.com/json/" & oClient.IPAddress, False
oXML.Send
Set oGeoip = Json.Decode(oXML.responseText)
ReturnCode = oXML.Status
On Error Goto 0
If (ReturnCode <> 200 ) Then
EventLog.Write("<OnClientConnect.error> ip-api.com lookup failed, error code: " & ReturnCode & " on IP address " & oClient.IPAddress)
Exit Sub
End If
' ALLOWED COUNTRIES - Port 25 only... Check Alpha-2 Code here -> https://en.wikipedia.org/wiki/ISO_3166-1
If (oClient.Port = 25) Then
strBase = "^(US|CA|AT|BE|DE|DK|ES|FR|GB|GL|GR|HU|IE|IS|IT|LI|NL|NO|PL|PT|RO|SE|SI|SK|AU|NZ)$"
If Lookup(strBase, oGeoip("countryCode")) Then
EventLog.Write(strPort & " Connection accepted" & Chr(34) & vbTab & oClient.IPAddress & vbTab & Chr(34) & oGeoip("countryCode") & Chr(34) & vbTab & Chr(34) & oGeoip("country"))
Exit Sub
End If
' Disconnect all others connecting to port 25.
Call idsAddIP(oClient.IPAddress, oClient.Port)
Result.Value = 1
Call AutoBan(oClient.IPAddress, "GeoIP - " & oClient.IpAddress, 7, "d")
EventLog.Write(strPort & " Connection REJECTED" & Chr(34) & vbTab & oClient.IPAddress & vbTab & Chr(34) & oGeoip("countryCode") & Chr(34) & vbTab & Chr(34) & oGeoip("country"))
Exit Sub
Else
' ALLOWED COUNTRIES - All ports except 25... Check Alpha-2 Code here -> https://en.wikipedia.org/wiki/ISO_3166-1
strBase = "^(US)$"
If Lookup(strBase, oGeoip("countryCode")) Then
EventLog.Write(strPort & " Connection accepted" & Chr(34) & vbTab & oClient.IPAddress & vbTab & Chr(34) & oGeoip("countryCode") & Chr(34) & vbTab & Chr(34) & oGeoip("country"))
Exit Sub
End If
' Disconnect all others connecting to any port except 25.
Call idsAddIP(oClient.IPAddress, oClient.Port)
Result.Value = 1
Call AutoBan(oClient.IPAddress, "GeoIP - " & oClient.IpAddress, 7, "d")
EventLog.Write(strPort & " Connection REJECTED" & Chr(34) & vbTab & oClient.IPAddress & vbTab & Chr(34) & oGeoip("countryCode") & Chr(34) & vbTab & Chr(34) & oGeoip("country"))
Exit Sub
End If
Re: Hardening hMailServer - The ongoing saga!
Code: Select all
' Disconnect all others connecting to port 25.
Call idsAddIP(oClient.IPAddress, oClient.Port)
Result.Value = 1
Call AutoBan(oClient.IPAddress, "GeoIP - " & oClient.IpAddress, 7, "d")
EventLog.Write(strPort & " Connection REJECTED" & Chr(34) & vbTab & oClient.IPAddress & vbTab & Chr(34) & oGeoip("countryCode") & Chr(34) & vbTab & Chr(34) & oGeoip("country"))
Exit SubInsert information into the DB for handler.vbs to deal with... oClient.Port tell handler.vbs this is a GEOip block...
Call AutoBan(oClient.IPAddress, "GeoIP - " & oClient.IpAddress, 7, "d")
Why ?? This should be done by handler.vbs UNLESS you disabled the code in handler.vbs. (*NOTE)
(*NOTE) Actually I have changed my code so Call idsAddIP is ONLY used for IDS and NOT GEOip blocking thus the line "Call idsAddIP(oClient.IPAddress, oClient.Port)" should go and the line "Call AutoBan(oClient.IPAddress, "GeoIP - " & oClient.IpAddress, 7, "d")" should stay.
Perhaps I should post the latest version but I'm a bit crippled atm. The Power circuit on my "work pc" mainboard died (Dell D610) and the only other machine I have spare is a Acer Aspire 5552 with an AMD Athlon II and 16:9. Prognosis is good, I got my old 32 bit XP SP3 back up running with a million new drivers... The challenge is doing the swap without doing a clean install - I have so much crap on this system that it would take a month if I can find all the software in my archive or online.
Fortunately I did a mirror backup of the harddrive only a few days ago... Intel Pentium M -> AMD Dual core. IDE -> SATA and XP don't like SATA. It runs, I got internet, office works (sort of - keeps asking for activation), Internet Explorer don't so something is F'd...
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
Did you drag that thing out of a time capsule or something? Those antiques might be worth something today if you throw a couple of kroner inside the case. LOL
I think my ProTools mixing station in 2000 was on an Athlon based box running windows 98. It must have been the original Athlon in that year. It was rockin' back then. Blew the macs away on every measurement. Of course, back then macs were running motorola chips which were not getting any attention after suddenly motorola discovered it could make 100 times more on cell phones than cpu's for a niche market.
Re: Hardening hMailServer - The ongoing saga!
It has to match the other old stuff I have...palinka wrote: ↑2019-05-21 18:03Did you drag that thing out of a time capsule or something? Those antiques might be worth something today if you throw a couple of kroner inside the case. LOL
I think my ProTools mixing station in 2000 was on an Athlon based box running windows 98. It must have been the original Athlon in that year. It was rockin' back then. Blew the macs away on every measurement. Of course, back then macs were running motorola chips which were not getting any attention after suddenly motorola discovered it could make 100 times more on cell phones than cpu's for a niche market.
Ferguson (lawn mover) - 1952
House & "toolshed" - 1967
Audi Quattro (urquattro) - 1982
Golf Cabriolet (Etienne Aigner edition) 1990
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
Nice mower. Do you bale it? Or stack it like the old days?
Re: Hardening hMailServer - The ongoing saga!
I'm hosting horses for a friend from time to time so 6 of the 12 acres I don't have to touch, the rest is kept short.
Working the wood chipper clearing up years of dead wood. I've owned the place since 2005 and last year we moved up here for good. We have all sorts of birds, ducks and cranes in the pond. Been feeding a couple of Pheasants all winter and a red tailed woodpecker, deer, a red fox, several birds of pray and a Sea Eagle family <-- That is a bloody big bird!
Dog (German Pointer bitch) saved one of the Pheasants from the Fox the other day.
So that is why, sometimes, I don't respond promptly on forum... Either outside working or just staring out the window looking at nature
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
Beautiful. Looks like an awesome place to live.
Re: Hardening hMailServer - The ongoing saga!
By the way, after implementing your event handlers, i went from 20 to 30 spam per day to 1 to 3. Very nice! When i get some time, I'll try to figure out how to knock that down even further. There's a pattern I've noticed for spam addresses that make it through is "Somefirstname <DifferentfirstnameLastname@bogusdomain.tld>". The capital letters for first and last name with no digits, dashes or dots PLUS the different name than the email are a dead giveaway. A pattern easily recognized by human eyes. Now i have to figure out how to regex that.
Re: Hardening hMailServer - The ongoing saga!
Look at all the headers. I look for oMessage.FromAddress since this is the actual email sender and sometimes also oMessage.From for known spammers but mostly to whitelist contact(s).palinka wrote: ↑2019-05-22 01:35By the way, after implementing your event handlers, i went from 20 to 30 spam per day to 1 to 3. Very nice! When i get some time, I'll try to figure out how to knock that down even further. There's a pattern I've noticed for spam addresses that make it through is "Somefirstname <DifferentfirstnameLastname@bogusdomain.tld>". The capital letters for first and last name with no digits, dashes or dots PLUS the different name than the email are a dead giveaway. A pattern easily recognized by human eyes. Now i have to figure out how to regex that.
It will be very difficult to target "FirstnameLastname" as you are bound to catch some innocent victims.
Check headers, use EventLog.Write to write out specific headers so you can look for commonalities that will identify SPAM... Sometimes it takes 1 week but most often longer to figure out the similarities. It took me almost 3 weeks until I figured out that a specific "List-Unsubscribe" template could catch spammers. It all depend on the software they use.
SørenR.
You know he’s a coder when his first 3D print is "hello world"
You know he’s a coder when his first 3D print is "hello world"
Re: Hardening hMailServer - The ongoing saga!
I've been monitoring this (receiving notifications on a hit, but taking no action) and I'm getting nothing but VictoriasSecret and a couple other hams. No worky.
However, I further tweaked the IP as HELO.
Code: Select all
' Filter bots using residential FQDN
Dim a, i
a = Split(oClient.IPAddress, ".")
For i = 0 to 3
Next
strRegEx = "((" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")(.+)" &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")(.+)" &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")(.+)" &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & "))"
If Lookup(strRegEx, oClient.HELO) Then
Result.Value = 2
Result.Message = "530 CODE10 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."
EventLog.Write( LPad("Bot on Res FQDN", 15, " ") & vbTab & oClient.IPAddress )
End If
IPAddress = "193.126.23.235"
HELO = "193-126-23-235.static.optimus.net.pt"
IPAddress = "85.57.145.95"
HELO = "95.pool85-57-145.dynamic.orange.es"
IPAddress = "83.59.97.107"
HELO = "107.red-83-59-97.dynamicip.rima-tde.net"
Even when the IP numbers are out of order or have other crud mixed between they get picked up. Does NOT hit if any of the IP numbers are different than the ones in HELO. Positive matches must contain all of the IP numbers.
Re: Hardening hMailServer - The ongoing saga!
That also matches:
IPAddress = "193.126.23.235"
HELO = "[193.126.23.235]"
Which is allowed, see RFC2821 4.1.3
But i think this will do to filter out ip4 and ip6 adresses between brackets
IPAddress = "193.126.23.235"
HELO = "[193.126.23.235]"
Which is allowed, see RFC2821 4.1.3
But i think this will do to filter out ip4 and ip6 adresses between brackets
Code: Select all
strRegEx="^(?!(?:\[)(?:(?:ipv6.+)|(?:[0-9]{1,3}[.-]){3}[0-9]{1,3})(?:\])$)" &_
"((" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")(.+)" &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")(.+)" &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")(.+)" &_
"(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & "))"
CIDR to RegEx: d-fault.nl/cidrtoregex
DNS Lookup: d-fault.nl/dnstools
DKIM Generator: d-fault.nl/dkimgenerator
DNSBL Lookup: d-fault.nl/dnsbllookup
GEOIP Lookup: d-fault.nl/geoiplookup
DNS Lookup: d-fault.nl/dnstools
DKIM Generator: d-fault.nl/dkimgenerator
DNSBL Lookup: d-fault.nl/dnsbllookup
GEOIP Lookup: d-fault.nl/geoiplookup
Re: Hardening hMailServer - The ongoing saga!
Good stuff. Thanks!RvdH wrote: ↑2019-06-01 00:31That also matches:
IPAddress = "193.126.23.235"
HELO = "[193.126.23.235]"
Which is allowed, see RFC2821 4.1.3
But i think this will do to filter out ip4 and ip6 adresses between bracketsCode: Select all
strRegEx="^(?!(?:\[)(?:(?:ipv6.+)|(?:[0-9]{1,3}[.-]){3}[0-9]{1,3})(?:\])$)" &_ "((" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")(.+)" &_ "(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")(.+)" &_ "(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & ")(.+)" &_ "(" & a(0) & "|" & a(1) & "|" & a(2) & "|" & a(3) & "))"
Re: Hardening hMailServer - The ongoing saga!
And it can shortened...ps i have seen cases ip adresses are zero prefixed (see example 107.red-083-059-097.dynamicip.rima-tde.net), my final regexp would look something like:
Code: Select all
strRegEx = "^(?!(?:\[)(?:(?:ipv6.+)|(?:[0-9]{1,3}[.-]){3}[0-9]{1,3})(?:\]))" &_
"(.*(((?:[0]{0,2})" & a(0) & "|(?:[0]{0,2})" & a(1) & "|(?:[0]{0,2})" & a(2) & "|(?:[0]{0,2})" & a(3) & ")(?:.+)){3}" &_
"((?:[0]{0,2})" & a(0) & "|(?:[0]{0,2})" & a(1) & "|(?:[0]{0,2})" & a(2) & "|(?:[0]{0,2})" & a(3) & ").+)$"
Code: Select all
Dim arr(9,1) ' Which has 9 rows and 2 columns
arr(0,0) = "193.126.23.235"
arr(0,1) = "193-126-23-235.static.optimus.net.pt"
arr(1,0) = "85.57.145.95"
arr(1,1) = "95.pool85-57-145.dynamic.orange.es"
arr(2,0) = "83.59.97.107"
arr(2,1) = "107.red-83-59-97.dynamicip.rima-tde.net"
arr(3,0) = "31.168.210.62"
arr(3,1) = "bzq-210-168-31-62.red.bezeqint.net"
arr(9,0) = "193.126.23.235"
arr(9,1) = "193.126.23.235"
arr(4,0) = "85.57.145.95"
arr(4,1) = "pool95.85-57-145.dynamic.orange.es"
arr(5,0) = "83.59.97.107"
arr(5,1) = "107.red-083-059-097.dynamicip.rima-tde.net"
arr(6,0) = "198.2.139.211"
arr(6,1) = "mail211.atl221.rsgsv.net"
arr(7,0) = "192.168.0.101"
arr(7,1) = "[IPv6:::ffff:192.168.0.101]"
arr(8,0) = "192.168.0.101"
arr(8,1) = "IPv6:::ffff:192.168.0.101"
dim a, strRegEx
'Fetching values from 2 Dimenional array
For i=0 to Ubound(arr,1) ' Ubound of first dimension
a = Split(arr(i,0), ".")
strRegEx = "^(?!(?:\[)(?:(?:ipv6.+)|(?:[0-9]{1,3}[.-]){3}[0-9]{1,3})(?:\]))" &_
"(.*(((?:[0]{0,2})" & a(0) & "|(?:[0]{0,2})" & a(1) & "|(?:[0]{0,2})" & a(2) & "|(?:[0]{0,2})" & a(3) & ")(?:.+)){3}" &_
"((?:[0]{0,2})" & a(0) & "|(?:[0]{0,2})" & a(1) & "|(?:[0]{0,2})" & a(2) & "|(?:[0]{0,2})" & a(3) & ").+)$"
If Lookup(strRegEx, arr(i,1)) Then
MsgBox "IPAddress = " & arr(i,0) & VbCrLF & "HELO = " & arr(i,1)
end If
Next
Function Lookup(strRegEx, strMatch)
With CreateObject("VBScript.RegExp")
.Global = False
.Pattern = strRegEx
.IgnoreCase = True
Lookup = .Test(strMatch)
End With
End FunctionCIDR to RegEx: d-fault.nl/cidrtoregex
DNS Lookup: d-fault.nl/dnstools
DKIM Generator: d-fault.nl/dkimgenerator
DNSBL Lookup: d-fault.nl/dnsbllookup
GEOIP Lookup: d-fault.nl/geoiplookup
DNS Lookup: d-fault.nl/dnstools
DKIM Generator: d-fault.nl/dkimgenerator
DNSBL Lookup: d-fault.nl/dnsbllookup
GEOIP Lookup: d-fault.nl/geoiplookup
Re: Hardening hMailServer - The ongoing saga!
This is pretty slick. I'm going to give it a shot. Thanks!
Re: Hardening hMailServer - The ongoing saga!
Fun with PTR.
I've been using a variation of the above dynamic looking HELO filter for a while. Today I came up with an idea and I tested it out against banned IPs in my Firewall Ban project.
I just ran a PTR lookup for every record in my Firewall Ban project from the United States (has passed GeoIP filter). I have 1,085 bans from US on Firewall Ban for a variety of reasons, but mostly for hitting Spamhaus Zen. Of those that have a PTR record, 412 hit the "Dynamic-Looking PTR" filter. Of those, I excluded HELO entries that also hit the same filter (e.g. HELO: 24-181-205-130.static.hckr.nc.charter.com, PTR: 24-181-205-130.static.hckr.nc.charter.com) and came up with 235 that hit the filter, which are the ones that would not have hit on filter "bots using residential FQDN as HELO". So right there is an improvement. 269 had no PTR record.
So, 63% of known spammers got picked up by these rules. Not a bad tool to have.
By the way, what sparked my interest in this was occasionally getting network errors in geoip lookups. So I decided to put as much filtering as possible in a "local" sense. The PTR lookup is obviously not coming from a local database, but dns is crazy efficient and I only look it up once for the entire transaction.
I've been using a variation of the above dynamic looking HELO filter for a while. Today I came up with an idea and I tested it out against banned IPs in my Firewall Ban project.
Code: Select all
Function PTRLookup(strIP)
Dim strLookup, strPTR
With CreateObject("DNSLibrary.DNSResolver")
strLookup = .PTR(strIP)
End With
If strLookup = Empty Then strPTR = "No.PTR.Record" Else strPTR = strLookup End If
PTRLookup = strPTR
End Function
Sub OnHELO(oClient)
' Grab PTR-Record
Dim PTR_Record
PTR_Record = PTRLookup(oClient.IPAddress)
' Reject on No-PTR
If (oClient.Port = 25) Then
If PTR_Record = "No.PTR.Record" Then
Result.Value = 2
Result.Message = ". 03 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 Disconnect(oClient.IPAddress)
Call FWBan(oClient.IPAddress, "No-PTR", oClient.HELO)
Call AutoBan(oClient.IPAddress, "No-PTR - " & oClient.IpAddress, 1, "h")
Call AccRejDB(strPort, oClient.Port, "OnHELO", "REJECTED", "No-PTR", oClient.IPAddress, oClient.HELO)
Exit Sub
End If
End If
' Filter bots using residential FQDN as HELO
Dim a, i
a = Split(oClient.IPAddress, ".")
For i = 0 to 3
Next
' Exclude certain false positives
strRegEx = "sendgrid|facebook.com"
If Lookup(strRegEx, oClient.HELO) Then Exit Sub
' Search for residential looking HELO
strRegEx = "(.*(((?:[0]{0,2})" & a(0) & "|(?:[0]{0,2})" & a(1) & "|(?:[0]{0,2})" & a(2) & "|(?:[0]{0,2})" & a(3) & ")(?:.+)){3}" &_
"((?:[0]{0,2})" & a(0) & "|(?:[0]{0,2})" & a(1) & "|(?:[0]{0,2})" & a(2) & "|(?:[0]{0,2})" & a(3) & ").+)$"
If (oClient.Port = 25) Then
If Lookup(strRegEx, oClient.HELO) Then
Result.Value = 2
Result.Message = ". 05 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 If
' Filter dynamic-looking PTR-Record
If PTR_Record <> "" Then
' Exclude certain false positives
strRegEx = "sendgrid|facebook.com"
If Lookup(strRegEx, PTR_Record) Then Exit Sub
' Search for residential looking HELO
strRegEx = "(.*(((?:[0]{0,2})" & a(0) & "|(?:[0]{0,2})" & a(1) & "|(?:[0]{0,2})" & a(2) & "|(?:[0]{0,2})" & a(3) & ")(?:.+)){3}" &_
"((?:[0]{0,2})" & a(0) & "|(?:[0]{0,2})" & a(1) & "|(?:[0]{0,2})" & a(2) & "|(?:[0]{0,2})" & a(3) & ").+)$"
If (oClient.Port = 25) Then
If Lookup(strRegEx, PTR_Record) Then
Result.Value = 2
Result.Message = ". 18 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."
End If
End If
End If
End Sub
So, 63% of known spammers got picked up by these rules. Not a bad tool to have.
By the way, what sparked my interest in this was occasionally getting network errors in geoip lookups. So I decided to put as much filtering as possible in a "local" sense. The PTR lookup is obviously not coming from a local database, but dns is crazy efficient and I only look it up once for the entire transaction.
Re: Hardening hMailServer - The ongoing saga!
I ran a test on my entire firewall ban database and came up with this.
72% of known spammers got hit for either NO PTR or dynamic looking PTR. I'm rejecting both catagories now.
Code: Select all
11,349 IPs banned
42.74% - 4,851 No PTR
29.09% - 3,301 Dynamic looking PTR
0.35% - 40 Dynamic looking HELO (after testing PTR)
27.82% - 3,157 No matches
------ ------
100.00% 11,349 IPs banned
8,968 banned for GeoIP
1,967 banned for Spamhaus
414 banned for other reasons
------
11,349 IPs banned
Re: Hardening hMailServer - The ongoing saga!
palinka wrote: ↑2019-10-29 21:33I ran a test on my entire firewall ban database and came up with this.
72% of known spammers got hit for either NO PTR or dynamic looking PTR. I'm rejecting both catagories now.Code: Select all
11,349 IPs banned 42.74% - 4,851 No PTR 29.09% - 3,301 Dynamic looking PTR 0.35% - 40 Dynamic looking HELO (after testing PTR) 27.82% - 3,157 No matches ------ ------ 100.00% 11,349 IPs banned 8,968 banned for GeoIP 1,967 banned for Spamhaus 414 banned for other reasons ------ 11,349 IPs banned
Thank you very much Palinka, I have followed your advice adapted your code and in a few hours I have rejected / banned more than 200 servers.
You have to be careful with the lords of Microsoft.
It can be a false positive in, FQDN as HELO.
Code: Select all
AM5EUR02FT035.mail.protection.outlook.com
EUR04-DB3-obe.outbound.protection.outlook.com
EUR03-VE1-obe.outbound.protection.outlook.comProduction 5.6.8-B2574.45.RvDH W.Server 2016 Datace [2x Intel Xeon E5-2660 8GB RAM]
Staging 5.7-B2490 W.Server 2008 R2 Stand [Intel Pentium 4 4GB RAM]
Staging 5.7-B2490 W.Server 2008 R2 Stand [Intel Pentium 4 4GB RAM]
Re: Hardening hMailServer - The ongoing saga!
I discovered that yesterday too. I added outbound.protection.outlook.com$ to the list of "known false positives" so they skip the test.nitro wrote: ↑2019-10-31 10:28You have to be careful with the lords of Microsoft.
It can be a false positive in, FQDN as HELO.
Code: Select all
AM5EUR02FT035.mail.protection.outlook.com EUR04-DB3-obe.outbound.protection.outlook.com EUR03-VE1-obe.outbound.protection.outlook.com
Re: Hardening hMailServer - The ongoing saga!
Hi Palinka,palinka wrote: ↑2019-10-28 17:44Fun with PTR.
I've been using a variation of the above dynamic looking HELO filter for a while. Today I came up with an idea and I tested it out against banned IPs in my Firewall Ban project.
I just ran a PTR lookup for every record in my Firewall Ban project from the United States (has passed GeoIP filter). I have 1,085 bans from US on Firewall Ban for a variety of reasons, but mostly for hitting Spamhaus Zen. Of those that have a PTR record, 412 hit the "Dynamic-Looking PTR" filter. Of those, I excluded HELO entries that also hit the same filter (e.g. HELO: 24-181-205-130.static.hckr.nc.charter.com, PTR: 24-181-205-130.static.hckr.nc.charter.com) and came up with 235 that hit the filter, which are the ones that would not have hit on filter "bots using residential FQDN as HELO". So right there is an improvement. 269 had no PTR record.Code: Select all
Function PTRLookup(strIP) Dim strLookup, strPTR With CreateObject("DNSLibrary.DNSResolver") strLookup = .PTR(strIP) End With If strLookup = Empty Then strPTR = "No.PTR.Record" Else strPTR = strLookup End If PTRLookup = strPTR End Function Sub OnHELO(oClient) ' Grab PTR-Record Dim PTR_Record PTR_Record = PTRLookup(oClient.IPAddress) ' Reject on No-PTR If (oClient.Port = 25) Then If PTR_Record = "No.PTR.Record" Then Result.Value = 2 Result.Message = ". 03 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 Disconnect(oClient.IPAddress) Call FWBan(oClient.IPAddress, "No-PTR", oClient.HELO) Call AutoBan(oClient.IPAddress, "No-PTR - " & oClient.IpAddress, 1, "h") Call AccRejDB(strPort, oClient.Port, "OnHELO", "REJECTED", "No-PTR", oClient.IPAddress, oClient.HELO) Exit Sub End If End If ' Filter bots using residential FQDN as HELO Dim a, i a = Split(oClient.IPAddress, ".") For i = 0 to 3 Next ' Exclude certain false positives strRegEx = "sendgrid|facebook.com" If Lookup(strRegEx, oClient.HELO) Then Exit Sub ' Search for residential looking HELO strRegEx = "(.*(((?:[0]{0,2})" & a(0) & "|(?:[0]{0,2})" & a(1) & "|(?:[0]{0,2})" & a(2) & "|(?:[0]{0,2})" & a(3) & ")(?:.+)){3}" &_ "((?:[0]{0,2})" & a(0) & "|(?:[0]{0,2})" & a(1) & "|(?:[0]{0,2})" & a(2) & "|(?:[0]{0,2})" & a(3) & ").+)$" If (oClient.Port = 25) Then If Lookup(strRegEx, oClient.HELO) Then Result.Value = 2 Result.Message = ". 05 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 If ' Filter dynamic-looking PTR-Record If PTR_Record <> "" Then ' Exclude certain false positives strRegEx = "sendgrid|facebook.com" If Lookup(strRegEx, PTR_Record) Then Exit Sub ' Search for residential looking HELO strRegEx = "(.*(((?:[0]{0,2})" & a(0) & "|(?:[0]{0,2})" & a(1) & "|(?:[0]{0,2})" & a(2) & "|(?:[0]{0,2})" & a(3) & ")(?:.+)){3}" &_ "((?:[0]{0,2})" & a(0) & "|(?:[0]{0,2})" & a(1) & "|(?:[0]{0,2})" & a(2) & "|(?:[0]{0,2})" & a(3) & ").+)$" If (oClient.Port = 25) Then If Lookup(strRegEx, PTR_Record) Then Result.Value = 2 Result.Message = ". 18 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." End If End If End If End Sub
So, 63% of known spammers got picked up by these rules. Not a bad tool to have.
By the way, what sparked my interest in this was occasionally getting network errors in geoip lookups. So I decided to put as much filtering as possible in a "local" sense. The PTR lookup is obviously not coming from a local database, but dns is crazy efficient and I only look it up once for the entire transaction.
I used your code above but got an error:
Code: Select all
"ERROR" 11944 "2019-11-11 18:42:34.161" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A000D - Description: Type mismatch: 'Disconnect' - Line: 262 Column: 3 - Code: (null)"Re: Hardening hMailServer - The ongoing saga!
You probably don't have the disconnect function.
You also need RvdH's disconnect.exe. Download it from here: https://d-fault.nl/files/Disconnect.zip and unzip it into your hmailserver\Events folder. Change the path in the function if it doesn't match your Events folder location.
Code: Select all
Function Disconnect(sIPAddress)
With CreateObject("WScript.Shell")
.Run """C:\Program Files (x86)\hMailServer\Events\Disconnect.exe"" " & sIPAddress & "", 0, True
REM EventLog.Write("Disconnect.exe " & sIPAddress & "")
End With
End Function
Re: Hardening hMailServer - The ongoing saga!
Also, I just looked at my script and see that I did not strip out some of my custom stuff.
This:
Really should be this with my crap stripped out:
Otherwise you'll get the same errors for calling FWBan and AccRejDB. If you copied Soren's stuff, you probably already have AutoBan. If not, you can find it above in this thread.
This:
Code: Select all
If (oClient.Port = 25) Then
If PTR_Record = "No.PTR.Record" Then
Result.Value = 2
Result.Message = ". 03 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 Disconnect(oClient.IPAddress)
Call FWBan(oClient.IPAddress, "No-PTR", oClient.HELO)
Call AutoBan(oClient.IPAddress, "No-PTR - " & oClient.IpAddress, 1, "h")
Call AccRejDB(strPort, oClient.Port, "OnHELO", "REJECTED", "No-PTR", oClient.IPAddress, oClient.HELO)
Exit Sub
End If
End IfCode: Select all
If (oClient.Port = 25) Then
If PTR_Record = "No.PTR.Record" Then
Result.Value = 2
Result.Message = ". 03 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 IfRe: Hardening hMailServer - The ongoing saga!
Hi Palinka,palinka wrote: ↑2019-11-11 18:19Also, I just looked at my script and see that I did not strip out some of my custom stuff.
This:Really should be this with my crap stripped out:Code: Select all
If (oClient.Port = 25) Then If PTR_Record = "No.PTR.Record" Then Result.Value = 2 Result.Message = ". 03 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 Disconnect(oClient.IPAddress) Call FWBan(oClient.IPAddress, "No-PTR", oClient.HELO) Call AutoBan(oClient.IPAddress, "No-PTR - " & oClient.IpAddress, 1, "h") Call AccRejDB(strPort, oClient.Port, "OnHELO", "REJECTED", "No-PTR", oClient.IPAddress, oClient.HELO) Exit Sub End If End IfOtherwise you'll get the same errors for calling FWBan and AccRejDB. If you copied Soren's stuff, you probably already have AutoBan. If not, you can find it above in this thread.Code: Select all
If (oClient.Port = 25) Then If PTR_Record = "No.PTR.Record" Then Result.Value = 2 Result.Message = ". 03 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 If
It's working, Thank you so much. Now, I got this logs from the botnet every time they're trying to connect. I appreciate all your help and for sharing this script.
Code: Select all
"SMTPD" 11896 1393 "2019-11-11 19:49:48.137" "200.0.0.103" "SENT: 220 mydomain.com ESMTP"
"SMTPD" 11112 1393 "2019-11-11 19:49:48.138" "200.0.0.103" "RECEIVED: EHLO Ammar"
"DEBUG" 11112 "2019-11-11 19:49:48.139" "Executing event OnHELO"
"DEBUG" 11112 "2019-11-11 19:49:48.165" "Event completed"
"SMTPD" 11112 1393 "2019-11-11 19:49:48.165" "200.0.0.103" "SENT: 554 . 03 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."
"DEBUG" 11896 "2019-11-11 19:49:48.167" "The read operation failed. Bytes transferred: 0 Remote IP: 200.0.0.103, Session: 1393, Code: 2, Message: End of file"
"DEBUG" 11896 "2019-11-11 19:49:48.167" "Ending session 1393"
"DEBUG" 11896 "2019-11-11 19:49:48.172" "Creating session 1397"
"TCPIP" 11896 "2019-11-11 19:49:48.172" "TCP - 200.0.0.103 connected to 200.0.0.8:25."
"DEBUG" 11896 "2019-11-11 19:49:48.173" "Executing event OnClientConnect"
"DEBUG" 4292 "2019-11-11 19:49:54.381" "The read operation failed. Bytes transferred: 0 Remote IP: 200.0.0.103, Session: 1392, Code: 335544539, Message: short read"
"DEBUG" 4292 "2019-11-11 19:49:54.382" "Ending session 1392"
"DEBUG" 11896 "2019-11-11 19:50:08.135" "Event completed"
"DEBUG" 11896 "2019-11-11 19:50:08.135" "TCP connection started for session 1396"
"SMTPD" 11896 1396 "2019-11-11 19:50:08.136" "200.0.0.103" "SENT: 220 mydomain.com ESMTP"
"SMTPD" 4292 1396 "2019-11-11 19:50:08.137" "200.0.0.103" "RECEIVED: EHLO Ammar"
"DEBUG" 4292 "2019-11-11 19:50:08.138" "Executing event OnHELO"
"DEBUG" 4292 "2019-11-11 19:50:08.167" "Event completed"
"SMTPD" 4292 1396 "2019-11-11 19:50:08.168" "200.0.0.103" "SENT: 554 . 03 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."
"DEBUG" 11896 "2019-11-11 19:50:08.169" "The read operation failed. Bytes transferred: 0 Remote IP: 200.0.0.103, Session: 1396, Code: 2, Message: End of file"
"DEBUG" 11896 "2019-11-11 19:50:08.170" "Ending session 1396"
"DEBUG" 11896 "2019-11-11 19:50:08.173" "Creating session 1398"
"TCPIP" 11896 "2019-11-11 19:50:08.173" "TCP - 200.0.0.103 connected to 200.0.0.8:25."
"DEBUG" 11896 "2019-11-11 19:50:08.174" "Executing event OnClientConnect"
"DEBUG" 4292 "2019-11-11 19:50:14.632" "Ending session 1394"
"DEBUG" 6908 "2019-11-11 19:50:23.112" "Creating session 1399"
"TCPIP" 6908 "2019-11-11 19:50:23.112" "TCP - 200.0.0.103 connected to 200.0.0.8:995."
"DEBUG" 6908 "2019-11-11 19:50:23.113" "Executing event OnClientConnect"
"DEBUG" 6908 "2019-11-11 19:50:23.114" "Event completed"
"DEBUG" 6908 "2019-11-11 19:50:23.114" "TCP connection started for session 1390"
"DEBUG" 6908 "2019-11-11 19:50:23.114" "Performing SSL/TLS handshake for session 1390. Verify certificate: False"
"TCPIP" 4292 "2019-11-11 19:50:23.144" "TCPConnection - TLS/SSL handshake completed. Session Id: 1390, Remote IP: 200.0.0.103, Version: TLSv1.2, Cipher: ECDHE-RSA-AES256-GCM-SHA384, Bits: 256"
"DEBUG" 11112 "2019-11-11 19:50:23.195" "Executing event OnClientLogon"
"DEBUG" 11112 "2019-11-11 19:50:23.196" "Event completed"
"DEBUG" 11112 "2019-11-11 19:50:23.254" "Ending session 1390"
"DEBUG" 11896 "2019-11-11 19:50:28.144" "Event completed"
"DEBUG" 11896 "2019-11-11 19:50:28.145" "TCP connection started for session 1397"
"SMTPD" 11896 1397 "2019-11-11 19:50:28.145" "200.0.0.103" "SENT: 220 mydomain.com ESMTP"
"SMTPD" 11112 1397 "2019-11-11 19:50:28.148" "200.0.0.103" "RECEIVED: EHLO Ammar"
"DEBUG" 11112 "2019-11-11 19:50:28.148" "Executing event OnHELO"
"DEBUG" 11112 "2019-11-11 19:50:28.197" "Event completed"
"SMTPD" 11112 1397 "2019-11-11 19:50:28.198" "200.0.0.103" "SENT: 554 . 03 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."
"DEBUG" 11112 "2019-11-11 19:50:28.200" "The read operation failed. Bytes transferred: 0 Remote IP: 200.0.0.103, Session: 1397, Code: 2, Message: End of file"
"DEBUG" 11112 "2019-11-11 19:50:28.201" "Ending session 1397"
"DEBUG" 11896 "2019-11-11 19:50:28.210" "Creating session 1400"
"TCPIP" 11896 "2019-11-11 19:50:28.211" "TCP - 200.0.0.103 connected to 200.0.0.8:25."Re: Hardening hMailServer - The ongoing saga!
Only check PTR on port 25. The logic behind that is only "real" mailservers should be connecting on port 25 and all of them should have a valid PTR.
If you check the PTR on submission ports or IMAP/POP3 ports, you'll be checking all kinds of legitimate mail clients and nearly none will pass the no/dyn PTR test. Nearly all legitimate users/clients will have dynamic IP/PTR or no PTR because they're not servers and can and should be allowed to connect from anywhere.
Your best bet is to let autoban do its job. Checking PTR is for rejecting incoming mail only.
If you check the PTR on submission ports or IMAP/POP3 ports, you'll be checking all kinds of legitimate mail clients and nearly none will pass the no/dyn PTR test. Nearly all legitimate users/clients will have dynamic IP/PTR or no PTR because they're not servers and can and should be allowed to connect from anywhere.
Your best bet is to let autoban do its job. Checking PTR is for rejecting incoming mail only.
Re: Hardening hMailServer - The ongoing saga!
Thank you, I appreciate this.palinka wrote: ↑2019-11-11 19:50Only check PTR on port 25. The logic behind that is only "real" mailservers should be connecting on port 25 and all of them should have a valid PTR.
If you check the PTR on submission ports or IMAP/POP3 ports, you'll be checking all kinds of legitimate mail clients and nearly none will pass the no/dyn PTR test. Nearly all legitimate users/clients will have dynamic IP/PTR or no PTR because they're not servers and can and should be allowed to connect from anywhere.
Your best bet is to let autoban do its job. Checking PTR is for rejecting incoming mail only.
I have one more question, how do I know if botnet has been banned? Is there a way I can check this?
Re: Hardening hMailServer - The ongoing saga!
That depends on what you mean by ban. If you autoban rejections, then you can look in your ip ranges. If you firewall ban using my firewall ban project, there's a whole php web interface to keep track of them.
Autoban entries expire according to whatever time period that you choose. Firewall banning is permanent unless you decide to release the ip for some reason, including auto expiration on a time frame you choose.