Andrew Pollack's Blog
Technology, Family, Entertainment, Politics, and Random Noise| Professional Services | Second Signal | Presentations | Andrew's Blog | Support |
Automatic Spam Report to Provider Agent
By Andrew Pollack on 10/29/2014 at 09:24 AM EDTThis 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
Other Recent Stories...
- 01/26/2023Better Running VirtualBox or VMWARE Virtual Machines on Windows 10+ Forgive me, Reader, for I have sinned. I has been nearly 3 years since my last blog entry. The truth is, I haven't had much to say that was worthy of more than a basic social media post -- until today. For my current work, I was assigned a new laptop. It's a real powerhouse machine with 14 processor cores and 64 gigs of ram. It should be perfect for running my development environment in a virtual machine, but it wasn't. VirtualBox was barely starting, and no matter how many features I turned off, it could ......
- 04/04/2020How many Ventilators for the price of those tanks the Pentagon didn't even want?This goes WAY beyond Trump or Obama. This is decades of poor planning and poor use of funds. Certainly it should have been addressed in the Trump, Obama, Bush, Clinton, Bush, and Reagan administrations -- all of which were well aware of the implications of a pandemic. I want a military prepared to help us, not just hurt other people. As an American I expect that with the ridiculous funding of our military might, we are prepared for damn near everything. Not just killing people and breaking things, but ......
- 01/28/2020Copyright Troll WarningThere's a copyright troll firm that has automated reverse-image searches and goes around looking for any posted images that they can make a quick copyright claim on. This is not quite a scam because it's technically legal, but it's run very much like a scam. This company works with a few "clients" that have vast repositories of copyrighted images. The trolls do a reverse web search on those images looking for hits. When they find one on a site that looks like someone they can scare, they work it like ......
- 03/26/2019Undestanding how OAUTH scopes will bring the concept of APPS to your Domino server
- 02/05/2019Toro Yard Equipment - Not really a premium brand as far as I am concerned
- 10/08/2018Will you be at the NYC Launch Event for HCL Domino v10 -- Find me!
- 09/04/2018With two big projects on hold, I suddenly find myself very available for new short and long term projects.
- 07/13/2018Who is HCL and why is it a good thing that they are now the ones behind Notes and Domino?
- 03/21/2018Domino Apps on IOS is a Game Changer. Quit holding back.
- 02/15/2018Andrew’s Proposed Gun Laws
