+ (setq spam-split-last-successful-check nil)
+ (unless spam-split-disabled
+ (let ((spam-split-group-choice spam-split-group))
+ (dolist (check specific-checks)
+ (when (stringp check)
+ (setq spam-split-group-choice check)
+ (setq specific-checks (delq check specific-checks))))
+
+ (let ((spam-split-group spam-split-group-choice))
+ (save-excursion
+ (save-restriction
+ (dolist (check spam-list-of-statistical-checks)
+ (when (and (symbolp check)
+ (or (symbol-value check)
+ (memq check specific-checks)))
+ (widen)
+ (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
+ (symbol-name check))
+ (return)))
+ ;; (progn (widen) (debug (buffer-string)))
+ (let ((list-of-checks spam-list-of-checks)
+ decision)
+ (while (and list-of-checks (not decision))
+ (let ((pair (pop list-of-checks)))
+ (when (or
+ ;; either, given specific checks, this is one of them
+ (and specific-checks (memq (car pair) specific-checks))
+ ;; or, given no specific checks, spam-use-CHECK is set
+ (and (null specific-checks) (symbol-value (car pair))))
+ (gnus-message 5 "spam-split: calling the %s function"
+ (symbol-name (cdr pair)))
+ (setq decision (funcall (cdr pair)))
+ ;; if we got a decision at all, save the current check
+ (when decision
+ (setq spam-split-last-successful-check (car pair)))
+
+ (when (eq decision 'spam)
+ (unless spam-split-symbolic-return
+ (gnus-error
+ 5
+ (format "spam-split got %s but %s is nil"
+ (symbol-name decision)
+ (symbol-name spam-split-symbolic-return))))))))
+ (if (eq decision t)
+ (if spam-split-symbolic-return-positive 'ham nil)
+ decision))))))))
+
+(defun spam-find-spam ()
+ "This function will detect spam in the current newsgroup using spam-split."
+ (interactive)
+
+ (let* ((group gnus-newsgroup-name)
+ (autodetect (gnus-parameter-spam-autodetect group))
+ (methods (gnus-parameter-spam-autodetect-methods group))
+ (first-method (nth 0 methods))
+ (articles (if spam-autodetect-recheck-messages
+ gnus-newsgroup-articles
+ gnus-newsgroup-unseen))
+ article-cannot-be-faked)
+
+ (dolist (check spam-list-of-statistical-checks)
+ (when (and (symbolp check)
+ (memq check methods))
+ (setq article-cannot-be-faked t)
+ (return)))
+
+ (when (memq 'default methods)
+ (setq article-cannot-be-faked t))
+
+ (when (and autodetect
+ (not (equal first-method 'none)))
+ (mapcar
+ (lambda (article)
+ (let ((id (spam-fetch-field-message-id-fast article))
+ (subject (spam-fetch-field-subject-fast article))
+ (sender (spam-fetch-field-from-fast article))
+ registry-lookup)
+
+ (unless id
+ (gnus-error 5 "Article %d has no message ID!" article))
+
+ (when (and id spam-log-to-registry)
+ (setq registry-lookup (spam-log-registration-type id 'incoming))
+ (when registry-lookup
+ (gnus-message
+ 9
+ "spam-find-spam: message %s was already registered incoming"
+ id)))
+
+ (let* ((spam-split-symbolic-return t)
+ (spam-split-symbolic-return-positive t)
+ (split-return
+ (or registry-lookup
+ (with-temp-buffer
+ (if article-cannot-be-faked
+ (gnus-request-article-this-buffer
+ article
+ group)
+ (spam-insert-fake-headers article))
+ (if (or (null first-method)
+ (equal first-method 'default))
+ (spam-split)
+ (apply 'spam-split methods))))))
+ (if (equal split-return 'spam)
+ (gnus-summary-mark-article article gnus-spam-mark))
+
+ (when (and id split-return spam-log-to-registry)
+ (when (zerop (gnus-registry-group-count id))
+ (gnus-registry-add-group
+ id group subject sender))
+
+ (unless registry-lookup
+ (spam-log-processing-to-registry
+ id
+ 'incoming
+ split-return
+ spam-split-last-successful-check
+ group))))))
+ articles))))
+
+(defvar spam-registration-functions
+ ;; first the ham register, second the spam register function
+ ;; third the ham unregister, fourth the spam unregister function
+ '((spam-use-blacklist nil
+ spam-blacklist-register-routine
+ nil
+ spam-blacklist-unregister-routine)
+ (spam-use-whitelist spam-whitelist-register-routine
+ nil
+ spam-whitelist-unregister-routine
+ nil)
+ (spam-use-BBDB spam-BBDB-register-routine
+ nil
+ spam-BBDB-unregister-routine
+ nil)
+ (spam-use-ifile spam-ifile-register-ham-routine
+ spam-ifile-register-spam-routine
+ spam-ifile-unregister-ham-routine
+ spam-ifile-unregister-spam-routine)
+ (spam-use-spamoracle spam-spamoracle-learn-ham
+ spam-spamoracle-learn-spam
+ spam-spamoracle-unlearn-ham
+ spam-spamoracle-unlearn-spam)
+ (spam-use-stat spam-stat-register-ham-routine
+ spam-stat-register-spam-routine
+ spam-stat-unregister-ham-routine
+ spam-stat-unregister-spam-routine)
+ ;; note that spam-use-gmane is not a legitimate check
+ (spam-use-gmane nil
+ spam-report-gmane-register-routine
+ ;; does Gmane support unregistration?
+ nil
+ nil)
+ (spam-use-bogofilter spam-bogofilter-register-ham-routine
+ spam-bogofilter-register-spam-routine
+ spam-bogofilter-unregister-ham-routine
+ spam-bogofilter-unregister-spam-routine))
+ "The spam-registration-functions list contains pairs
+associating a parameter variable with the ham and spam
+registration functions, and the ham and spam unregistration
+functions")
+
+(defun spam-classification-valid-p (classification)
+ (or (eq classification 'spam)
+ (eq classification 'ham)))
+
+(defun spam-process-type-valid-p (process-type)
+ (or (eq process-type 'incoming)
+ (eq process-type 'process)))
+
+(defun spam-registration-check-valid-p (check)
+ (assoc check spam-registration-functions))
+
+(defun spam-unregistration-check-valid-p (check)
+ (assoc check spam-registration-functions))
+
+(defun spam-registration-function (classification check)
+ (let ((flist (cdr-safe (assoc check spam-registration-functions))))
+ (if (eq classification 'spam)
+ (nth 1 flist)
+ (nth 0 flist))))
+
+(defun spam-unregistration-function (classification check)
+ (let ((flist (cdr-safe (assoc check spam-registration-functions))))
+ (if (eq classification 'spam)
+ (nth 3 flist)
+ (nth 2 flist))))
+
+(defun spam-list-articles (articles classification)
+ (let ((mark-check (if (eq classification 'spam)
+ 'spam-group-spam-mark-p
+ 'spam-group-ham-mark-p))
+ list mark-cache-yes mark-cache-no)
+ (dolist (article articles)
+ (let ((mark (gnus-summary-article-mark article)))
+ (unless (memq mark mark-cache-no)
+ (if (memq mark mark-cache-yes)
+ (push article list)
+ ;; else, we have to actually check the mark
+ (if (funcall mark-check
+ gnus-newsgroup-name
+ mark)
+ (progn
+ (push article list)
+ (push mark mark-cache-yes))
+ (push mark mark-cache-no))))))
+ list))
+
+(defun spam-register-routine (classification
+ check
+ &optional unregister
+ specific-articles)
+ (when (and (spam-classification-valid-p classification)
+ (spam-registration-check-valid-p check))
+ (let* ((register-function
+ (spam-registration-function classification check))
+ (unregister-function
+ (spam-unregistration-function classification check))
+ (run-function (if unregister
+ unregister-function
+ register-function))
+ (log-function (if unregister
+ 'spam-log-undo-registration
+ 'spam-log-processing-to-registry))
+ article articles)
+
+ (when run-function
+ ;; make list of articles, using specific-articles if given
+ (setq articles (or specific-articles
+ (spam-list-articles
+ gnus-newsgroup-articles
+ classification)))
+ ;; process them
+ (gnus-message 5 "%s %d %s articles with classification %s, check %s"
+ (if unregister "Unregistering" "Registering")
+ (length articles)
+ (if specific-articles "specific" "")
+ (symbol-name classification)
+ (symbol-name check))
+ (funcall run-function articles)
+ ;; now log all the registrations (or undo them, depending on unregister)
+ (dolist (article articles)
+ (funcall log-function
+ (spam-fetch-field-message-id-fast article)
+ 'process
+ classification
+ check
+ gnus-newsgroup-name))))))
+
+;;; log a ham- or spam-processor invocation to the registry
+(defun spam-log-processing-to-registry (id type classification check group)
+ (when spam-log-to-registry
+ (if (and (stringp id)
+ (stringp group)
+ (spam-process-type-valid-p type)
+ (spam-classification-valid-p classification)
+ (spam-registration-check-valid-p check))
+ (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
+ (cell (list classification check group)))
+ (push cell cell-list)
+ (gnus-registry-store-extra-entry
+ id
+ type
+ cell-list))
+
+ (gnus-error 5 (format "%s called with bad ID, type, classification, check, or group"
+ "spam-log-processing-to-registry")))))
+
+;;; check if a ham- or spam-processor registration has been done
+(defun spam-log-registered-p (id type)
+ (when spam-log-to-registry
+ (if (and (stringp id)
+ (spam-process-type-valid-p type))
+ (cdr-safe (gnus-registry-fetch-extra id type))
+ (progn
+ (gnus-error 5 (format "%s called with bad ID, type, classification, or check"
+ "spam-log-registered-p"))
+ nil))))
+
+;;; check what a ham- or spam-processor registration says
+;;; returns nil if conflicting registrations are found
+(defun spam-log-registration-type (id type)
+ (let ((count 0)
+ decision)
+ (dolist (reg (spam-log-registered-p id type))
+ (let ((classification (nth 0 reg)))
+ (when (spam-classification-valid-p classification)
+ (when (and decision
+ (not (eq classification decision)))
+ (setq count (+ 1 count)))
+ (setq decision classification))))
+ (if (< 0 count)
+ nil
+ decision)))
+
+;;; check if a ham- or spam-processor registration needs to be undone
+(defun spam-log-unregistration-needed-p (id type classification check)
+ (when spam-log-to-registry
+ (if (and (stringp id)
+ (spam-process-type-valid-p type)
+ (spam-classification-valid-p classification)
+ (spam-registration-check-valid-p check))
+ (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
+ found)
+ (dolist (cell cell-list)
+ (unless found
+ (when (and (eq classification (nth 0 cell))
+ (eq check (nth 1 cell)))
+ (setq found t))))
+ found)
+ (progn
+ (gnus-error 5 (format "%s called with bad ID, type, classification, or check"
+ "spam-log-unregistration-needed-p"))
+ nil))))
+
+
+;;; undo a ham- or spam-processor registration (the group is not used)
+(defun spam-log-undo-registration (id type classification check &optional group)
+ (when (and spam-log-to-registry
+ (spam-log-unregistration-needed-p id type classification check))
+ (if (and (stringp id)
+ (spam-process-type-valid-p type)
+ (spam-classification-valid-p classification)
+ (spam-registration-check-valid-p check))
+ (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
+ new-cell-list found)
+ (dolist (cell cell-list)
+ (unless (and (eq classification (nth 0 cell))
+ (eq check (nth 1 cell)))
+ (push cell new-cell-list)))
+ (gnus-registry-store-extra-entry
+ id
+ type
+ new-cell-list))
+ (progn
+ (gnus-error 5 (format "%s called with bad ID, type, check, or group"
+ "spam-log-undo-registration"))
+ nil))))
+
+;;; set up IMAP widening if it's necessary