rmail-spam-filter.el [plain text]
(require 'rmail)
(if (> emacs-major-version 20)
(require 'rmailsum)
(if (not (fboundp 'rmail-make-summary-line)) (load-library "rmailsum")))
(defvar bbdb/mail_auto_create_p)
(defvar rmail-summary-mode-map)
(eval-when-compile
(require 'cl))
(defgroup rmail-spam-filter nil
"Spam filter for RMAIL, the mail reader for Emacs."
:group 'rmail)
(defcustom rmail-use-spam-filter nil
"*Non-nil to activate the rmail spam filter.
Specify `rsf-definitions-alist' to define what you consider spam
emails."
:type 'boolean
:group 'rmail-spam-filter )
(defcustom rsf-file "~/XRMAIL-SPAM"
"*Name of rmail file for optionally saving some of the spam.
Spam may be either just deleted, or saved in a separate spam file to
be looked at at a later time. Whether the spam is just deleted or
also saved in a separete spam file is specified for each definition of
spam, as one of the fields of `rsf-definitions-alist'"
:type 'string
:group 'rmail-spam-filter )
(defcustom rsf-no-blind-cc nil
"*Non-nil to treat blind CC (no To: header) as spam."
:type 'boolean
:group 'rmail-spam-filter )
(defcustom rsf-ignore-case nil
"*Non-nil to ignore case in `rsf-definitions-alist'."
:type 'boolean
:group 'rmail-spam-filter )
(defcustom rsf-beep nil
"*Non-nil to beep if spam is found."
:type 'boolean
:group 'rmail-spam-filter )
(defcustom rsf-sleep-after-message 2.0
"*Seconds to wait after display of message that spam was found."
:type 'number
:group 'rmail-spam-filter )
(defcustom rsf-min-region-to-spam-list 7
"*Minimum size of region that you can add to the spam list.
This is a size limit on text that you can specify as
indicating a message is spam. The aim is to avoid
accidentally adding a too short region, which would result
in false positive identification of spam."
:type 'integer
:group 'rmail-spam-filter )
(defcustom rsf-auto-delete-spam-bbdb-entries nil
"*Non-nil to make sure no entries are made in bbdb for spam emails.
This is done in two ways: (1) bbdb is made not to auto-create entries
for messages that are deleted by the `rmail-spam-filter', (2) when a
message is deleted in rmail, the user is offered to delete the
sender's bbdb entry as well if it was created at the same day. Note
that Emacs needs to be restarted after setting this option for it to
take an effect."
:type 'boolean
:group 'rmail-spam-filter )
(defcustom rsf-autosave-newly-added-definitions nil
"*Non-nil to auto save new spam entries.
New entries entered via the spam menu bar item are then saved to
customization file immediately after being added via the menu bar, and
do not require explicitly saving the file after adding the new
entries."
:type 'boolean
:group 'rmail-spam-filter )
(defcustom rsf-white-list nil
"*List of strings to identify valid senders.
If any rsf-white-list string matches a substring of the 'From'
header, the message is flagged as a valid, non-spam message. Example:
If your domain is emacs.com then including 'emacs.com' in your
rsf-white-list would flag all mail from your colleagues as
valid."
:type '(repeat string)
:group 'rmail-spam-filter )
(defcustom rsf-definitions-alist nil
"*Alist matching strings defining what messages are considered spam.
Each definition may contain specifications of one or more of the
elements {subject, sender, recipients or contents}, as well as a
definition of what to do with the spam (action item). A spam e-mail
is defined as one that fits all of the specified elements of any one
of the spam definitions. The strings that specify spam subject,
sender, etc, may be regexp. For example, to specify that the subject
may be either 'this is spam' or 'another spam', use the regexp: 'this
is spam\\|another spam' (without the single quotes). To specify that
if the contents contain both this and that the message is spam,
specify 'this\\&that' in the appropriate spam definition field."
:type '(repeat
(list :format "%v"
(cons :format "%v" :value (from . "")
(const :format "" from)
(string :tag "From" ""))
(cons :format "%v" :value (to . "")
(const :format "" to)
(string :tag "To" ""))
(cons :format "%v" :value (subject . "")
(const :format "" subject)
(string :tag "Subject" ""))
(cons :format "%v" :value (content-type . "")
(const :format "" content-type)
(string :tag "Content-Type" ""))
(cons :format "%v" :value (contents . "")
(const :format "" contents)
(string :tag "Contents" ""))
(cons :format "%v" :value (action . output-and-delete)
(const :format "" action)
(choice :tag "Action selection"
(const :tag "output to spam folder and delete" output-and-delete)
(const :tag "delete spam" delete-spam)
))
))
:group 'rmail-spam-filter)
(defvar rsf-scanning-messages-now nil
"Non-nil when `rmail-spam-filter' scans messages.
This is for interaction with `rsf-bbdb-auto-delete-spam-entries'.")
(defun check-field (field-symbol message-data definition result)
"Check if field-symbol is in `rsf-definitions-alist'.
Capture maybe-spam and this-is-a-spam-email in a cons in result,
where maybe-spam is in first and this-is-a-spam-email is in rest.
The values are returned by destructively changing result.
If FIELD-SYMBOL field does not exist AND is not specified,
this may still be spam due to another element...
if (first result) is nil, we already have a contradiction in another
field"
(let ((definition-field (cdr (assoc field-symbol definition))))
(if (and (first result) (> (length definition-field) 0))
(if (and message-data
(string-match definition-field message-data))
(setf (rest result) t)
(setf (first result) nil)))))
(defun rmail-spam-filter (msg)
"Return nil if msg is spam based on rsf-definitions-alist.
If spam, optionally output msg to a file `rsf-file' and delete
it from rmail file. Called for each new message retrieved by
`rmail-get-new-mail'."
(let ((old-message)
(return-value)
(this-is-a-spam-email)
(maybe-spam)
(message-sender)
(message-recipients)
(message-subject)
(message-content-type)
(num-spam-definition-elements)
(num-element 0)
(exit-while-loop nil)
(saved-case-fold-search case-fold-search)
(save-current-msg)
(rsf-saved-bbdb/mail_auto_create_p nil)
)
(setq rsf-saved-bbdb/mail_auto_create_p 'bbdb/mail_auto_create_p)
(setq bbdb/mail_auto_create_p nil)
(setq rsf-scanning-messages-now t)
(save-excursion
(save-restriction
(setq this-is-a-spam-email nil)
(save-restriction
(goto-char (rmail-msgbeg msg))
(narrow-to-region (point) (progn (search-forward "\n\n") (point)))
(setq message-sender (mail-fetch-field "From"))
(setq message-recipients
(concat (mail-fetch-field "To")
(if (mail-fetch-field "Cc")
(concat ", " (mail-fetch-field "Cc")))))
(setq message-subject (mail-fetch-field "Subject"))
(setq message-content-type (mail-fetch-field "Content-Type"))
)
(setq num-spam-definition-elements (safe-length
rsf-definitions-alist))
(setq case-fold-search rsf-ignore-case)
(if (and rsf-no-blind-cc
(null message-recipients))
(setq exit-while-loop t
maybe-spam t
this-is-a-spam-email t))
(if (and message-sender
(let ((white-list rsf-white-list)
(found nil))
(while (and (not found) white-list)
(if (string-match (car white-list) message-sender)
(setq found t)
(setq white-list (cdr white-list))))
found))
(setq exit-while-loop t
maybe-spam nil
this-is-a-spam-email nil))
(setq maybe-spam (cons maybe-spam this-is-a-spam-email))
(while (and
(< num-element num-spam-definition-elements)
(not exit-while-loop))
(let ((definition (nth num-element rsf-definitions-alist)))
(setq maybe-spam (cons t nil))
(check-field 'from message-sender definition maybe-spam)
(check-field 'to message-recipients definition maybe-spam)
(check-field 'subject message-subject definition maybe-spam)
(check-field 'content-type message-content-type
definition maybe-spam)
(check-field 'contents
(buffer-substring
(rmail-msgbeg msg) (rmail-msgend msg))
definition maybe-spam)
(if (and (first maybe-spam) (rest maybe-spam))
(setq exit-while-loop t)
(setq num-element (+ num-element 1)))
)
)
(setq this-is-a-spam-email (rest maybe-spam)
maybe-spam (first maybe-spam))
(if (and this-is-a-spam-email maybe-spam)
(progn
(setq save-current-msg rmail-current-message)
(setq rmail-current-message msg)
(cond
((equal (cdr (assoc 'action
(nth num-element rsf-definitions-alist)))
'output-and-delete)
(progn
(rmail-output-to-rmail-file rsf-file 1 t)
(unless rmail-delete-after-output (rmail-delete-message))
))
((equal (cdr (assoc 'action
(nth num-element rsf-definitions-alist)))
'delete-spam)
(progn
(rmail-delete-message)
))
)
(setq rmail-current-message save-current-msg)
(setq bbdb/mail_auto_create_p
'rsf-saved-bbdb/mail_auto_create_p)
(setq return-value nil))
(setq return-value t))))
(setq case-fold-search saved-case-fold-search)
(setq rsf-scanning-messages-now nil)
return-value))
(defun rsf-add-subject-to-spam-list ()
(interactive)
(set-buffer rmail-buffer)
(let ((message-subject))
(setq message-subject (mail-fetch-field "Subject"))
(add-to-list 'rsf-definitions-alist
(list '(from . "")
'(to . "")
`(subject . ,message-subject)
'(content-type . "")
'(contents . "")
'(action . output-and-delete))
t)
(customize-mark-to-save 'rsf-definitions-alist)
(if rsf-autosave-newly-added-definitions
(progn
(custom-save-all)
(message "%s" (concat "added subject \n <<< \n" message-subject
" \n >>> \n to list of spam definitions. \n"
"and saved the spam definitions to file.")))
(message "%s" (concat "added subject \n <<< \n" message-subject
" \n >>> \n to list of spam definitions. \n"
"Don't forget to save the spam definitions to file using the spam
menu"))
)))
(defun rsf-add-sender-to-spam-list ()
(interactive)
(set-buffer rmail-buffer)
(let ((message-sender))
(setq message-sender (mail-fetch-field "From"))
(add-to-list 'rsf-definitions-alist
(list `(from . ,message-sender)
'(to . "")
'(subject . "")
'(content-type . "")
'(contents . "")
'(action . output-and-delete))
t)
(customize-mark-to-save 'rsf-definitions-alist)
(if rsf-autosave-newly-added-definitions
(progn
(custom-save-all)
(message "%s" (concat "added sender \n <<< \n" message-sender
" \n >>> \n to list of spam definitions. \n"
"and saved the spam definitions to file.")))
(message "%s" (concat "added sender \n <<< \n " message-sender
" \n >>> \n to list of spam definitions."
"Don't forget to save the spam definitions to file using the spam
menu"))
)))
(defun rsf-add-region-to-spam-list ()
"Add the region makred by user in the rmail buffer to spam list.
Added to spam definitions as a contents field."
(interactive)
(set-buffer rmail-buffer)
(let ((region-to-spam-list))
(if (not (and mark-active (not (= (region-beginning) (region-end)))))
(message "you need to first highlight some text in the rmail buffer")
(if (< (- (region-end) (region-beginning)) rsf-min-region-to-spam-list)
(message
(concat "highlighted region is too small; min length set by variable \n"
"rsf-min-region-to-spam-list"
" is " (number-to-string rsf-min-region-to-spam-list)))
(progn
(setq region-to-spam-list (buffer-substring (region-beginning) (region-end)))
(add-to-list 'rsf-definitions-alist
(list '(from . "")
'(to . "")
'(subject . "")
'(content-type . "")
`(contents . ,region-to-spam-list)
'(action . output-and-delete))
t)
(customize-mark-to-save 'rsf-definitions-alist)
(if rsf-autosave-newly-added-definitions
(progn
(custom-save-all)
(message "%s" (concat "added highlighted text \n <<< \n" region-to-spam-list
" \n >>> \n to list of spam definitions. \n"
"and saved the spam definitions to file.")))
(message "%s" (concat "added highlighted text \n <<< \n " region-to-spam-list
" \n >>> \n to list of spam definitions."
"Don't forget to save the spam definitions to file using the
spam menu"))
))))))
(defun rsf-customize-spam-definitions ()
(interactive)
(customize-variable (quote rsf-definitions-alist)))
(defun rsf-customize-group ()
(interactive)
(customize-group (quote rmail-spam-filter)))
(defun rsf-custom-save-all ()
(interactive)
(custom-save-all))
(define-key rmail-summary-mode-map [menu-bar spam]
(cons "Spam" (make-sparse-keymap "Spam")))
(define-key rmail-mode-map [menu-bar spam]
(cons "Spam" (make-sparse-keymap "Spam")))
(define-key rmail-summary-mode-map [menu-bar spam customize-group]
'("Browse customizations of rmail spam filter" . rsf-customize-group))
(define-key rmail-mode-map [menu-bar spam customize-group]
'("Browse customizations of rmail spam filter" . rsf-customize-group))
(define-key rmail-summary-mode-map "\C-cSg" 'rsf-customize-group)
(define-key rmail-mode-map "\C-cSg" 'rsf-customize-group)
(define-key rmail-summary-mode-map [menu-bar spam customize-spam-list]
'("Customize list of spam definitions" . rsf-customize-spam-definitions))
(define-key rmail-mode-map [menu-bar spam customize-spam-list]
'("Customize list of spam definitions" . rsf-customize-spam-definitions))
(define-key rmail-summary-mode-map "\C-cSd" 'rsf-customize-spam-definitions)
(define-key rmail-mode-map "\C-cSd" 'rsf-customize-spam-definitions)
(define-key rmail-summary-mode-map [menu-bar spam lambda] '("----"))
(define-key rmail-mode-map [menu-bar spam lambda] '("----"))
(define-key rmail-summary-mode-map [menu-bar spam my-custom-save-all]
'("save newly added spam definitions to customization file" . rsf-custom-save-all))
(define-key rmail-mode-map [menu-bar spam my-custom-save-all]
'("save newly added spam definitions to customization file" . rsf-custom-save-all))
(define-key rmail-summary-mode-map "\C-cSa" 'rsf-custom-save-all)
(define-key rmail-mode-map "\C-cSa" 'rsf-custom-save-all)
(define-key rmail-summary-mode-map [menu-bar spam add-region-to-spam-list]
'("add region to spam list" . rsf-add-region-to-spam-list))
(define-key rmail-mode-map [menu-bar spam add-region-to-spam-list]
'("add region to spam list" . rsf-add-region-to-spam-list))
(define-key rmail-summary-mode-map "\C-cSn" 'rsf-add-region-to-spam-list)
(define-key rmail-mode-map "\C-cSn" 'rsf-add-region-to-spam-list)
(define-key rmail-summary-mode-map [menu-bar spam add-sender-to-spam-list]
'("add sender to spam list" . rsf-add-sender-to-spam-list))
(define-key rmail-mode-map [menu-bar spam add-sender-to-spam-list]
'("add sender to spam list" . rsf-add-sender-to-spam-list))
(define-key rmail-summary-mode-map "\C-cSr" 'rsf-add-sender-to-spam-list)
(define-key rmail-mode-map "\C-cSr" 'rsf-add-sender-to-spam-list)
(define-key rmail-summary-mode-map [menu-bar spam add-subject-to-spam-list]
'("add subject to spam list" . rsf-add-subject-to-spam-list))
(define-key rmail-mode-map [menu-bar spam add-subject-to-spam-list]
'("add subject to spam list" . rsf-add-subject-to-spam-list))
(define-key rmail-summary-mode-map "\C-cSt" 'rsf-add-subject-to-spam-list)
(define-key rmail-mode-map "\C-cSt" 'rsf-add-subject-to-spam-list)
(defun rsf-add-content-type-field ()
"Maintain backward compatibility for `rmail-spam-filter'.
The most recent version of `rmail-spam-filter' checks the contents
field of the incoming mail to see if it spam. The format of
`rsf-definitions-alist' has therefore changed. This function
checks to see if old format is used, and if it is, it converts
`rsf-definitions-alist' to the new format. Invoked
automatically, no user input is required."
(interactive)
(if (and rsf-definitions-alist
(not (assoc 'content-type (car rsf-definitions-alist))))
(let ((result nil)
(current nil)
(definitions rsf-definitions-alist))
(while definitions
(setq current (car definitions))
(setq definitions (cdr definitions))
(setq result
(append result
(list
(list (assoc 'from current)
(assoc 'to current)
(assoc 'subject current)
(cons 'content-type "")
(assoc 'contents current)
(assoc 'action current))))))
(setq rsf-definitions-alist result)
(customize-mark-to-save 'rsf-definitions-alist)
(if rsf-autosave-newly-added-definitions
(progn
(custom-save-all)
(message (concat "converted spam definitions to new format\n"
"and saved the spam definitions to file.")))
(message (concat "converted spam definitions to new format\n"
"Don't forget to save the spam definitions to file using the
spam menu"))
))))
(provide 'rmail-spam-filter)