(const :tag "Bogofilter is not installed"))
:group 'spam-bogofilter)
+(defvar spam-bogofilter-valid 'unknown "Is the bogofilter version valid?")
+
(defcustom spam-bogofilter-header "X-Bogosity"
"The header that Bogofilter inserts in messages."
:type 'string
classification
type)))
+(defun spam-backend-article-list-property (classification
+ &optional unregister)
+ "Property name of article list with CLASSIFICATION and UNREGISTER."
+ (let* ((r (if unregister "unregister" "register"))
+ (prop (format "%s-%s" classification r)))
+ prop))
+
+(defun spam-backend-get-article-todo-list (backend
+ classification
+ &optional unregister)
+ "Get the articles to be processed for BACKEND and CLASSIFICATION.
+With UNREGISTER, get articles to be unregistered.
+This is a temporary storage function - nothing here persists."
+ (get
+ backend
+ (intern (spam-backend-article-list-property classification unregister))))
+
+(defun spam-backend-put-article-todo-list (backend classification list &optional unregister)
+ "Set the LIST of articles to be processed for BACKEND and CLASSIFICATION.
+With UNREGISTER, set articles to be unregistered.
+This is a temporary storage function - nothing here persists."
+ (put
+ backend
+ (intern (spam-backend-article-list-property classification unregister))
+ list))
+
(defun spam-backend-ham-registration-function (backend)
"Get the ham registration function for BACKEND."
(get backend 'hrf))
(spam-install-checkonly-backend 'spam-use-blackholes
'spam-check-blackholes)
-;; TODO: does anyone use hashcash? We should remove it if not.
(spam-install-checkonly-backend 'spam-use-hashcash
'spam-check-hashcash)
;; call spam-register-routine with specific articles to unregister,
;; when there are articles to unregister and the check is enabled
(when (and unregister-list (symbol-value backend))
- (spam-unregister-routine
- classification
- backend
- unregister-list))))))
+ (spam-backend-put-article-todo-list backend
+ classification
+ unregister-list
+ t))))))
;; do the non-moving backends first, then the moving ones
(dolist (backend-type '(non-mover mover))
- (dolist (classification '(spam ham))
+ (dolist (classification (spam-classifications))
(dolist (backend (spam-backend-list backend-type))
(when (spam-group-processor-p
gnus-newsgroup-name
backend
classification)
- (let ((num (spam-register-routine classification backend)))
- (when (> num 0)
- (gnus-message
- 6
- "%d %s messages were processed by backend %s."
- num
- classification
- backend)))))))
+ (spam-backend-put-article-todo-list backend
+ classification
+ (spam-list-articles
+ gnus-newsgroup-articles
+ classification))))))
+
+ (spam-resolve-registrations-routine) ; do the registrations now
;; we mark all the leftover spam articles as expired at the end
(dolist (article (spam-list-articles
;;{{{ registration/unregistration functions
+(defun spam-resolve-registrations-routine ()
+ "Go through the backends and register or unregister articles as needed."
+ (dolist (backend-type '(non-mover mover))
+ (dolist (classification (spam-classifications))
+ (dolist (backend (spam-backend-list backend-type))
+ (let ((rlist (spam-backend-get-article-todo-list
+ backend classification))
+ (ulist (spam-backend-get-article-todo-list
+ backend classification t))
+ (delcount 0))
+
+ ;; clear the old lists right away
+ (spam-backend-put-article-todo-list backend
+ classification
+ nil
+ nil)
+ (spam-backend-put-article-todo-list backend
+ classification
+ nil
+ t)
+
+ ;; eliminate duplicates
+ (dolist (article (copy-sequence ulist))
+ (when (memq article rlist)
+ (incf delcount)
+ (setq rlist (delq article rlist))
+ (setq ulist (delq article ulist))))
+
+ (unless (zerop delcount)
+ (gnus-message
+ 9
+ "%d messages were saved the trouble of unregistering and then registering"
+ delcount))
+
+ ;; unregister articles
+ (unless (zerop (length ulist))
+ (let ((num (spam-unregister-routine classification backend ulist)))
+ (when (> num 0)
+ (gnus-message
+ 6
+ "%d %s messages were unregistered by backend %s."
+ num
+ classification
+ backend))))
+
+ ;; register articles
+ (unless (zerop (length rlist))
+ (let ((num (spam-register-routine classification backend rlist)))
+ (when (> num 0)
+ (gnus-message
+ 6
+ "%d %s messages were registered by backend %s."
+ num
+ classification
+ backend)))))))))
+
(defun spam-unregister-routine (classification
- backend
- &optional specific-articles)
- (spam-register-routine classification backend t specific-articles))
+ backend
+ specific-articles)
+ (spam-register-routine classification backend specific-articles t))
(defun spam-register-routine (classification
- backend
- &optional unregister
- specific-articles)
+ backend
+ specific-articles
+ &optional unregister)
(when (and (spam-classification-valid-p classification)
(spam-backend-valid-p backend))
(let* ((register-function
classification
backend)
(funcall run-function articles)
- ;; now log all the registrations (or undo them, depending on unregister)
+ ;; now log all the registrations (or undo them, depending on
+ ;; unregister)
(dolist (article articles)
(funcall log-function
(spam-fetch-field-message-id-fast article)
classification
backend
gnus-newsgroup-name))))
- (length articles)))) ;return the number of articles processed
+ ;; return the number of articles processed
+ (length articles))))
;;; log a ham- or spam-processor invocation to the registry
(defun spam-log-processing-to-registry (id type classification backend group)
(message "Spamicity score %s" score)
(or score "0"))))
+(defun spam-verify-bogofilter ()
+ "Verify the Bogofilter version is sufficient."
+ (when (eq spam-bogofilter-valid 'unknown)
+ (setq spam-bogofilter-valid
+ (not (string-match "^bogofilter version 0\\.\\([0-9]\\|1[01]\\)\\."
+ (shell-command-to-string
+ (format "%s -V" spam-bogofilter-path))))))
+ spam-bogofilter-valid)
+
(defun spam-check-bogofilter (&optional score)
- "Check the Bogofilter backend for the classification of this message"
- (let ((article-buffer-name (buffer-name))
- (db spam-bogofilter-database-directory)
+ "Check the Bogofilter backend for the classification of this message."
+ (if (spam-verify-bogofilter)
+ (let ((article-buffer-name (buffer-name))
+ (db spam-bogofilter-database-directory)
+ return)
+ (with-temp-buffer
+ (let ((temp-buffer-name (buffer-name)))
+ (save-excursion
+ (set-buffer article-buffer-name)
+ (apply 'call-process-region
+ (point-min) (point-max)
+ spam-bogofilter-path
+ nil temp-buffer-name nil
+ (if db `("-d" ,db "-v") `("-v"))))
+ (setq return (spam-check-bogofilter-headers score))))
return)
- (with-temp-buffer
- (let ((temp-buffer-name (buffer-name)))
- (save-excursion
- (set-buffer article-buffer-name)
- (apply 'call-process-region
- (point-min) (point-max)
- spam-bogofilter-path
- nil temp-buffer-name nil
- (if db `("-d" ,db "-v") `("-v"))))
- (setq return (spam-check-bogofilter-headers score))))
- return))
+ (gnus-error "`spam.el' doesnt support obsolete bogofilter versions")))
(defun spam-bogofilter-register-with-bogofilter (articles
spam
&optional unregister)
"Register an article, given as a string, as spam or non-spam."
- (dolist (article articles)
- (let ((article-string (spam-get-article-as-string article))
- (db spam-bogofilter-database-directory)
- (switch (if unregister
- (if spam
- spam-bogofilter-spam-strong-switch
- spam-bogofilter-ham-strong-switch)
- (if spam
- spam-bogofilter-spam-switch
- spam-bogofilter-ham-switch))))
- (when (stringp article-string)
- (with-temp-buffer
- (insert article-string)
-
- (apply 'call-process-region
- (point-min) (point-max)
- spam-bogofilter-path
- nil nil nil switch
- (if db `("-d" ,db "-v") `("-v"))))))))
+ (if (spam-verify-bogofilter)
+ (dolist (article articles)
+ (let ((article-string (spam-get-article-as-string article))
+ (db spam-bogofilter-database-directory)
+ (switch (if unregister
+ (if spam
+ spam-bogofilter-spam-strong-switch
+ spam-bogofilter-ham-strong-switch)
+ (if spam
+ spam-bogofilter-spam-switch
+ spam-bogofilter-ham-switch))))
+ (when (stringp article-string)
+ (with-temp-buffer
+ (insert article-string)
+
+ (apply 'call-process-region
+ (point-min) (point-max)
+ spam-bogofilter-path
+ nil nil nil switch
+ (if db `("-d" ,db "-v") `("-v")))))))
+ (gnus-error "`spam.el' doesnt support obsolete bogofilter versions")))
(defun spam-bogofilter-register-spam-routine (articles &optional unregister)
(spam-bogofilter-register-with-bogofilter articles t unregister))
projects / elisp / gnus.git- / blobdiff