+(defun spam-classifications ()
+ "Return list of valid classifications"
+ '(spam ham))
+
+(defun spam-classification-valid-p (classification)
+ "Is CLASSIFICATION a valid spam/ham classification?"
+ (memq classification (spam-classifications)))
+
+(defun spam-backend-properties ()
+ "Return list of valid classifications."
+ '(statistical mover check hrf srf huf suf))
+
+(defun spam-backend-property-valid-p (property)
+ "Is PROPERTY a valid backend property?"
+ (memq property (spam-backend-properties)))
+
+(defun spam-backend-function-type-valid-p (type)
+ (or (eq type 'registration)
+ (eq type 'unregistration)))
+
+(defun spam-process-type-valid-p (process-type)
+ (or (eq process-type 'incoming)
+ (eq process-type 'process)))
+
+(defun spam-list-articles (articles classification)
+ (let ((mark-check (if (eq classification 'spam)
+ 'spam-group-spam-mark-p
+ 'spam-group-ham-mark-p))
+ alist mark-cache-yes mark-cache-no)
+ (dolist (article articles)
+ (let ((mark (gnus-summary-article-mark article)))
+ (unless (or (memq mark mark-cache-yes)
+ (memq mark mark-cache-no))
+ (if (funcall mark-check
+ gnus-newsgroup-name
+ mark)
+ (push mark mark-cache-yes)
+ (push mark mark-cache-no)))
+ (when (memq mark mark-cache-yes)
+ (push article alist))))
+ alist))
+
+;;}}}
+
+;;{{{ backend installation functions and procedures
+
+(defun spam-install-backend-super (backend &rest properties)
+ "Install BACKEND for spam.el.
+Accepts incoming CHECK, ham registration function HRF, spam
+registration function SRF, ham unregistration function HUF, spam
+unregistration function SUF, and an indication whether the
+backend is STATISTICAL."
+ (setq spam-backends (add-to-list 'spam-backends backend))
+ (while properties
+ (let ((property (pop properties))
+ (value (pop properties)))
+ (if (spam-backend-property-valid-p property)
+ (put backend property value)
+ (gnus-error
+ 5
+ "spam-install-backend-super got an invalid property %s"
+ property)))))
+
+(defun spam-backend-list (&optional type)
+ "Return a list of all the backend symbols, constrained by TYPE.
+When TYPE is 'non-mover, only non-mover backends are returned.
+When TYPE is 'mover, only mover backends are returned."
+ (let (list)
+ (dolist (backend spam-backends)
+ (when (or
+ (null type) ;either no type was requested
+ ;; or the type is 'mover and the backend is a mover
+ (and
+ (eq type 'mover)
+ (spam-backend-mover-p backend))
+ ;; or the type is 'non-mover and the backend is not a mover
+ (and
+ (eq type 'non-mover)
+ (not (spam-backend-mover-p backend))))
+ (push backend list)))
+ list))
+
+(defun spam-backend-check (backend)
+ "Get the check function for BACKEND.
+Each individual check may return nil, t, or a mailgroup name.
+The value nil means that the check does not yield a decision, and
+so, that further checks are needed. The value t means that the
+message is definitely not spam, and that further spam checks
+should be inhibited. Otherwise, a mailgroup name or the symbol
+'spam (depending on `spam-split-symbolic-return') is returned where
+the mail should go, and further checks are also inhibited. The
+usual mailgroup name is the value of `spam-split-group', meaning
+that the message is definitely a spam."
+ (get backend 'check))
+
+(defun spam-backend-valid-p (backend)
+ "Is BACKEND valid?"
+ (member backend (spam-backend-list)))
+
+(defun spam-backend-info (backend)
+ "Return information about BACKEND."
+ (if (spam-backend-valid-p backend)
+ (let (info)
+ (setq info (format "Backend %s has the following properties:\n"
+ backend))
+ (dolist (property (spam-backend-properties))
+ (setq info (format "%s%s=%s\n"
+ info
+ property
+ (get backend property))))
+ info)
+ (gnus-error 5 "spam-backend-info was asked about an invalid backend %s"
+ backend)))
+
+(defun spam-backend-function (backend classification type)
+ "Get the BACKEND function for CLASSIFICATION and TYPE.
+TYPE is 'registration or 'unregistration.
+CLASSIFICATION is 'ham or 'spam."
+ (if (and
+ (spam-classification-valid-p classification)
+ (spam-backend-function-type-valid-p type))
+ (let ((retrieval
+ (intern
+ (format "spam-backend-%s-%s-function"
+ classification
+ type))))
+ (funcall retrieval backend))
+ (gnus-error
+ 5
+ "%s was passed invalid backend %s, classification %s, or type %s"
+ "spam-backend-function"
+ backend
+ 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))
+
+(defun spam-backend-spam-registration-function (backend)
+ "Get the spam registration function for BACKEND."
+ (get backend 'srf))
+
+(defun spam-backend-ham-unregistration-function (backend)
+ "Get the ham unregistration function for BACKEND."
+ (get backend 'huf))
+
+(defun spam-backend-spam-unregistration-function (backend)
+ "Get the spam unregistration function for BACKEND."
+ (get backend 'suf))
+
+(defun spam-backend-statistical-p (backend)
+ "Is BACKEND statistical?"
+ (get backend 'statistical))
+
+(defun spam-backend-mover-p (backend)
+ "Is BACKEND a mover?"
+ (get backend 'mover))
+
+(defun spam-install-backend-alias (backend alias)
+ "Add ALIAS to an existing BACKEND.
+The previous backend settings for ALIAS are erased."
+
+ ;; install alias with no properties at first
+ (spam-install-backend-super alias)
+
+ (dolist (property (spam-backend-properties))
+ (put alias property (get backend property))))
+
+(defun spam-install-checkonly-backend (backend check)
+ "Install a BACKEND than can only CHECK for spam."
+ (spam-install-backend-super backend 'check check))
+
+(defun spam-install-mover-backend (backend hrf srf huf suf)
+ "Install a BACKEND than can move articles at summary exit.
+Accepts ham registration function HRF, spam registration function
+SRF, ham unregistration function HUF, spam unregistration
+function SUF. The backend has no incoming check and can't be
+statistical."
+ (spam-install-backend-super
+ backend
+ 'hrf hrf 'srf srf 'huf huf 'suf suf 'mover t))
+
+(defun spam-install-nocheck-backend (backend hrf srf huf suf)
+ "Install a BACKEND than has no check.
+Accepts ham registration function HRF, spam registration function
+SRF, ham unregistration function HUF, spam unregistration
+function SUF. The backend has no incoming check and can't be
+statistical (it could be, but in practice that doesn't happen)."
+ (spam-install-backend-super
+ backend
+ 'hrf hrf 'srf srf 'huf huf 'suf suf))
+
+(defun spam-install-backend (backend check hrf srf huf suf)
+ "Install a BACKEND.
+Accepts incoming CHECK, ham registration function HRF, spam
+registration function SRF, ham unregistration function HUF, spam
+unregistration function SUF. The backend won't be
+statistical (use `spam-install-statistical-backend' for that)."
+ (spam-install-backend-super
+ backend
+ 'check check 'hrf hrf 'srf srf 'huf huf 'suf suf))
+
+(defun spam-install-statistical-backend (backend check hrf srf huf suf)
+ "Install a BACKEND.
+Accepts incoming CHECK, ham registration function HRF, spam
+registration function SRF, ham unregistration function HUF, spam
+unregistration function SUF. The backend will be
+statistical (use `spam-install-backend' for non-statistical
+backends)."
+ (spam-install-backend-super
+ backend
+ 'check check 'statistical t 'hrf hrf 'srf srf 'huf huf 'suf suf))
+
+(defun spam-install-statistical-checkonly-backend (backend check)
+ "Install a statistical BACKEND than can only CHECK for spam."
+ (spam-install-backend-super
+ backend
+ 'check check 'statistical t))
+
+;;}}}
+
+;;{{{ backend installations
+(spam-install-checkonly-backend 'spam-use-blackholes
+ 'spam-check-blackholes)
+
+(spam-install-checkonly-backend 'spam-use-hashcash
+ 'spam-check-hashcash)
+
+(spam-install-checkonly-backend 'spam-use-spamassassin-headers
+ 'spam-check-spamassassin-headers)
+
+(spam-install-checkonly-backend 'spam-use-bogofilter-headers
+ 'spam-check-bogofilter-headers)
+
+(spam-install-checkonly-backend 'spam-use-bsfilter-headers
+ 'spam-check-bsfilter-headers)
+
+(spam-install-checkonly-backend 'spam-use-gmane-xref
+ 'spam-check-gmane-xref)
+
+(spam-install-checkonly-backend 'spam-use-regex-headers
+ 'spam-check-regex-headers)
+
+(spam-install-statistical-checkonly-backend 'spam-use-regex-body
+ 'spam-check-regex-body)
+
+;; TODO: NOTE: spam-use-ham-copy is now obsolete, use (ham spam-use-copy) instead
+(spam-install-mover-backend 'spam-use-move
+ 'spam-move-ham-routine
+ 'spam-move-spam-routine
+ nil
+ nil)
+
+(spam-install-nocheck-backend 'spam-use-copy
+ 'spam-copy-ham-routine
+ 'spam-copy-spam-routine
+ nil
+ nil)
+
+(spam-install-nocheck-backend 'spam-use-gmane
+ 'spam-report-gmane-unregister-routine
+ 'spam-report-gmane-register-routine
+ 'spam-report-gmane-register-routine
+ 'spam-report-gmane-unregister-routine)
+
+(spam-install-nocheck-backend 'spam-use-resend
+ 'spam-report-resend-register-ham-routine
+ 'spam-report-resend-register-routine
+ nil
+ nil)
+
+(spam-install-backend 'spam-use-BBDB
+ 'spam-check-BBDB
+ 'spam-BBDB-register-routine
+ nil
+ 'spam-BBDB-unregister-routine
+ nil)
+
+(spam-install-backend-alias 'spam-use-BBDB 'spam-use-BBDB-exclusive)
+
+(spam-install-backend 'spam-use-blacklist
+ 'spam-check-blacklist
+ nil
+ 'spam-blacklist-register-routine
+ nil
+ 'spam-blacklist-unregister-routine)
+
+(spam-install-backend 'spam-use-whitelist
+ 'spam-check-whitelist
+ 'spam-whitelist-register-routine
+ nil
+ 'spam-whitelist-unregister-routine
+ nil)
+
+(spam-install-statistical-backend 'spam-use-ifile
+ 'spam-check-ifile
+ 'spam-ifile-register-ham-routine
+ 'spam-ifile-register-spam-routine
+ 'spam-ifile-unregister-ham-routine
+ 'spam-ifile-unregister-spam-routine)
+
+(spam-install-statistical-backend 'spam-use-spamoracle
+ 'spam-check-spamoracle
+ 'spam-spamoracle-learn-ham
+ 'spam-spamoracle-learn-spam
+ 'spam-spamoracle-unlearn-ham
+ 'spam-spamoracle-unlearn-spam)
+
+(spam-install-statistical-backend 'spam-use-stat
+ 'spam-check-stat
+ 'spam-stat-register-ham-routine
+ 'spam-stat-register-spam-routine
+ 'spam-stat-unregister-ham-routine
+ 'spam-stat-unregister-spam-routine)
+
+(spam-install-statistical-backend 'spam-use-spamassassin
+ 'spam-check-spamassassin
+ 'spam-spamassassin-register-ham-routine
+ 'spam-spamassassin-register-spam-routine
+ 'spam-spamassassin-unregister-ham-routine
+ 'spam-spamassassin-unregister-spam-routine)
+
+(spam-install-statistical-backend 'spam-use-bogofilter
+ 'spam-check-bogofilter
+ 'spam-bogofilter-register-ham-routine
+ 'spam-bogofilter-register-spam-routine
+ 'spam-bogofilter-unregister-ham-routine
+ 'spam-bogofilter-unregister-spam-routine)
+
+(spam-install-statistical-backend 'spam-use-bsfilter
+ 'spam-check-bsfilter
+ 'spam-bsfilter-register-ham-routine
+ 'spam-bsfilter-register-spam-routine
+ 'spam-bsfilter-unregister-ham-routine
+ 'spam-bsfilter-unregister-spam-routine)
+
+(spam-install-statistical-backend 'spam-use-crm114
+ 'spam-check-crm114
+ 'spam-crm114-register-ham-routine
+ 'spam-crm114-register-spam-routine
+ 'spam-crm114-unregister-ham-routine
+ 'spam-crm114-unregister-spam-routine)
+;;}}}
+
+;;{{{ scoring and summary formatting
+(defun spam-necessary-extra-headers ()
+ "Return the extra headers spam.el thinks are necessary."
+ (let (list)
+ (when (or spam-use-spamassassin
+ spam-use-spamassassin-headers
+ spam-use-regex-headers)
+ (push 'X-Spam-Status list))
+ (when (or spam-use-bogofilter
+ spam-use-regex-headers)
+ (push 'X-Bogosity list))
+ (when (or spam-use-crm114
+ spam-use-regex-headers)
+ (push 'X-CRM114-Status list))
+ list))
+
+(defun spam-user-format-function-S (headers)
+ (when headers
+ (format "%3.2f"
+ (spam-summary-score headers spam-summary-score-preferred-header))))
+
+(defun spam-article-sort-by-spam-status (h1 h2)
+ "Sort articles by score."
+ (let (result)
+ (dolist (header (spam-necessary-extra-headers))
+ (let ((s1 (spam-summary-score h1 header))
+ (s2 (spam-summary-score h2 header)))
+ (unless (= s1 s2)
+ (setq result (< s1 s2))
+ (return))))
+ result))
+
+(defvar spam-spamassassin-score-regexp
+ ".*\\b\\(?:score\\|hits\\)=\\(-?[0-9.]+\\)"
+ "Regexp matching SpamAssassin score header.
+The first group must match the number.")
+
+(defun spam-extra-header-to-number (header headers)
+ "Transform an extra HEADER to a number, using list of HEADERS.
+Note this has to be fast."
+ (let ((header-content (gnus-extra-header header headers)))
+ (if header-content
+ (cond
+ ((eq header 'X-Spam-Status)
+ (string-to-number (gnus-replace-in-string
+ header-content
+ spam-spamassassin-score-regexp
+ "\\1")))
+ ;; for CRM checking, it's probably faster to just do the string match
+ ((string-match "( pR: \\([0-9.-]+\\)" header-content)
+ (- (string-to-number (match-string 1 header-content))))
+ ((eq header 'X-Bogosity)
+ (string-to-number (gnus-replace-in-string
+ (gnus-replace-in-string
+ header-content
+ ".*spamicity=" "")
+ ",.*" "")))
+ (t nil))
+ nil)))
+
+(defun spam-summary-score (headers &optional specific-header)
+ "Score an article for the summary buffer, as fast as possible.
+With SPECIFIC-HEADER, returns only that header's score.
+Will not return a nil score."
+ (let (score)
+ (dolist (header
+ (if specific-header
+ (list specific-header)
+ (spam-necessary-extra-headers)))
+ (setq score
+ (spam-extra-header-to-number header headers))
+ (when score
+ (return)))
+ (or score 0)))
+
+(defun spam-generic-score (&optional recheck)
+ "Invoke whatever scoring method we can."
+ (interactive "P")
+ (cond
+ ((or spam-use-spamassassin spam-use-spamassassin-headers)
+ (spam-spamassassin-score recheck))
+ ((or spam-use-bsfilter spam-use-bsfilter-headers)
+ (spam-bsfilter-score recheck))
+ (spam-use-crm114
+ (spam-crm114-score))
+ (t (spam-bogofilter-score recheck))))
+;;}}}
+
+;;{{{ set up widening, processor checks
+
+;;; set up IMAP widening if it's necessary
+(defun spam-setup-widening ()
+ (when (spam-widening-needed-p)
+ (setq nnimap-split-download-body-default t)))
+
+(defun spam-widening-needed-p (&optional force-symbols)
+ (let (found)
+ (dolist (backend (spam-backend-list))
+ (when (and (spam-backend-statistical-p backend)
+ (or (symbol-value backend)
+ (memq backend force-symbols)))
+ (setq found backend)))
+ found))
+