Andrew Pollack's Blog

Technology, Family, Entertainment, Politics, and Random Noise

Automatic Spam Report to Provider Agent

By Andrew Pollack on 10/29/2014 at 09:24 AM EDT

This morning Andy Donaldson was asking on FB for code that turned a spam email into an EML attachment for reporting to anti-spam providers. I wrote this a while back for exactly that purpose. Rather than an attachment, this just creates an email to the anti-spam provider that contains the original spam message including all of it's header information and encoded mime. Essentially, if you took the body of what I'm sending and saved it as a text document with a .EML extension it would be the same thing.

It's not perfect, but it works for me. If you feel like improving on it, go ahead. For publication, I've moved a few things to constants at the top of the initialize() sub. You could hard code these, or you could get them from the user's current workstation, or whatever you want to do.

The agent is mean to be run periodically in the mail file. It looks to the "($JunkMail)" folder for any messages the user drops there. If there are any, it processes them into the format you need to report the message and sends the report, then moves the processed spam into another folder (in my case "Handled Spam") and marks it as "READ" so it stops bothering the user.



%REM
   Agent Report Missed Spam
   Created May 9, 2013 by Andrew Pollack/thenorth
   Description: Comments for Agent
%END REM
Option Public
Option Declare
Dim session As NotesSession
Dim thisdb As NotesDatabase
Const NCT_DEBUG_OUTPUT_AS_MSGBOX = True


Sub initialize()
   ' ********************************************************
   On Error GoTo errorhandle
   ' if the debug.nsf script is in place
   ' uncomment its use in the nct_outputerror sub
   Set session = New NotesSession
   Set thisdb = session.currentdatabase
   ' ********************************************************
   
   Const EMAIL_ADDRESS_TO_REPORT_TO = "reports@spamservice.com"
   Const MY_USER_ID = "John Smith/Organization"
   Const FOLDER_AFTER_REPORTING = "Handled Spam"
   Const SPAM_SOURCE_FOLDER = "($JunkMail)"
   
   session.Convertmime = false   
   Dim doc As NotesDocument, nextdoc As notesdocument
   Dim spamfolder As NotesView   
   Dim newdoc As NotesDocument
   Dim db As NotesDatabase
   Dim rtitem As notesrichtextitem
   Set db = session.Currentdatabase
   Set spamfolder = db.getview(SPAM_SOURCE_FOLDER)
   If Not spamfolder Is Nothing Then
      Set doc = spamfolder.Getfirstdocument()
      While Not doc Is nothing
         Set nextdoc = spamfolder.Getnextdocument(doc)
         set newdoc = New NotesDocument(db)
         Set rtitem = newdoc.Createrichtextitem("body")
         Call generatedfwdrt(doc, rtitem)
         newdoc.sendto = EMAIL_ADDRESS_TO_REPORT_TO
         newdoc.copyto = ""
         newdoc.blindcopyto = ""
         If doc.hasitem("subject") Then newdoc.subject = "SPAM FWD: " & doc.subject(0)
         Call newdoc.Send(False, False)
         Call rtitem.Copyitemtodocument(doc, "sourcert")
         Call doc.Putinfolder(FOLDER_AFTER_REPORTING, true)         
         Call doc.Removefromfolder(SPAM_SOURCE_FOLDER)
         Call doc.Markread(MY_USER_ID)         
         Set doc = nextdoc
      wend
   End If
   
   
   
   ' ********************************************************
alldone:
   Exit Sub
errorhandle:
   nct_outputError("Error in sub '" & Getthreadinfo(1) & "' at " & Erl & " :" & Error$)
   Resume alldone
   ' ********************************************************
End sub


Function generatedFwdRT(doc As NotesDocument, rtitem As NotesRichTextItem) As Boolean
On Error GoTo errorhandle
   Dim hasmime As Boolean, headerobjects As Variant, rcd(4) As String, n(4) As Integer, skiprcd As Boolean
   Dim spaces As String, tmp As String, startskipping As Boolean
   Dim item As NotesItem, mimeitem As NotesMIMEEntity, st As NotesStream, txt As String, tv As Variant
   Set st = session.Createstream()
   
   ForAll i In doc.Items
      If i.type = 25 Then
         hasmime = True         
         Set mimeitem = doc.Getmimeentity(i.name)         
         If Not mimeitem Is Nothing Then
            tv = doc.Getreceiveditemtext()
            If IsArray(tv) Then
               ForAll tva In tv
                  rcd(0) = ""
                  rcd(1) = ""
                  rcd(2) = ""
                  rcd(3) = ""
                  spaces = ""
                  n(1) = InStr( tva, "by ")                  
                  n(2) = InStr( n(1) + 1 , tva, "with ")
                  n(3) = InStr( n(2) + 1, tva, ";")
                  
                  skiprcd = True
                  tmp = tva                      
                  n(1) = InStr(tmp, "by ")
                  If n(1) > 0 Then                  
                     rcd(0) = Left$(tmp, n(1) - 1)
                     tmp = Right$(tmp, Len(tmp) - Len(rcd(0)))
                  End If
                  n(2) = InStr(tmp, "with ")
                  If n(2) > 0 Then
                     rcd(1) = Left$(tmp, n(2) - 1)
                     tmp = Right$(tmp, Len(tmp) - Len(rcd(1)))
                  End If
                  n(3) = InStr(tmp, ";")
                  If n(3) > 0 Then
                     rcd(2) = Left$(tmp, n(3) - 1)
                     tmp = Right$(tmp, Len(tmp) - Len(rcd(2)))
                  End If
                  rcd(3) = FullTrim(tmp)
                  If Left$(rcd(3),1) = ";" Then
                     rcd(3) = Right$(CStr(rcd(3)), Len(rcd(3)) -1)
                  End If                      
                  Call rtitem.Appendtext("Received: " & FullTrim(rcd(0)) )
                  If Not FullTrim(rcd(0)) = "" Then
                     Call rtitem.Addnewline(1,True)
                     spaces = " "
                  End If
                  
                  If Not FullTrim(rcd(1)) = "" Then
                     Call rtitem.Appendtext(spaces & FullTrim(rcd(1)) )
                     Call rtitem.Addnewline(1,True)
                     spaces = " "
                  End If
                  
                  If Not FullTrim(rcd(2)) = "" Then                     
                     Call rtitem.Appendtext(spaces & FullTrim(rcd(2)) )
                     Call rtitem.Addnewline(1,True)
                     spaces = " "
                  End If
                  
                  If Not FullTrim(rcd(3)) = "" Then
                     Call rtitem.Appendtext(spaces & FullTrim(rcd(3)) )
                     Call rtitem.Addnewline(1,True)
                     spaces = " "
                  End If
                  
               End ForAll               
            Else
               Call rtitem.Appendtext( tv )
               Call rtitem.Addnewline(1,True)
            End If
            txt = mimeitem.headers            
            tv = Split(mimeitem.headers, Chr$(10))
            If IsArray(tv) Then
               startskipping = True
               ForAll tvi In tv                                 
                  If ((Left$(tvi,10) = "Received: ") And ( skiprcd = True)) Then
                     startskipping = True
                  Else
                     n(0) = InStr(tvi, " ")
                     n(1) = InStr(tvi, ": ")               
                     If n(1) > 0 And n(1) < n(0) Then startskipping = False
                  End If                  
                  If startskipping = False Then                     
                     If InStr(tvi, "X-Notes-Item:") = 0 Then
                        txt = Join(Split(tvi, Chr$(10)), "")
                        txt = Join(Split(tvi, Chr$(13)), "")
                        If Not FullTrim(txt) = "" Then
                           Call rtitem.Appendtext( "" & txt )
                           Call rtitem.addnewline(1, True)
                        End If
                     End If
                  End If               
               End ForAll      
            Else
               Call rtitem.Appendtext( txt )
               Call rtitem.Addnewline(1,True)
            End If
            txt = mimeitem.Contentastext   
            Call rtitem.appendtext( txt)
         End If      
      End If
   End ForAll
   
   If Not hasmime Then
      ForAll i In doc.Items
         Call rtitem.Appendtext("" & i.name & ": ")   
         If Not i.type = 25 Then
            txt = i.text      
            Call rtitem.appendtext(txt)
            Call rtitem.Addnewline(1,True)                                                               
         End If   
      End ForAll
   End If
alldone:
   Exit Function
errorhandle:
   nct_outputError("Error in function '" & GetThreadInfo(1) & "' at " & Erl & " :" & Error$)
   Resume alldone
End Function


Sub nct_outputError( txt As String)
   ' ********************************************************
   On Error GoTo errorhandle
   ' ********************************************************
   If NCT_DEBUG_OUTPUT_AS_MSGBOX Then
      MsgBox(txt)
   Else
      Print(txt)
   End if
   
   ' ********************************************************
alldone:
   Exit Sub
errorhandle:
   Msgbox("Error in sub '" & Getthreadinfo(1) & "' at " & Erl & " :" & Error$)
   Resume alldone
   ' ********************************************************
End sub


There are  - loading -  comments....



Other Recent Stories...

  1. 05/05/2016Is the growing social-sourced economy the modern back door into socialism?Is the growing social-sourced economy the modern back door into socialism? I read a really insightful post a couple of days ago that suggested the use of social network funding sites like “Go Fund Me” and “Kickstarter” have come about and gained popularity in part because the existing economy in no longer serving its purpose for anyone who isn’t already wealthy. Have the traditional ways to get new ventures funded become closed to all but a few who aren’t already connected to them and so onerous as to make ...... 
  2. 04/20/2016Want to be whitelisted? Here are some sensible rules for web site advertisingAn increasing number of websites are now detecting when users have ad-blocking enabled, and refuse to show content unless you "whitelist" their site (disable your ad-blocking for them). I think that is a fair decision on their part, it's how they pay for the site. However, if you want me (and many others) to white list your site, there are some rules you should follow. If you violate these rules, I won't whitelist your site, I'll just find content elsewhere. 1. The total space taken up by advertisements ...... 
  3. 12/30/2015Fantastic new series on Syfy called “The Expanse” – for people who love traditional science fiction[] “The Expanse” is a new science fiction series being broadcast onthe Syfy channelthis winter. It’s closely based on a series of books by author James S. A. Corey beginning with “Leviathan Wakes”. There are 5 books in the “Expanse” series so far. If you’re a fan of the novels you’ll appreciate how closely the books are followed.TIP: The first five episodes are already available on Syfy.com. If you’re having trouble getting into the characters and plot, use those to get up to speed.The worlds created for ...... 
  4. 10/20/2015My suggestion is to stay away from PayAnywhere(dot)com  
  5. 08/07/2015Here is one for you VMWARE gurus - particularly if you run ESXi without fancy drive arrays 
  6. 08/06/2015The Killer of Orphans (Orphan Documents) 
  7. 06/02/2015Homeopathic Marketing: Traveler on my Android is now calling itself VERSE. Allow me to translate that for the IBM Notes community... 
  8. 03/17/2015A review of British Airways Premium Economy Service – How to destroy customer goodwill all at once 
  9. 02/26/2015There's a bug in how @TextToTime() and @ToTime() process date strings related to international standards and browser settings. 
  10. 01/21/2015Delivering two new presentations at Developer Camp (EntwicklerCamp) 2015 in Germany 
Click here for more articles.....


pen icon Comment Entry
Subject
Your Name
Homepage
*Your Email
* Your email address is required, but not displayed.
 
Your thoughts....
 
Remember Me  

Please wait while your document is saved.