Add TLS statement to email

Use this forum if you have installed hMailServer and want to ask a question related to a production release of hMailServer. Before posting, please read the troubleshooting guide. A large part of all reported issues are already described in detail here.
Post Reply
1ucasPitts
New user
New user
Posts: 8
Joined: 2014-08-27 17:06

Add TLS statement to email

Post by 1ucasPitts » 2020-04-10 00:05

Is it possible to add a statement to the top of an incoming email indicating whether or not the message was sent with TLS?

Similar to https://www.hmailserver.com/forum/viewt ... =7&t=29777 but checking whether or not the connection was encrypted.

I imagine you would need to search the headers for ESMTPS or TLS or something similar. A securely transferred email usually has something like the following: "Received: from ExternalServer (ExternalServer [1.2.3.4]) by my.mailserver.com with ESMTPS (version=TLSv1.2 cipher=ECDHE-RSA-AES256-GCM-SHA384 bits=256) ;"

Thanks for your help!

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

Re: Add TLS statement to email

Post by SorenR » 2020-04-10 00:39

1ucasPitts wrote:
2020-04-10 00:05
Is it possible to add a statement to the top of an incoming email indicating whether or not the message was sent with TLS?

Similar to https://www.hmailserver.com/forum/viewt ... =7&t=29777 but checking whether or not the connection was encrypted.

I imagine you would need to search the headers for ESMTPS or TLS or something similar. A securely transferred email usually has something like the following: "Received: from ExternalServer (ExternalServer [1.2.3.4]) by my.mailserver.com with ESMTPS (version=TLSv1.2 cipher=ECDHE-RSA-AES256-GCM-SHA384 bits=256) ;"

Thanks for your help!
Probably the most current "Received:" header in the email like this:

Code: Select all

Received: from fullcirclecharity.com (fullcirclecharity.com [51.15.67.79]) by mx.acme.inc
 with ESMTPS (version=TLSv1.2 cipher=ECDHE-RSA-AES256-GCM-SHA384 bits=256) ;
 Thu, 9 Apr 2020 18:36:01 +0200
I may have some code I can adapt ... tomorrow ...
SørenR.

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

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

Re: Add TLS statement to email

Post by RvdH » 2020-04-10 00:53

What header you gonna check? A message can have multiple Received headers, it can be send true a insecure server to a secure server and then finally thru a insecure server again
Here you find a way to loop thru the received headers

Few regex you could use,
this first only matched TLS1 and TLS1.1 (insecure, depreciated versions)

Code: Select all

\b(?!(?:TLSv1\.2|TLSv1\.3))(TLSv1\.1|TLSv1)\b
Match all (known, today) TLS versions

Code: Select all

\b(TLSv1(?:\.[123])?)\b
basic example

Code: Select all

Dim i
For i = oHeaders.Count -1 To 0 Step -1

	dim oHeader
	Set oHeader =oHeaders.Item(i)

	EventLog.Write("Header found: " + oHeader.Name)

	dim strRegEx : strRegEx = "\b(TLSv1(?:\.[123])?)\b"
	' Check if this is a header which we need.
	if LCase(oHeader.Name) = "received" Then
		If Lookup(strRegEx, oHeader.Value) Then
		  ' TLS found, do your message writing here 
		End If
	End If

Next

Code: Select all

Function Lookup(strRegEx, strMatch) : Lookup = False
   If strRegEx = "" Then Exit Function
   With CreateObject("VBScript.RegExp")
      .Pattern = strRegEx
      .Global = False
      .MultiLine = True
      .IgnoreCase = True
      If .Test(strMatch) Then Lookup = True
   End With
End Function
The code to add a warning can be adopted from the topic you referred to

In my opinion, if you like to put a message, you should only do that for insecure mails, i think otherwise you are writing messages to 90% of nowadays (valid) mails send :shock:
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

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

Re: Add TLS statement to email

Post by SorenR » 2020-04-10 11:45

when you use "headervalue" it is always the last one - the one added by your mailserver...

I've been using that for years until I dropped my Backup-mx last year.
I made a function to check the IP of the server delivering to the Backup-mx against my autoban list. Just to close a possible backdoor ;-)
SørenR.

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

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

Re: Add TLS statement to email

Post by SorenR » 2020-04-10 12:38

On my way out the door but perhaps something like this should do it?

UNTESTED!

Code: Select all

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 IsTLSMail(oMessage) : IsTLSMail = ""
    Dim strRegEx, oMatch, oMatches

    strRegEx = ".*\(version=(.*)\).*"
    Set oMatches = oLookup(strRegEx, oMessage.HeaderValue("Received"), False)
    For Each oMatch In oMatches
        If oMatch.SubMatches.Count > 0 Then
            IsTLSMail = oMatch.SubMatches(0)
        End If
    Next

    Set oMatch = Nothing
    Set oMatches = Nothing
End Function

Sub OnAcceptMessage(oClient, oMessage)
    Dim a, strTMP
    strTMP = IsTLSMail(oMessage)
    If strTMP <> "" Then
        a = Split(strTMP, " ")
        EventLog.Write( "version=" & a(0) )
        EventLog.Write( a(1) )
        EventLog.Write( a(2) )
    End If
End Sub    
SørenR.

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

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

Re: Add TLS statement to email

Post by SorenR » 2020-04-10 12:58

SorenR wrote:
2020-04-10 11:45
when you use "headervalue" it is always the last one - the one added by your mailserver...

I've been using that for years until I dropped my Backup-mx last year.
I made a function to check the IP of the server delivering to the Backup-mx against my autoban list. Just to close a possible backdoor ;-)
Lacking a better place to place this script... Admin can move as needed...

Code: Select all

Private Const ADMIN = "Administrator"
Private Const PASSWORD = "secret"
Private Const BACKUPMX = "mx.acme.inc"

Function INET_NTOA(strIP)
    '
    '   The inet_ntoa() function converts the specified Internet host address
    '   to a string in the Internet standard dot notation.
    '
    Dim a, i, N : N = 0
    a = Split(strIP, ".")
    For i = 0 To UBound(a)
        N = N + CLng( a(i) ) * ( 256 ^ (3 - i) )
    Next
    INET_NTOA = N
End Function

Function INET_ATON(N)
    '
    '   The inet_aton() function converts the specified string, in the Internet
    '   standard dot notation, to an Internet host address.
    '
    Dim a(2), i
    For i = 2 To 0 Step -1
        a(i) = Int(N - ( 256 * Int(N / 256)))
        N = Int(N / 256)
    Next
    INET_ATON = N & "." & a(0) & "." & a(1) & "." & a(2)
End Function

Function Lookup(strRegEx, strMatch) : Lookup = False
    If strRegEx = "" Then Exit Function
    With CreateObject("VBScript.RegExp")
        .Pattern = strRegEx
        .Global = False
        .MultiLine = True
        .IgnoreCase = True
        If .Test(strMatch) Then Lookup = True
    End With
End Function

Function oLookup(strRegEx, strMatch, bGlobal)
    If strRegEx = "" Then strRegEx = StrReverse(strMatch)
    With CreateObject("VBScript.RegExp")
        .Pattern = strRegEx
        .Global = bGlobal
        .MultiLine = True
        .IgnoreCase = True
        Set oLookup = .Execute(strMatch)
    End With
End Function

Function getXServer(oClient, oMessage)
    Dim i, a, strTo, strOriginalTo, strIP, strRegEx, oMatch, oMatches
    If Lookup("from " & BACKUPMX, oMessage.HeaderValue("Received")) Then
        For i = 0 To oMessage.Headers.Count-1
            If (oMessage.Headers(i).Name = "Received") Then
                If Lookup("by " & BACKUPMX & " with", oMessage.Headers(i).Value) Then
                    a = Split( oMessage.Headers(i).Value, " " )
                    oMessage.HeaderValue("X-Envelope-HELO") = Trim(a(1))
                    strRegEx = "(?:\[)((?:[0-9]{1,3}\.){3}[0-9]{1,3})(?:\])"
                    Set oMatches = oLookup(strRegEx, oMessage.Headers(i).Value, False)
                    For Each oMatch In oMatches
                        If oMatch.SubMatches.Count > 0 Then
                            oMessage.HeaderValue("X-Envelope-IPAddress") = oMatch.SubMatches(0)
                        Else
                            oMessage.HeaderValue("X-Envelope-IPAddress") = ""
                        End If
                    Next
                    Exit For
                End If
            End If
        Next
    Else
        oMessage.HeaderValue("X-Envelope-HELO") = Trim(oClient.HELO)
        oMessage.HeaderValue("X-Envelope-IPAddress") = Trim(oClient.IPAddress)
    End If
    For i = 0 To oMessage.Recipients.Count-1
        If (i = 0) Then
            strTo = oMessage.Recipients(i).Address
            strOriginalTo = oMessage.Recipients(i).OriginalAddress
        Else
            strTo = strTo & ", " & oMessage.Recipients(i).Address
            strOriginalTo = strOriginalTo & ", " & oMessage.Recipients(i).OriginalAddress
        End If
    Next
    oMessage.HeaderValue("X-Envelope-To") = strTo
    oMessage.HeaderValue("X-Envelope-OriginalTo") = strOriginalTo
    oMessage.HeaderValue("X-Envelope-From") = oMessage.FromAddress
    oMessage.Save
    Set oMatch = Nothing
    Set oMatches = Nothing
End Function

Function isBanned(oMessage) : isBanned = False
    Dim a, strIP, strLowerIP, strUpperIP, strRegEx, oMatch, oMatches
    Dim oApp : Set oApp = CreateObject("hMailServer.Application")
    Call oApp.Authenticate(ADMIN, PASSWORD)
    strIP = INET_NTOA(oMessage.HeaderValue("X-Envelope-IPAddress"))
    For a = 0 To oApp.Settings.SecurityRanges.Count-1
        If (oApp.Settings.SecurityRanges.Item(a).Priority = 20) Then
            strLowerIP = INET_NTOA(oApp.Settings.SecurityRanges.Item(a).LowerIP)
            strUpperIP = INET_NTOA(oApp.Settings.SecurityRanges.Item(a).UpperIP)
            If (strUpperIP >= strIP) And (strIP >= strLowerIP) Then
                isBanned = True
                Set oApp = Nothing
                Set oMatch = Nothing
                Set oMatches = Nothing
                Exit Function
            End If
        End If
    Next
    Set oApp = Nothing
    Set oMatch = Nothing
    Set oMatches = Nothing
End Function

Sub OnAcceptMessage(oClient, oMessage)
    Dim Client_IP, Client_HELO
    '
    '   Add X-Envelope... headers
    '
    Call getXServer(oClient, oMessage)
    Client_IP = oMessage.HeaderValue("X-Envelope-IPAddress")
    Client_HELO = oMessage.HeaderValue("X-Envelope-HELO")
    '
    '   Check for banned sender via Backup-MX ?
    '
    If (oClient.IPAddress <> Client_IP) Then
        If isBanned(oMessage) Then
            Result.Value = 2
            Result.Message = "5.3.0 [Origin Banned] The SMTP service (" & Client_HELO & ") originating on IP address (" & Client_IP & ") is not welcome here."
            Exit Sub
        End If
    End If
End Sub
SørenR.

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

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

Re: Add TLS statement to email

Post by SorenR » 2020-04-10 16:01

Version 0.002

Since VBScript per default use "ByVar" when parsing parameters to functions I decided to use "ByRef" with "Function IsTLSMail" to obtain a boolean response AND updating three variables in one go :idea: 8)

Code: Select all

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 IsTLSMail(oMessage, ByRef strTLS, ByRef strCipher, ByRef iBits) : IsTLSMail = False
    Dim strRegEx, oMatch, oMatches
    strRegEx = ".*\(version=(.*) cipher=(.*) bits=([0-9]{0,4})\).*"
    Set oMatches = oLookup(strRegEx, oMessage.HeaderValue("Received"), False)
    For Each oMatch In oMatches
        If oMatch.SubMatches.Count > 0 Then
            IsTLSMail = True
            strTLS = oMatch.SubMatches(0)
            strCipher = oMatch.SubMatches(1)
            iBits = oMatch.SubMatches(2)
        End If
    Next
    Set oMatch = Nothing
    Set oMatches = Nothing
End Function

Sub OnAcceptMessage(oClient, oMessage)
    Dim strTLS, strCipher, iBits
    EventLog.Write( oMessage.HeaderValue("Received") )
    If IsTLSMail(oMessage, strTLS, strCipher, iBits) Then
        EventLog.Write( "version=" & strTLS )
        EventLog.Write( "cipher=" & strCipher )
        EventLog.Write( "bits=" & iBits )
    End If
End Sub    
SørenR.

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

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

Re: Add TLS statement to email

Post by RvdH » 2020-04-10 16:26

SorenR wrote:
2020-04-10 11:45
when you use "headervalue" it is always the last one - the one added by your mailserver...
Unless you loop the headers :!: :?:
I assume he only needs the last received (topmost) header though, so your method works....but i think it will also match SSL3, not only TLS
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

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

Re: Add TLS statement to email

Post by SorenR » 2020-04-10 16:56

RvdH wrote:
2020-04-10 16:26
SorenR wrote:
2020-04-10 11:45
when you use "headervalue" it is always the last one - the one added by your mailserver...
Unless you loop the headers :!: :?:
I assume he only needs the last received (topmost) header though, so your method works....but i think it will also match SSL3, not only TLS
Script will only flag TLS ( 5.6.8 )

hmailserver\source\Server\SMTP\SMTPMessageHeaderCreator.cpp(127):

Code: Select all

      if (is_tls_)
         cipher_line.Format(_T("\t(version=%s cipher=%s bits=%d)\r\n"), String(cipher_info_.GetVersion()).c_str(), String(cipher_info_.GetName()).c_str(), cipher_info_.GetBits());
SørenR.

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

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

Re: Add TLS statement to email

Post by RvdH » 2020-04-10 17:27

version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES256-SHA bits=256

but nog biggie, SSL3 should be disabled by default nowadays
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

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

Re: Add TLS statement to email

Post by SorenR » 2020-04-10 17:31

RvdH wrote:
2020-04-10 17:27
version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES256-SHA bits=256

but nog biggie, SSL3 should be disabled by default nowadays
Oh well... :mrgreen:
SørenR.

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

1ucasPitts
New user
New user
Posts: 8
Joined: 2014-08-27 17:06

Re: Add TLS statement to email

Post by 1ucasPitts » 2020-04-11 01:53

Thank you all so much for the replies. I will try these out, and then report back. Thanks again!

Post Reply