Hardening hMailServer - The ongoing saga!

This section contains user-submitted tutorials.
User avatar
SorenR
Senior user
Senior user
Posts: 6308
Joined: 2006-08-21 15:38
Location: Denmark

Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-01-28 17:09

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
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-01-28 17:12

#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.

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                                                                                                      **********
'******************************************************************************************************************************
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
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-01-28 17:29

#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.

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                                                                                                      **********
'******************************************************************************************************************************
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
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-01-28 17:57

#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

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                                                                                                      **********
'******************************************************************************************************************************
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                                                                                                      **********
'******************************************************************************************************************************
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
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-01-28 18:17

#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 :mrgreen:

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                                                                                                      **********
'******************************************************************************************************************************
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
Last edited by SorenR on 2019-01-28 18:20, edited 1 time in total.
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-01-28 18:17

#5 How does a fully functioning system look like? PART 2!

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                                                                                                      **********
'******************************************************************************************************************************
File: Check-State.vbs

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                                                                                                      **********
'******************************************************************************************************************************
File: RunBackup.vbs

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
File: hMailServer.xml

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>(\&lt;http:\/\/(.*)\/unsubscribe\.php\?M=(.*)&amp;C=(.*)&amp;L=(.*)&amp;N=(.*)\&gt;)</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)(|\&gt;)$</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>(\&lt;.*\@.*\.[a-z]{4,}\&gt;)$<!--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 &lt;no-reply\@mail\.goodreads\.com&gt;)$</From>
    <From>^(EasyPark &lt;no-reply\@easypark\.net&gt;)$</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.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-01-28 20:35

Wow this is really awesome stuff. Thank you for sharing all of it! Great job, man!

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-01-28 20:39

One question (for now :wink: ). What is the ransomware bit in hMailServer.xml? They appear to be legit URLs.

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-01-28 21:01

palinka wrote:
2019-01-28 20:39
One question (for now :wink: ). What is the ransomware bit in hMailServer.xml? They appear to be legit URLs.
Yes, bad guys use dropbox too :mrgreen:

Never caught one though.
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-04 14:26

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:

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
Any ideas?

I have Function LoadXML(XMLFile) included, and Private Const XMLFile = "hMailServer.xml" also, as well as RvdH's activex thingy installed.

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-05-04 20:12

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.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-05-04 20:15

Anyways... It has all been slightly changed in the meantime :oops:

My EventHandlers.vbs is not static code for very long. I find other ways to do the same stuff quicker or with less ressources :mrgreen:
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-04 20:40

SorenR wrote:
2019-05-04 20:15
Anyways... It has all been slightly changed in the meantime :oops:

My EventHandlers.vbs is not static code for very long. I find other ways to do the same stuff quicker or with less ressources :mrgreen:
I know. And im always 3 generations in the past. :mrgreen:

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-05-04 21:11

palinka wrote:
2019-05-04 20:40
SorenR wrote:
2019-05-04 20:15
Anyways... It has all been slightly changed in the meantime :oops:

My EventHandlers.vbs is not static code for very long. I find other ways to do the same stuff quicker or with less ressources :mrgreen:
I know. And im always 3 generations in the past. :mrgreen:
Todays flavor :mrgreen:

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.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-04 21:13

SorenR wrote:
2019-05-04 20:12

Code: Select all

   Dim oXML : Set oXML = CreateObject("MSXML2.DOMDocument")  <=== YOU ARE MISSING THIS !!
  
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.

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.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-04 21:31

palinka wrote:
2019-05-04 21:13
Sub OnHELO(oClient)
Dim oXML : Set oXML = LoadXML(XMLDATA)
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.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-04 21:33

One more thing - I added this to the top of eventhandlers. Very handy when looking at the logs! :D

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 ::

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-05 03:24

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".

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-05-05 10:19

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.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-05 14:53

I'm using this (another of yours :mrgreen: ) 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   
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"]'

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) & ")"

What am I doing wrong?

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

Re: Hardening hMailServer - The ongoing saga!

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

Got it. :D

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) & "))"

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-05 20:40

OK, now that everything is running smoothly, I have a couple of questions.

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
Also, for this:

Code: Select all

   '   Reject "List-Unsubscribe:"
   strRegEx = LoadXMLNode(oXML, "//Reject/List-Unsubscribe")
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. :mrgreen:

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-05-05 22:27

palinka wrote:
2019-05-05 20:40
OK, now that everything is running smoothly, I have a couple of questions.

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
Also, for this:

Code: Select all

   '   Reject "List-Unsubscribe:"
   strRegEx = LoadXMLNode(oXML, "//Reject/List-Unsubscribe")
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. :mrgreen:
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.

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 :mrgreen:

Code: Select all

<List-Unsubscribe>(\&lt;http(s?):\/\/(.*)\/unsubscribe\.php\?M=(.*)&amp;C=(.*)&amp;L=(.*)&amp;N=(.*)\&gt;)</List-Unsubscribe>
It will match against oMessage.HeaderValue("List-Unsubscribe")
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-05 23:41

SorenR wrote:
2019-05-05 22:27
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.
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"
When I saw the first one, I was surprised nothing came through to my spam repository for SA-learn training. I looked around trying to find WTF happened and finally I saw that the connection quit. No big deal because I know these messages from today are all actual spam, but I hope it doesn't happen with any bona fide ham.

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?

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-06 04:41

SorenR wrote:
2019-05-04 21:11
Todays flavor :mrgreen:

Disclaimer. Not all variables are declared in the sample code....
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"
Here in your example you used XMLFILE which I changed to XMLDATA.

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
Line 583 is Dim...

Code: Select all

Sub OnHELO(oClient)
   Dim oXML : Set oXML = GetXMLNode(XMLDATA)
Per your example, I changed all these xml to GetXMLNode

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
Line 667 is the Dim...

Code: Select all

Sub OnAcceptMessage(oClient, oMessage)
   Dim oXML : Set oXML = GetXMLNode(XMLDATA)

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-05-06 11:59

palinka wrote:
2019-05-06 04:41
SorenR wrote:
2019-05-04 21:11
Todays flavor :mrgreen:

Disclaimer. Not all variables are declared in the sample code....
Line 583 is Dim...

Code: Select all

Sub OnHELO(oClient)
   Dim oXML : Set oXML = LoadXML(XMLDATA)
Line 667 is the Dim...

Code: Select all

Sub OnAcceptMessage(oClient, oMessage)
   Dim oXML : Set oXML = LoadXML(XMLDATA)
No longer needed. When you remove "Dim oXML : Set oXML = LoadXML(XMLDATA)" also remove "Set oXML = Nothing" or you will get another error.

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
New code:

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
Also notice that with the new Bolean AutoBan code you can

Code: Select all

Call AutoBan(oClient.IPAddress, "Scum of the earth "  & Match.Value, 12, "h")
or you can

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
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.
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-06 13:57

Awesome! Thanks, man!

One question - I successfully banned google during testing (using //Reject/Subject). :roll: 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... :evil: Too many friendly connections to blast away like this:

Image

YOU'VE BEEN TERMINATED! :mrgreen:

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-06 14:01

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.

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   
As far as I'm concerned, HELO = IP is spam even if its presented in brackets per the "code".

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-05-06 16:55

palinka wrote:
2019-05-06 14:01

As far as I'm concerned, HELO = IP is spam even if its presented in brackets per the "code".
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.

Woke is Marxism advancing through Maoist cultural revolution.

Gordonh1970
Normal user
Normal user
Posts: 42
Joined: 2016-01-29 13:50
Location: UK
Contact:

Re: Hardening hMailServer - The ongoing saga!

Post by Gordonh1970 » 2019-05-11 21:21

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

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-05-12 10:58

Gordonh1970 wrote:
2019-05-11 21:21
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
Failed logins are handled by hMailServer directly, not by scripting.

https://www.hmailserver.com/documentati ... ce_autoban
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

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

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.

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-05-12 17:45

palinka wrote:
2019-05-12 14:31
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.
I knew that... I have a "CheckState" job running every 5 minutes for that specific reason ... :mrgreen:

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.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-12 17:50

SorenR wrote:
2019-05-12 17:45
palinka wrote:
2019-05-12 14:31
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.
I knew that... I have a "CheckState" job running every 5 minutes for that specific reason ... :mrgreen:

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
I do it in powershell.

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
}
For whatever reason, powershell comes a lot easier to me than vbs. I had a bit of trouble crossing midnight, but the above works.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-21 12:24

SorenR wrote:
2019-05-06 11:59
Also notice that with the new Bolean AutoBan code you can

Code: Select all

Call AutoBan(oClient.IPAddress, "Scum of the earth "  & Match.Value, 12, "h")
or you can

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
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.
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.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-21 12:46

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:

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

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-05-21 14:36

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 Sub
Call idsAddIP(oClient.IPAddress, oClient.Port)
Insert 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.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-21 18:03

SorenR wrote:
2019-05-21 14:36
the only other machine I have spare is a Acer Aspire 5552 with an AMD Athlon II
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.

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-05-21 21:25

palinka wrote:
2019-05-21 18:03
SorenR wrote:
2019-05-21 14:36
the only other machine I have spare is a Acer Aspire 5552 with an AMD Athlon II
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.
It has to match the other old stuff I have... :mrgreen:

Ferguson (lawn mover) - 1952
House & "toolshed" - 1967
Audi Quattro (urquattro) - 1982
Golf Cabriolet (Etienne Aigner edition) 1990

Image
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-21 22:17

Nice mower. Do you bale it? Or stack it like the old days? :mrgreen:

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-05-21 23:32

palinka wrote:
2019-05-21 22:17
Nice mower. Do you bale it? Or stack it like the old days? :mrgreen:
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. :mrgreen:
Image

So that is why, sometimes, I don't respond promptly on forum... Either outside working or just staring out the window looking at nature 8)
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-22 00:23

Beautiful. Looks like an awesome place to live.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-22 01:35

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. :mrgreen:

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

Re: Hardening hMailServer - The ongoing saga!

Post by SorenR » 2019-05-22 08:19

palinka wrote:
2019-05-22 01:35
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. :mrgreen:
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).

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.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-05-30 02:18

SorenR wrote:
2019-05-22 08:19
It will be very difficult to target "FirstnameLastname" as you are bound to catch some innocent victims.
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. :cry:

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   
This picks up the following on a test run:

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.

User avatar
RvdH
Senior user
Senior user
Posts: 3231
Joined: 2008-06-27 14:42
Location: The Netherlands

Re: Hardening hMailServer - The ongoing saga!

Post by RvdH » 2019-06-01 00:31

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

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

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-06-01 22:11

RvdH wrote:
2019-06-01 00:31
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

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) & "))"
Good stuff. Thanks!

User avatar
RvdH
Senior user
Senior user
Posts: 3231
Joined: 2008-06-27 14:42
Location: The Netherlands

Re: Hardening hMailServer - The ongoing saga!

Post by RvdH » 2019-06-02 01:59

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 Function
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

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-06-02 03:52

This is pretty slick. I'm going to give it a shot. Thanks!

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-10-28 17:44

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.

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
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.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-10-29 21:33

I ran a test on my entire firewall ban database and came up with this.

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
72% of known spammers got hit for either NO PTR or dynamic looking PTR. I'm rejecting both catagories now.

User avatar
nitro
Normal user
Normal user
Posts: 52
Joined: 2018-11-08 16:31
Location: Spain

Re: Hardening hMailServer - The ongoing saga!

Post by nitro » 2019-10-31 10:28

palinka wrote:
2019-10-29 21:33
I ran a test on my entire firewall ban database and came up with this.

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
72% of known spammers got hit for either NO PTR or dynamic looking PTR. I'm rejecting both catagories now.

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.com
Production 5.6.9.xx RvDH W.Server 2016 Datacenter [2x Intel Xeon E5-2660 8GB RAM]

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-10-31 10:58

nitro wrote:
2019-10-31 10:28
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.com
I discovered that yesterday too. I added outbound.protection.outlook.com$ to the list of "known false positives" so they skip the test.

ashtec014
Normal user
Normal user
Posts: 234
Joined: 2019-09-05 11:56

Re: Hardening hMailServer - The ongoing saga!

Post by ashtec014 » 2019-11-11 17:43

palinka wrote:
2019-10-28 17:44
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.

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
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.
Hi Palinka,

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)"

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-11-11 18:14

You probably don't have the disconnect function.

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
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.

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-11-11 18:19

Also, I just looked at my script and see that I did not strip out some of my custom stuff.

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 If
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."
			Exit Sub
		End If
	End If
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.

ashtec014
Normal user
Normal user
Posts: 234
Joined: 2019-09-05 11:56

Re: Hardening hMailServer - The ongoing saga!

Post by ashtec014 » 2019-11-11 18:53

palinka wrote:
2019-11-11 18:19
Also, I just looked at my script and see that I did not strip out some of my custom stuff.

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 If
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."
			Exit Sub
		End If
	End If
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.
Hi Palinka,

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."

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-11-11 19:50

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.

ashtec014
Normal user
Normal user
Posts: 234
Joined: 2019-09-05 11:56

Re: Hardening hMailServer - The ongoing saga!

Post by ashtec014 » 2019-11-16 07:54

palinka wrote:
2019-11-11 19:50
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.
Thank you, I appreciate this.

I have one more question, how do I know if botnet has been banned? Is there a way I can check this?

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

Re: Hardening hMailServer - The ongoing saga!

Post by palinka » 2019-11-16 13:27

ashtec014 wrote:
2019-11-16 07:54

Thank you, I appreciate this.

I have one more question, how do I know if botnet has been banned? Is there a way I can check this?
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.

Post Reply