Working with attachments.

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
User avatar
SorenR
Senior user
Senior user
Posts: 3215
Joined: 2006-08-21 15:38
Location: Denmark

Working with attachments.

Post by SorenR » 2019-06-08 17:18

I'm exploring a bit of attachment handling as one of my users lost a word doc that was sent to her - and she did not bother to check it on receipt :roll:

Email clearly says:
The attachment %MACRO_FILE% was blocked for delivery by the e-mail server. Please contact your system administrator if you have any questions regarding this.

Administrator
Yeah... "The server is blocking the doc file and I can't get it" ... Me: "Nope, the server deleted it! Tell them to send it again and I'll switch protection off temporarely" ...

Now, IIRC hMailServer is doing it's AntiVirus stuff (including blocked attachment stuff) between OnDeliveryStart() and OnDeliverMessage() so ... If I intercept the message in OnDeliveryStart() and it matches one or more of the blocked attachments I can clone the message and forward it to a "Quarantine" account and let hMailServer do it's stuff on the original message. IIRC I can whitelist the "Quarantine" account to make it exempt from AntiVirus checking.

I also came across a thread here where someone wanted to rename certain attachments and it has not turned out to be such a straight forward task.

I'm playing with the idea to identify mails with the specific attachments and use RegEx to rename filenames directly in the .eml file and then use "oMessage.RefreshContent" to have hMailServer work with the new data.
I have no idea if it will work, there is only one way to find out 8)

Still need to play a bit with that ... In the meantime! I have a base of close to 10K SPAM mails and I have been playing :mrgreen:

Working with non-capturing groups in RegEx to get attachment filenames from Mime headers and the attachment object. I wanted to see if either can be relied on 100%.

I have in rare results seen Mime headers where the filename is NOT embedded in quotes and for some reason I fail to resolve a search string with optional quotes. Following are all embedded in quotes ...

Code: Select all

FileName:       C:\hMailServer\Data\domain.tld\spam\34\{34AB7D0A-D953-4BF1-A391-6847BE1A5B26}.eml
Match:          Content-Type: image/jpeg; name="0EYH2LypqwM.jpg"
SubMatch:       0EYH2LypqwM.jpg
Match:          Content-Disposition: attachment; filename="0EYH2LypqwM.jpg"; size=58558; creation-date="Wed, 14
SubMatch:       0EYH2LypqwM.jpg
Attachment:     0EYH2LypqwM.jpg

FileName:       C:\hMailServer\Data\domain.tld\spam\61\{61F154A2-CD3B-4EBF-B47A-D710B9E18471}.eml
Match:          Content-Disposition: attachment; filename="INVOICE-Yu-Gi-Oh.docx"
SubMatch:       INVOICE-Yu-Gi-Oh.docx
Attachment:     INVOICE-Yu-Gi-Oh.docx

FileName:       C:\hMailServer\Data\domain.tld\spam\57\{57C0AB41-3FC7-41FD-8CD5-697AF8C16EB6}.eml
Match:          Content-Type: application/octet-stream; name="SEO-pricelist.html"
SubMatch:       SEO-pricelist.html
Match:          Content-Disposition: attachment; filename="SEO-pricelist.html"
SubMatch:       SEO-pricelist.html
Attachment:     SEO-pricelist.html

FileName:       C:\hMailServer\Data\domain.tld\spam\E8\{E8C9ABA0-5B69-4D40-A53B-28D401F244FE}.eml
Match:          Content-Type: text/html; name="Card Member Document.html"
SubMatch:       Card Member Document.html
Match:          Content-Disposition: attachment; filename="Card Member Document.html"
SubMatch:       Card Member Document.html
Attachment:     Card Member Document.html

Code: Select all

Sub DoStuff(oMessage)
   Dim i, strRegEx, Match, Matches

   strRegEx = "^content-.*name=""(.*?)"".*"

   With CreateObject("Scripting.FileSystemObject")
      Set Matches = oLookup(strRegEx, .OpenTextFile(oMessage.Filename, 1).ReadAll, True)
   End With

   If (Matches.Count > 0) Or (oMessage.Attachments.Count > 0) Then
      
      WScript.Echo( "" )
'     WScript.Echo( LPad("To:", 15, " ") & vbTab & oMessage.HeaderValue("X-Envelope-To") )
'     WScript.Echo( LPad("From:", 15, " ") & vbTab & oMessage.HeaderValue("X-Envelope-From") )
'     WScript.Echo( LPad("Subject:", 15, " ") & vbTab & oMessage.Subject )
      WScript.Echo( LPad("FileName:", 15, " ") & vbTab & oMessage.Filename )

      For Each Match in Matches
         If Match.SubMatches.Count > 0 Then
            WScript.Echo( LPad("Match:", 15, " ") & vbTab & Match.Value )
            WScript.Echo( LPad("SubMatch:", 15, " ") & vbTab & Match.SubMatches(0) )
         End If
      Next

      If (oMessage.Attachments.Count > 0) Then
         For i = 0 To oMessage.Attachments.Count-1
            WScript.Echo( LPad("Attachment:", 15, " ") & vbTab & oMessage.Attachments(i).Filename )
         Next
      End If

   End If
End Sub
SørenR.

“With age comes wisdom, but sometimes age comes alone.”
- Oscar Wilde

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

Re: Working with attachments.

Post by SorenR » 2019-07-03 20:14

Changed direction a bit...

Code: Select all

Sub OnDeliveryStart(oMessage)

    If (oMessage.Attachments.Count > 0) Then
        Dim i, strBaseName, TEMPDIR : TEMPDIR = "C:\hMailServer\Temp"

        With CreateObject("Scripting.FileSystemObject")
            '
            '   Extract Base FileName from message {name}.eml
            '
            strBaseName = .GetBaseName(.GetFile(oMessage.Filename))
        End With

        For i = 0 To oMessage.Attachments.Count-1
            '
            '   Save attachments prefixed with message filename
            '
            oMessage.Attachments(i).SaveAs( TEMPDIR & "\" & strBaseName & "." & oMessage.Attachments(i).Filename )
            EventLog.Write( TEMPDIR & "\" & strBaseName & "." & oMessage.Attachments(i).Filename )
        Next

    End If

End Sub

Sub OnDeliverMessage(oMessage)

    If (oMessage.Attachments.Count > 0) Then
        Dim i, strBaseName, TEMPDIR : TEMPDIR = "C:\hMailServer\Temp"

        With CreateObject("Scripting.FileSystemObject")
            '
            '   Extract Base FileName from message {name}.eml
            '
            strBaseName = .GetBaseName(.GetFile(oMessage.Filename))
            On Error Resume Next

            For i = 0 To oMessage.Attachments.Count-1
                '
                '   Delete previously saved attachment
                '
                .DeleteFile( TEMPDIR & "\" & strBaseName & "." & oMessage.Attachments(i).Filename )
                If Err.Number <> 0 Then
                    '
                    '   No file deleted means hMailServer changed the attached file filename
                    '
                    EventLog.Write( "FILE BLOCKED BY HMAILSERVER: " & TEMPDIR & "\" & strBaseName & "." & oMessage.Attachments(i).Filename )
                    '
                    '
                End If
            Next

            On Error Goto 0
        End With

    End If

End Sub
SørenR.

“With age comes wisdom, but sometimes age comes alone.”
- Oscar Wilde

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

Re: Working with blocked attachments.

Post by SorenR » 2019-07-04 01:32

Ready for testing.

When an email is received and hMailServer block the attachment, the blocked attachment is re-attached to a cloned message and sent to Postmaster.

Code: Select all

Sub OnDeliveryStart(oMessage)
    '
    '    Check if 2'nd Run.
    '
    If (oMessage.HeaderValue("X-hMailServer-AttachmentID") <> "") Then Exit Sub
    If (oMessage.Attachments.Count > 0) Then
        Dim i, strBaseName, TEMPDIR : TEMPDIR = "C:\hMailServer\Temp"
        Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
        '
        '   1'st Run. Extract Base FileName from message {name}.eml
        '
        strBaseName = oFSO.GetBaseName(oFSO.GetFile(oMessage.Filename))
        Set oFSO = Nothing
        For i = 0 To oMessage.Attachments.Count-1
            '
            '   Save attachments prefixed with message filename
            '
            oMessage.Attachments(i).SaveAs( TEMPDIR & "\" & strBaseName & "." & oMessage.Attachments(i).Filename )
        Next
    End If
End Sub

Sub OnDeliverMessage(oMessage)

    Dim i, strBaseName, strFilename, TEMPDIR : TEMPDIR = "C:\hMailServer\Temp"
    Dim Blocked : Blocked = False
    Dim oFile, oFiles, oFolder, oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
    '
    '    Check if 2'nd Run.
    '
    If (oMessage.HeaderValue("X-hMailServer-AttachmentID") <> "") Then
        '
        '   2'nd Run re-attach blocked file(s) for Postmaster
        '
        With CreateObject("VBScript.RegExp")
            .Pattern = oMessage.HeaderValue("X-hMailServer-AttachmentID")
            Set oFolder = oFSO.GetFolder(TEMPDIR & "\")
            Set oFiles = oFolder.Files
            For Each oFile In oFiles
                '
                '    List files to re-attach.
                '
                If .Test(oFile.Name) Then 
                    oMessage.attachments.add(TEMPDIR & "\" & oFile.Name)
                    '
                    '   Delete file when attached.
                    '
                    oFSO.DeleteFile( TEMPDIR & "\" & oFile.Name )
                End If
            Next
        End With
        oMessage.Save
        Set oFile = Nothing
        Set oFiles = Nothing
        Set oFolder = Nothing
        Set oFSO = Nothing
        '
        '    We are done ...
        '
        Exit Sub
    End If
    If (oMessage.Attachments.Count > 0) Then
        strBaseName = oFSO.GetBaseName(oFSO.GetFile(oMessage.Filename))
        On Error Resume Next
        For i = 0 To oMessage.Attachments.Count-1
            '
            '    1'st Run Delete saved files
            '
            oFSO.DeleteFile( TEMPDIR & "\" & strBaseName & "." & oMessage.Attachments(i).Filename )
            '
            '    OOPS, no file to delete = attachment blocked by hMailServer
            '
            If Err.Number <> 0 Then Blocked = True
        Next
        If Blocked Then
            '
            '    Clone mail and prepare for 2'nd run to re-attach blocked file(s) for Postmaster.
            '
            With CreateObject("hMailServer.Message")
                strFilename = .Filename
                oFSO.CopyFile oMessage.Filename, strFilename, True
                .RefreshContent
                '
                '    Address to Postmaster.
                '
                .AddRecipient "Postmaster", "postmaster@acme.inc"
                .HeaderValue("Message-ID") = "<" & CStr(oMessage.ID) & "-" & Mid(oMessage.HeaderValue("Message-ID"),2)
                .HeaderValue("X-hMailServer-AttachmentID") = strBaseName
                .Save
            End With
        End If
        On Error Goto 0
        Set oFSO = Nothing
        Exit Sub
    End If
    Set oFSO = Nothing
End Sub
SørenR.

“With age comes wisdom, but sometimes age comes alone.”
- Oscar Wilde

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

Re: Working with attachments.

Post by SorenR » 2019-07-07 02:24

Update

Code: Select all

Sub OnDeliveryStart(oMessage)
    
    '   Exit Sub
    
    '
    '   If no attachments, skip!
    '
    If (oMessage.Attachments.Count = 0) Then Exit Sub
    If (oMessage.HeaderValue("X-hMailServer-AttachmentID") <> "") Then Exit Sub
    '
    EventLog.Write( "Sub OnDeliveryStart(oMessage)" )
    Dim ATTDIR : ATTDIR = "C:\hMailServer\Attachments"
    '
    Dim i, strBaseName, strFolder
    Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
    '
    '   Create unique folder.
    '
    '   Eg: oMessage.Filename = {2B1BE048-D0DA-4743-B723-0C3A2E392134}.eml
    '                  Folder = C:\hMailServer\Attachments\2B\{2B1BE048-D0DA-4743-B723-0C3A2E392134}
    '
    strBaseName = oFSO.GetBaseName(oFSO.GetFile(oMessage.Filename))
    EventLog.Write( "(1'st run) strBaseName = " & strBaseName )
    strFolder = ATTDIR & "\" & UCase(Mid(strBaseName, 2, 2))
    If Not oFSO.FolderExists(strFolder) Then oFSO.CreateFolder strFolder
    strFolder = strFolder & "\" & strBaseName
    EventLog.Write( "(1'st run) strFolder = " & strFolder )
    If Not oFSO.FolderExists(strFolder) Then oFSO.CreateFolder strFolder
    For i = 0 To oMessage.Attachments.Count-1
        EventLog.Write( "(1'st run) save attachment as " & strFolder & "\" & oMessage.Attachments(i).Filename )
        oMessage.Attachments(i).SaveAs( strFolder & "\" & oMessage.Attachments(i).Filename )
    Next
    Set oFSO = Nothing
End Sub

Sub OnDeliverMessage(oMessage)
    
    '   Exit Sub
    
    '
    '   If no attachments, skip!
    '
    If (oMessage.Attachments.Count = 0) Then Exit Sub
    '
    EventLog.Write( "Sub OnDeliverMessage(oMessage)" )
    Dim ATTDIR   : ATTDIR   = "C:\hMailServer\Attachments"
    Dim MAILNAME : MAILNAME = "Postmaster"
    Dim MAILADDR : MAILADDR = "postmaster@mydomain.tld"
    '
    Dim i, strBaseName, strFilename, strFolder, Blocked : Blocked = False
    Dim oFile, oFiles, oFolder, oFSO
    '
    '   Delete saved attachments and mark blocked attachments for handling.
    '
    If (oMessage.HeaderValue("X-hMailServer-AttachmentID") = "") Then
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        strBaseName = oFSO.GetBaseName(oFSO.GetFile(oMessage.Filename))
        strFolder = ATTDIR & "\" & UCase(Mid(strBaseName, 2, 2)) & "\" & strBaseName
        EventLog.Write( "(1'st run) strFolder = " & strFolder )
        On Error Resume Next
        For i = 0 To oMessage.Attachments.Count-1
            oFSO.DeleteFile( strFolder & "\" & oMessage.Attachments(i).Filename )
            If Err.Number = 0 Then 
                EventLog.Write( "(1'st run) delete file " & strFolder & "\" & oMessage.Attachments(i).Filename )
            Else
                Err.Clear
                Blocked = True
                EventLog.Write( "(1'st run) delete file " & strFolder & "\" & oMessage.Attachments(i).Filename & " FAILED!" )
            End If
        Next
        On Error Goto 0
        EventLog.Write( "(1'st run) Blocked = " & Blocked )
        '
        '   Send mail to Postmaster. Blocked file(s) will be attached later.
        '
        If Blocked Then
            EventLog.Write( "(1'st run) send mail to " & MAILNAME )
            With CreateObject("hMailServer.Message")
                strFilename = .Filename
                oFSO.CopyFile oMessage.Filename, strFilename, True
                .RefreshContent
                .AddRecipient MAILNAME, MAILADDR
                .HeaderValue("X-hMailServer-AttachmentID") = strBaseName
                .Subject = "[Blocked attachment] " & .Subject
                .Save
            End With
            Set oFSO = Nothing
            Exit Sub
        End If
        EventLog.Write( "(1'st run) delete folder " & strFolder )
        oFSO.DeleteFolder strFolder
        Set oFSO = Nothing
        Exit Sub
    Else
        '
        '   Clear passed attachments.
        '
        oMessage.attachments.Clear
        strBaseName = oMessage.HeaderValue("X-hMailServer-AttachmentID")
        EventLog.Write( "(2'nd run) strBaseName = " & strBaseName )
        strFolder = ATTDIR & "\" & UCase(Mid(strBaseName, 2, 2)) & "\" & strBaseName
        EventLog.Write( "(2'nd run) strFolder = " & strFolder )
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set oFolder = oFSO.GetFolder(strFolder)
        Set oFiles = oFolder.Files
        '
        '   Re-attach blocked file(s) and delete folder.
        '
        For Each oFile In oFiles
            EventLog.Write( "(2'nd run) attach file " & strFolder & "\" & oFile.Name )
            oMessage.attachments.add(strFolder & "\" & oFile.Name)
        Next
        EventLog.Write( "(2'nd run) delete folder " & strFolder )
        oFSO.DeleteFolder strFolder
'       oMessage.HeaderValue("X-hMailServer-AttachmentID").Delete
        oMessage.Save
        Set oFile = Nothing
        Set oFiles = Nothing
        Set oFolder = Nothing
        Set oFSO = Nothing
    End If
End Sub
SørenR.

“With age comes wisdom, but sometimes age comes alone.”
- Oscar Wilde

Post Reply