Subject: SPAM - My Solution… code/agents…
Ok… here’s what I use.
First off, check out a few articles that really helped me out in this process. The first one is http://www.dominopower.com/issues/issue200305/00001039001.html - it talks about the basic modifications to the mail template you need to do. I use their modifications to the Calendar Profile with a few modifications (like removing the “Ignore” option).
Once you have the changes made to the Calendar Profile (FYI, that allows you to set your anti-spam settings from the Tools/Prefs section, but you should be able to figure that out from the article!), you need to add the agents. They have some agents in that article as well, but I’ve tweaked them a bit to better suit my needs.
The first agent is the one that looks for the tag and acts before new mail arrives. I changed the cases as well - in the artilce they reference using “M”, “I” and “D” - I killed the Ignore, and changed “M” to “Move” and “D” to “Remove” since I’m not DELETING the messages - I’m moving them to another database for keeping for two more weeks.
Here’s that agent:
Sub Initialize
Dim Session As NotesSession
Dim DB As NotesDatabase
Dim archiveDb As NotesDatabase
Dim doc As notesdocument
Dim docProfile As NotesDocument
Dim strAction As String
Dim strFolder As String
Set Session = New NotesSession
Set doc = Session.DocumentContext
If doc.HasItem("$DNSBLSite") Then
REM Current Mail is marked as Spam
Set DB = Session.CurrentDatabase
REM Get Mail Preferences with Spam Settings
Set docProfile = db.GetProfileDocument("CalendarProfile")
If Not docProfile Is Nothing Then
REM Check whether sender is listed in personal Whitelist
If Not IsInWhiteList(db, doc, docProfile) Then
REM Get selected Action
strAction = ""
If docProfile.HasItem("SpamOptionsTX") Then
strAction = docProfile.SpamOptionsTX(0)
End If
Select Case strAction
Case "Move" 'Move to a folder
strFolder = "Spam"
REM Get Folder name
If docProfile.HasItem("SpamFolderTX") Then
strFolder = docProfile.SpamFolderTX(0)
If strFolder = "" Then
strFolder = "Spam"
End If
End If
REM Move document to folder
Call doc.PutInFolder(strFolder,True)
Call doc.RemoveFromFolder( "($Inbox)" )
Case "Remove"
Set archiveDb = New NotesDatabase(db.Server,"SpamMail.nsf")
If Not archiveDb.IsOpen Then
Call archiveDb.Create( "", "", True )
End If
Call doc.CopyToDatabase(archiveDb)
Call doc.RemovePermanently(True)
End Select
End If
End If
End If
End Sub
You also need the “IsInWhitelist” function to check against the whitelist:
Function IsInWhiteList(DB As NotesDatabase, Doc As NotesDocument, docProfile As NotesDocument) As Integer
IsInWhiteList = False
Dim docWhiteList As NotesDocument
Dim strFrom As String
Dim strTemp As String
If doc.HasItem("SMTPOriginator") Then
strFrom = Ucase(doc.SMTPOriginator(0))
Else
REM This is not an SMTP Message
Exit Function
End If
If strFrom = "" Then
If doc.HasItem("From") Then
strFrom = Ucase(doc.From(0))
Else
REM Unable to determine the sender
Exit Function
End If
End If
Forall strAllowed In docProfile.SpamWhiteListTX
If strAllowed <> "" Then
REM WhiteList may contain complete mail addresses like ‘John@domain.com’ …
If Instr(strAllowed, "@") > 0 Then
If Ucase(strAllowed) = strFrom Then
IsInWhiteList = True
Exit Forall
End If
Else
REM … or just domain names like ‘domain.com’
strTemp = Mid$(strFrom, Instr(strFrom, "@")+1)
If Ucase(strTemp) = Ucase(strAllowed) Then
IsInWhiteList = True
Exit Forall
End If
End If
End If
End Forall
End Function
You might notice that I’ve got a Mail Box on my server called “SpamMail.nsf” - this is my holding tank, which autmatically kills messages after 14 days via the replication settings.
Now, I didn’t like the way the Whitelist worked either… it was nice and all, but it was rather confusing to use for most people. So I took some code from another issue of DominoPower that had another agent to add folks to a Whitelist automatically - MUCH more convient. I still added the Whitelist tab in the Calendar Profile tab, however, so people could see who they have in their Whitelist.
http://www.dominopower.com/issues/issue200305/00001044001.html
The agent I use lookslike this…
[Declarations]
Const SpamWhiteList =“SpamWhiteListTX”
Const DNSBLSite = “X_RBL”
[Initialize]
Sub Initialize
Dim Session As notessession
Dim DB As NotesDatabase
Dim coll As NotesDocumentCollection
Dim UIWs As NotesUIWorkspace
Dim UIDoc As NotesUIDocument
Dim doc As NotesDocument
Dim docProfile As NotesDocument
Dim intChoice As Integer
Dim strFrom As String
Dim strDomain As String
Dim item As NotesItem
Dim boolFound As Integer
Set Session = New NotesSession
Set DB = Session.CurrentDatabase
Set docProfile = db.GetProfileDocument("CalendarProfile")
If docProfile Is Nothing Then
Messagebox "There is currently no profile for your mailfile available. Please click 'Tools' 'Preferences' "+_
"to create a new profile.", 16, "Unable to find profile"
Exit Sub
End If
If docProfile.HasItem(SpamWhiteList) Then
Set item = docProfile.GetFirstItem(SpamWhitelist)
Else
Set item = New NotesItem(docProfile, SpamWhiteList, "")
End If
REM Agent may be called from view or UIDocument
Set coll = DB.UnprocessedDocuments
If coll.Count = 0 Then
Set UIWs = New NotesUIWorkspace
Set UIDoc = UIWs.CurrentDocument
If Not UIDoc Is Nothing Then
Set doc = UIDoc.Document
Set coll = Nothing
Call coll.AddDocument(doc)
End If
End If
If coll.Count = 0 Then
Messagebox "Please select the sender you want to add to your Spam Whitelist.", 64, "No documents selected"
Exit Sub
End If
Set doc = coll.GetFirstDocument
Do While Not doc Is Nothing
If Not doc.HasItem(DNSBLSite) Then
Messagebox "The selected document is not flagged as Spam Message. Therefor it's not necessary to "+_
"add the sender to your Spam Whitelist.", 64, "No need to update Whitelist"
Else
If doc.HasItem("SMTPOriginator") Then
strFrom = doc.SMTPOriginator(0)
Else
strFrom = ""
End If
If strFrom = "" Then
If doc.HasItem("From") Then
strFrom = doc.From(0)
End If
End If
If strFrom = "" Then
Messagebox "The sender of the mail could not be identified with fields 'SMTPOriginator' and 'From'." +_
"Therefor it's not possible to add the sender to your Whitelist.", 16, "Sender not identified"
Else
strdomain = Mid$(strFrom, Instr(strFrom, "@")+1)
If strDomain = strFrom Then
intChoice = 7
Else
intChoice = Messagebox ("Instead of adding the single email address '"+strFrom+"' you may also add the "+_
"whole domain '"+strDomain+"'. This is quite convenient if the domain belongs to a business partner and "+_
"you often receive mails from different users within this domain '"+strDomain+"'."+Chr(10)+Chr(10)+_
"Click 'Yes' to add the domain to your whitelist."+Chr(10)+_
"Click 'No' to add the single email address to your whitelist."+Chr(10)+_
"Click 'Cancel' for no update.", 291, "Update Spam Whitelist")
Select Case intChoice
Case 6
REM Add Domain
strFrom = strDomain
Case 7
REM Add Single Address
Case Else
REM Cancel
Exit Sub
End Select
End If
boolFound = False
Forall strAllowed In item.Values
Select Case True
Case Ucase(strAllowed) = Ucase(strFrom)
boolFound = True
Messagebox "Sender '"+strFrom+"' is already listed in your Whitelist. ", 64, "No need to update Whitelist"
Exit Forall
Case Ucase(strAllowed) = Ucase(strDomain)
boolFound = True
Messagebox "Your Whitelist already contains an entry for Domain '"+strDomain+"'. As the sender '"+_
strFrom+"' also belongs to this domain it is not necessary to add this single emailaddress.", 64, _
"No need to update Whitelist"
Exit Forall
End Select
End Forall
If Not boolFound Then
Call Item.AppendToTextList(strFrom)
If docProfile.Save(False, False) Then
Messagebox "Address '"+strFrom+"' has been added to your Whitelist.", 64, "Whitelist updated"
Else
Messagebox "An error appeared while saving your updated whitelist. Please try again to update your "+_
"whitelist in some minutes. If the problem still appears please contact your Support.", 16, _
"Whitelist could not be updated!"
End If
End If
End If
End If
Set doc = coll.GetNextDocument(doc)
Loop
Print "Agent finished"
End Sub
So that takes care of most of it. But this will STILL leave untold thousands of e-mails in people’s in-boxes if you don’t do something about the Spam folder. So nightly I run the following agent (it runs on all db’s in the mail\ dir on the server)…
[Declarations]
Dim db As NotesDatabase
Dim session As notessession
Dim doc As NotesDocument
Dim docnext As NotesDocument
Dim folder As NotesView
Dim docdate As NotesDateTime
Const daysold = -14
[Initialize]
Sub Initialize
Dim RemoveDate As New NotesDateTime("")
Dim dbdir As New NotesDbDirectory("")
Set directory = session.GetDbDirectory( "FMPANOTES1/FMPA" )
Set db = dbdir.GetFirstDatabase(DATABASE)
While Not(db Is Nothing)
If Left(db.filepath,5)="mail\" Then
Call db.Open("","")
Set folder = db.GetView( "Spam" )
Set doc = folder.Getfirstdocument
Set docdate=New NotesDateTime("")
Call RemoveDate.SetNow
Call RemoveDate.AdjustDay(daysold)
Do While Not(doc Is Nothing)
docdate.LSLocalTime=doc.Created
Set docnext = folder.GetNextDocument(doc)
If doc.HasItem("$DNSBLSite") And (RemoveDate.TimeDifference(docdate)>0) Then
Call doc.remove(True)
End If
Set doc=docnext
Loop
End If
Set db= dbdir.GetNextDatabase
Wend
End Sub
Note that you could also take the code from the before mail arrives agent and actually move the ‘expired’ e-mail to another database if you wanted… but I figure 2 weeks aught to be enough for anyone. Also, I check for both the spam tag AND message date, but you don’t have to check for the spam tag… if it’s in that folder, they must not want it, right?
I’m happy to answer questions as best I can… as I said, I’m not a coder, but I ended up taking a bunch of different code and making these agents do what I needed for my situation.
I hope this helps you as much as it did me!