Add TLS statement to email

[1ucasPitts]

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!

[SorenR]

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

[RvdH]

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

[SorenR]

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

[SorenR]

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    

[SorenR]

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

[SorenR]

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

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    

[RvdH]

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

[SorenR]

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());

[RvdH]

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

but nog biggie, SSL3 should be disabled by default nowadays

[SorenR]

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

but nog biggie, SSL3 should be disabled by default nowadays

Oh well...

[1ucasPitts]

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