Hardening hMailServer - The ongoing saga!

This section contains user-submitted tutorials.
Post Reply
User avatar
SorenR
Senior user
Senior user
Posts: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
SorenR
Senior user
Senior user
Posts: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
SorenR
Senior user
Senior user
Posts: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
SorenR
Senior user
Senior user
Posts: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
SorenR
Senior user
Senior user
Posts: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
SorenR
Senior user
Senior user
Posts: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

palinka
Senior user
Senior user
Posts: 893
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: 893
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: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

palinka
Senior user
Senior user
Posts: 893
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: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
SorenR
Senior user
Senior user
Posts: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

palinka
Senior user
Senior user
Posts: 893
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: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

palinka
Senior user
Senior user
Posts: 893
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: 893
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: 893
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: 893
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: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

palinka
Senior user
Senior user
Posts: 893
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: 893
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: 893
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: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

palinka
Senior user
Senior user
Posts: 893
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: 893
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: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

palinka
Senior user
Senior user
Posts: 893
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: 893
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: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

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

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

palinka
Senior user
Senior user
Posts: 893
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: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

palinka
Senior user
Senior user
Posts: 893
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: 893
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: 893
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: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

palinka
Senior user
Senior user
Posts: 893
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: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

palinka
Senior user
Senior user
Posts: 893
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: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

palinka
Senior user
Senior user
Posts: 893
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: 893
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: 3155
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.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

palinka
Senior user
Senior user
Posts: 893
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: 776
Joined: 2008-06-27 14:42
Location: 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
DNSBL Lookup: d-fault.nl/DNSBLLookup
GEOIP Lookup: d-fault.nl/GeoipLookup

palinka
Senior user
Senior user
Posts: 893
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: 776
Joined: 2008-06-27 14:42
Location: 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
DNSBL Lookup: d-fault.nl/DNSBLLookup
GEOIP Lookup: d-fault.nl/GeoipLookup

palinka
Senior user
Senior user
Posts: 893
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!

Post Reply