1 ;;; spam.el --- Identifying spam
2 ;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
26 ;;; This module addresses a few aspects of spam control under Gnus. Page
27 ;;; breaks are used for grouping declarations and documentation relating to
28 ;;; each particular aspect.
30 ;;; The integration with Gnus is not yet complete. See various `FIXME'
31 ;;; comments, below, for supplementary explanations or discussions.
33 ;;; Several TODO items are marked as such
35 ;; TODO: spam scores, detection of spam in newsgroups, cross-server splitting,
36 ;; remote processing, training through files
40 (eval-when-compile (require 'cl))
44 (require 'gnus-uu) ; because of key prefix issues
45 ;;; for the definitions of group content classification and spam processors
47 (require 'message) ;for the message-fetch-field functions
49 ;; for nnimap-split-download-body-default
50 (eval-when-compile (require 'nnimap))
54 (autoload 'query-dig "dig"))
56 ;; autoload spam-report
58 (autoload 'spam-report-gmane "spam-report"))
60 ;; autoload gnus-registry
62 (autoload 'gnus-registry-group-count "gnus-registry")
63 (autoload 'gnus-registry-add-group "gnus-registry")
64 (autoload 'gnus-registry-store-extra-entry "gnus-registry")
65 (autoload 'gnus-registry-fetch-extra "gnus-registry"))
69 (autoload 'query-dns "dns"))
74 "Spam configuration.")
76 (defcustom spam-directory (nnheader-concat gnus-directory "spam/")
77 "Directory for spam whitelists and blacklists."
81 (defcustom spam-move-spam-nonspam-groups-only t
82 "Whether spam should be moved in non-spam groups only.
83 When t, only ham and unclassified groups will have their spam moved
84 to the spam-process-destination. When nil, spam will also be moved from
89 (defcustom spam-process-ham-in-nonham-groups nil
90 "Whether ham should be processed in non-ham groups."
94 (defcustom spam-log-to-registry nil
95 "Whether spam/ham processing should be logged in the registry."
99 (defcustom spam-split-symbolic-return nil
100 "Whether `spam-split' should work with symbols or group names."
104 (defcustom spam-split-symbolic-return-positive nil
105 "Whether `spam-split' should ALWAYS work with symbols or group names.
106 Do not set this if you use `spam-split' in a fancy split
111 (defcustom spam-process-ham-in-spam-groups nil
112 "Whether ham should be processed in spam groups."
116 (defcustom spam-mark-only-unseen-as-spam t
117 "Whether only unseen articles should be marked as spam in spam groups.
118 When nil, all unread articles in a spam group are marked as
119 spam. Set this if you want to leave an article unread in a spam group
120 without losing it to the automatic spam-marking process."
124 (defcustom spam-mark-ham-unread-before-move-from-spam-group nil
125 "Whether ham should be marked unread before it's moved.
126 The article is moved out of a spam group according to ham-process-destination.
127 This variable is an official entry in the international Longest Variable Name
132 (defcustom spam-disable-spam-split-during-ham-respool nil
133 "Whether `spam-split' should be ignored while resplitting ham.
134 This is useful to prevent ham from ending up in the same spam
135 group after the resplit. Don't set this to t if you have `spam-split' as the
136 last rule in your split configuration."
140 (defcustom spam-autodetect-recheck-messages nil
141 "Should spam.el recheck all meessages when autodetecting?
142 Normally this is nil, so only unseen messages will be checked."
146 (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
147 "The location of the whitelist.
148 The file format is one regular expression per line.
149 The regular expression is matched against the address."
153 (defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
154 "The location of the blacklist.
155 The file format is one regular expression per line.
156 The regular expression is matched against the address."
160 (defcustom spam-use-dig t
161 "Whether `query-dig' should be used instead of `query-dns'."
165 (defcustom spam-use-gmane-xref nil
166 "Whether the Gmane spam xref should be used by `spam-split'."
170 (defcustom spam-use-blacklist nil
171 "Whether the blacklist should be used by `spam-split'."
175 (defcustom spam-blacklist-ignored-regexes nil
176 "Regular expressions that the blacklist should ignore."
177 :type '(repeat (regexp :tag "Regular expression to ignore when blacklisting"))
180 (defcustom spam-use-whitelist nil
181 "Whether the whitelist should be used by `spam-split'."
185 (defcustom spam-use-whitelist-exclusive nil
186 "Whether whitelist-exclusive should be used by `spam-split'.
187 Exclusive whitelisting means that all messages from senders not in the whitelist
188 are considered spam."
192 (defcustom spam-use-blackholes nil
193 "Whether blackholes should be used by `spam-split'."
197 (defcustom spam-use-hashcash nil
198 "Whether hashcash payments should be detected by `spam-split'."
202 (defcustom spam-use-regex-headers nil
203 "Whether a header regular expression match should be used by `spam-split'.
204 Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'."
208 (defcustom spam-use-regex-body nil
209 "Whether a body regular expression match should be used by `spam-split'.
210 Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'."
214 (defcustom spam-use-bogofilter-headers nil
215 "Whether bogofilter headers should be used by `spam-split'.
216 Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
220 (defcustom spam-use-bogofilter nil
221 "Whether bogofilter should be invoked by `spam-split'.
222 Enable this if you want Gnus to invoke Bogofilter on new messages."
226 (defcustom spam-use-BBDB nil
227 "Whether BBDB should be used by `spam-split'."
231 (defcustom spam-use-BBDB-exclusive nil
232 "Whether BBDB-exclusive should be used by `spam-split'.
233 Exclusive BBDB means that all messages from senders not in the BBDB are
238 (defcustom spam-use-ifile nil
239 "Whether ifile should be used by `spam-split'."
243 (defcustom spam-use-stat nil
244 "Whether `spam-stat' should be used by `spam-split'."
248 (defcustom spam-use-spamoracle nil
249 "Whether spamoracle should be used by `spam-split'."
253 (defcustom spam-use-spamassassin nil
254 "Whether spamassassin should be invoked by `spam-split'.
255 Enable this if you want Gnus to invoke SpamAssassin on new messages."
259 (defcustom spam-use-spamassassin-headers nil
260 "Whether spamassassin headers should be checked by `spam-split'.
261 Enable this if you pre-process messages with SpamAssassin BEFORE Gnus sees
266 (defcustom spam-install-hooks (or
271 spam-use-whitelist-exclusive
274 spam-use-regex-headers
277 spam-use-bogofilter-headers
278 spam-use-spamassassin
279 spam-use-spamassassin-headers
281 spam-use-BBDB-exclusive
285 "Whether the spam hooks should be installed.
286 Default to t if one of the spam-use-* variables is set."
290 (defcustom spam-split-group "spam"
291 "Group name where incoming spam should be put by `spam-split'."
295 ;;; TODO: deprecate this variable, it's confusing since it's a list of strings,
296 ;;; not regular expressions
297 (defcustom spam-junk-mailgroups (cons
299 '("mail.junk" "poste.pourriel"))
300 "Mailgroups with spam contents.
301 All unmarked article in such group receive the spam mark on group entry."
302 :type '(repeat (string :tag "Group"))
306 (defcustom spam-gmane-xref-spam-group "gmane.spam.detected"
307 "The group where spam xrefs can be found on Gmane.
308 Only meaningful if you enable `spam-use-gmane-xref'."
312 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
313 "dev.null.dk" "relays.visi.com")
314 "List of blackhole servers.
315 Only meaningful if you enable `spam-use-blackholes'."
316 :type '(repeat (string :tag "Server"))
319 (defcustom spam-blackhole-good-server-regex nil
320 "String matching IP addresses that should not be checked in the blackholes.
321 Only meaningful if you enable `spam-use-blackholes'."
322 :type '(radio (const nil)
323 (regexp :format "%t: %v\n" :size 0))
326 (defcustom spam-face 'gnus-splash-face
327 "Face for spam-marked articles."
331 (defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES")
332 "Regular expression for positive header spam matches.
333 Only meaningful if you enable `spam-use-regex-headers'."
334 :type '(repeat (regexp :tag "Regular expression to match spam header"))
337 (defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO")
338 "Regular expression for positive header ham matches.
339 Only meaningful if you enable `spam-use-regex-headers'."
340 :type '(repeat (regexp :tag "Regular expression to match ham header"))
343 (defcustom spam-regex-body-spam '()
344 "Regular expression for positive body spam matches.
345 Only meaningful if you enable `spam-use-regex-body'."
346 :type '(repeat (regexp :tag "Regular expression to match spam body"))
349 (defcustom spam-regex-body-ham '()
350 "Regular expression for positive body ham matches.
351 Only meaningful if you enable `spam-use-regex-body'."
352 :type '(repeat (regexp :tag "Regular expression to match ham body"))
355 (defgroup spam-ifile nil
356 "Spam ifile configuration."
359 (defcustom spam-ifile-path (executable-find "ifile")
360 "File path of the ifile executable program."
361 :type '(choice (file :tag "Location of ifile")
362 (const :tag "ifile is not installed"))
365 (defcustom spam-ifile-database-path nil
366 "File path of the ifile database."
367 :type '(choice (file :tag "Location of the ifile database")
368 (const :tag "Use the default"))
371 (defcustom spam-ifile-spam-category "spam"
372 "Name of the spam ifile category."
376 (defcustom spam-ifile-ham-category nil
377 "Name of the ham ifile category.
378 If nil, the current group name will be used."
379 :type '(choice (string :tag "Use a fixed category")
380 (const :tag "Use the current group name"))
383 (defcustom spam-ifile-all-categories nil
384 "Whether the ifile check will return all categories, or just spam.
385 Set this to t if you want to use the `spam-split' invocation of ifile as
386 your main source of newsgroup names."
390 (defgroup spam-bogofilter nil
391 "Spam bogofilter configuration."
394 (defcustom spam-bogofilter-path (executable-find "bogofilter")
395 "File path of the Bogofilter executable program."
396 :type '(choice (file :tag "Location of bogofilter")
397 (const :tag "Bogofilter is not installed"))
398 :group 'spam-bogofilter)
400 (defcustom spam-bogofilter-header "X-Bogosity"
401 "The header that Bogofilter inserts in messages."
403 :group 'spam-bogofilter)
405 (defcustom spam-bogofilter-spam-switch "-s"
406 "The switch that Bogofilter uses to register spam messages."
408 :group 'spam-bogofilter)
410 (defcustom spam-bogofilter-ham-switch "-n"
411 "The switch that Bogofilter uses to register ham messages."
413 :group 'spam-bogofilter)
415 (defcustom spam-bogofilter-spam-strong-switch "-S"
416 "The switch that Bogofilter uses to unregister ham messages."
418 :group 'spam-bogofilter)
420 (defcustom spam-bogofilter-ham-strong-switch "-N"
421 "The switch that Bogofilter uses to unregister spam messages."
423 :group 'spam-bogofilter)
425 (defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)"
426 "The regex on `spam-bogofilter-header' for positive spam identification."
428 :group 'spam-bogofilter)
430 (defcustom spam-bogofilter-database-directory nil
431 "Directory path of the Bogofilter databases."
432 :type '(choice (directory
433 :tag "Location of the Bogofilter database directory")
434 (const :tag "Use the default"))
435 :group 'spam-bogofilter)
437 (defgroup spam-spamoracle nil
438 "Spam spamoracle configuration."
441 (defcustom spam-spamoracle-database nil
442 "Location of spamoracle database file.
443 When nil, use the default spamoracle database."
444 :type '(choice (directory :tag "Location of spamoracle database file.")
445 (const :tag "Use the default"))
446 :group 'spam-spamoracle)
448 (defcustom spam-spamoracle-binary (executable-find "spamoracle")
449 "Location of the spamoracle binary."
450 :type '(choice (directory :tag "Location of the spamoracle binary")
451 (const :tag "Use the default"))
452 :group 'spam-spamoracle)
454 (defgroup spam-spamassassin nil
455 "Spam SpamAssassin configuration."
458 (defcustom spam-spamassassin-path (executable-find "spamassassin")
459 "File path of the spamassassin executable program.
460 Hint: set this to \"spamc\" if you have spamd running. See the spamc and
461 spamd man pages for more information on these programs."
462 :type '(choice (file :tag "Location of spamc")
463 (const :tag "spamassassin is not installed"))
464 :group 'spam-spamassassin)
466 (defcustom spam-spamassassin-arguments ()
467 "Arguments to pass to the spamassassin executable.
468 This must be a list. For example, `(\"-C\" \"configfile\")'."
469 :type '(restricted-sexp :match-alternatives (listp))
470 :group 'spam-spamassassin)
472 (defcustom spam-spamassassin-spam-flag-header "X-Spam-Flag"
473 "The header inserted by SpamAssassin to flag spam."
475 :group 'spam-spamassassin)
477 (defcustom spam-spamassassin-positive-spam-flag-header "YES"
478 "The regex on `spam-spamassassin-spam-flag-header' for positive spam
481 :group 'spam-spamassassin)
483 (defcustom spam-spamassassin-spam-status-header "X-Spam-Status"
484 "The header inserted by SpamAssassin, giving extended scoring information"
486 :group 'spam-spamassassin)
488 (defcustom spam-sa-learn-path (executable-find "sa-learn")
489 "File path of the sa-learn executable program."
490 :type '(choice (file :tag "Location of spamassassin")
491 (const :tag "spamassassin is not installed"))
492 :group 'spam-spamassassin)
494 (defcustom spam-sa-learn-rebuild t
495 "Whether sa-learn should rebuild the database every time it is called
496 Enable this if you want sa-learn to rebuild the database automatically. Doing
497 this will slightly increase the running time of the spam registration process.
498 If you choose not to do this, you will have to run \"sa-learn --rebuild\" in
499 order for SpamAssassin to recognize the new registered spam."
501 :group 'spam-spamassassin)
503 (defcustom spam-sa-learn-spam-switch "--spam"
504 "The switch that sa-learn uses to register spam messages"
506 :group 'spam-spamassassin)
508 (defcustom spam-sa-learn-ham-switch "--ham"
509 "The switch that sa-learn uses to register ham messages"
511 :group 'spam-spamassassin)
513 (defcustom spam-sa-learn-unregister-switch "--forget"
514 "The switch that sa-learn uses to unregister messages messages"
516 :group 'spam-spamassassin)
518 ;;; Key bindings for spam control.
520 (gnus-define-keys gnus-summary-mode-map
521 "St" spam-generic-score
522 "Sx" gnus-summary-mark-as-spam
523 "Mst" spam-generic-score
524 "Msx" gnus-summary-mark-as-spam
525 "\M-d" gnus-summary-mark-as-spam)
527 (defvar spam-cache-lookups t
528 "Whether spam.el will try to cache lookups using `spam-caches'.")
530 (defvar spam-caches (make-hash-table
533 "Cache of spam detection entries.")
535 (defvar spam-old-ham-articles nil
536 "List of old ham articles, generated when a group is entered.")
538 (defvar spam-old-spam-articles nil
539 "List of old spam articles, generated when a group is entered.")
541 (defvar spam-split-disabled nil
542 "If non-nil, `spam-split' is disabled, and always returns nil.")
544 (defvar spam-split-last-successful-check nil
546 `spam-split' will set this to nil or a spam-use-XYZ check if it
549 ;; convenience functions
550 (defun spam-clear-cache (symbol)
551 "Clear the spam-caches entry for a check."
552 (remhash symbol spam-caches))
554 (defun spam-xor (a b)
556 (and (or a b) (not (and a b))))
558 (defun spam-group-ham-mark-p (group mark &optional spam)
559 "Checks if MARK is considered a ham mark in GROUP."
560 (when (stringp group)
561 (let* ((marks (spam-group-ham-marks group spam))
562 (marks (if (symbolp mark)
564 (mapcar 'symbol-value marks))))
567 (defun spam-group-spam-mark-p (group mark)
568 "Checks if MARK is considered a spam mark in GROUP."
569 (spam-group-ham-mark-p group mark t))
571 (defun spam-group-ham-marks (group &optional spam)
572 "In GROUP, get all the ham marks."
573 (when (stringp group)
574 (let* ((marks (if spam
575 (gnus-parameter-spam-marks group)
576 (gnus-parameter-ham-marks group)))
578 (marks (if (listp (car marks)) (car marks) marks)))
581 (defun spam-group-spam-marks (group)
582 "In GROUP, get all the spam marks."
583 (spam-group-ham-marks group t))
585 (defun spam-group-spam-contents-p (group)
586 "Is GROUP a spam group?"
588 (or (member group spam-junk-mailgroups)
589 (memq 'gnus-group-spam-classification-spam
590 (gnus-parameter-spam-contents group)))
593 (defun spam-group-ham-contents-p (group)
594 "Is GROUP a ham group?"
596 (memq 'gnus-group-spam-classification-ham
597 (gnus-parameter-spam-contents group))
600 (defvar spam-list-of-processors
601 '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane)
602 (gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter)
603 (gnus-group-spam-exit-processor-blacklist spam spam-use-blacklist)
604 (gnus-group-spam-exit-processor-ifile spam spam-use-ifile)
605 (gnus-group-spam-exit-processor-stat spam spam-use-stat)
606 (gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle)
607 (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin)
608 (gnus-group-ham-exit-processor-ifile ham spam-use-ifile)
609 (gnus-group-ham-exit-processor-bogofilter ham spam-use-bogofilter)
610 (gnus-group-ham-exit-processor-stat ham spam-use-stat)
611 (gnus-group-ham-exit-processor-whitelist ham spam-use-whitelist)
612 (gnus-group-ham-exit-processor-BBDB ham spam-use-BBDB)
613 (gnus-group-ham-exit-processor-copy ham spam-use-ham-copy)
614 (gnus-group-ham-exit-processor-spamassassin ham spam-use-spamassassin)
615 (gnus-group-ham-exit-processor-spamoracle ham spam-use-spamoracle))
616 "The `spam-list-of-processors' list.
617 This list contains pairs associating a ham/spam exit processor
618 variable with a classification and a spam-use-* variable.")
620 (defun spam-group-processor-p (group processor)
621 (if (and (stringp group)
623 (or (member processor (nth 0 (gnus-parameter-spam-process group)))
624 (spam-group-processor-multiple-p
626 (cdr-safe (assoc processor spam-list-of-processors))))
629 (defun spam-group-processor-multiple-p (group processor-info)
630 (let* ((classification (nth 0 processor-info))
631 (check (nth 1 processor-info))
632 (parameters (nth 0 (gnus-parameter-spam-process group)))
634 (dolist (parameter parameters)
635 (when (and (null found)
637 (eq classification (nth 0 parameter))
638 (eq check (nth 1 parameter)))
642 (defun spam-group-spam-processor-report-gmane-p (group)
643 (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
645 (defun spam-group-spam-processor-bogofilter-p (group)
646 (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
648 (defun spam-group-spam-processor-blacklist-p (group)
649 (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
651 (defun spam-group-spam-processor-ifile-p (group)
652 (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
654 (defun spam-group-ham-processor-ifile-p (group)
655 (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
657 (defun spam-group-spam-processor-spamoracle-p (group)
658 (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle))
660 (defun spam-group-ham-processor-bogofilter-p (group)
661 (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter))
663 (defun spam-group-spam-processor-stat-p (group)
664 (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat))
666 (defun spam-group-ham-processor-stat-p (group)
667 (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat))
669 (defun spam-group-ham-processor-whitelist-p (group)
670 (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
672 (defun spam-group-ham-processor-BBDB-p (group)
673 (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
675 (defun spam-group-ham-processor-copy-p (group)
676 (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy))
678 (defun spam-group-ham-processor-spamoracle-p (group)
679 (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle))
681 (defun spam-report-articles-gmane (n)
682 "Report the current message as spam.
683 Respects the process/prefix convention."
685 (dolist (article (gnus-summary-work-articles n))
686 (gnus-summary-remove-process-mark article)
687 (spam-report-gmane article)))
689 (defun spam-generic-score ()
691 "Invoke whatever scoring method we can."
693 spam-use-spamassassin
694 spam-use-spamassassin-headers)
695 (spam-spamassassin-score)
696 (spam-bogofilter-score)))
698 ;;; Summary entry and exit processing.
700 (defun spam-summary-prepare ()
701 (setq spam-old-ham-articles
702 (spam-list-articles gnus-newsgroup-articles 'ham))
703 (setq spam-old-spam-articles
704 (spam-list-articles gnus-newsgroup-articles 'spam))
705 (spam-mark-junk-as-spam-routine))
707 ;; The spam processors are invoked for any group, spam or ham or neither
708 (defun spam-summary-prepare-exit ()
709 (unless gnus-group-is-exiting-without-update-p
710 (gnus-message 6 "Exiting summary buffer and applying spam rules")
712 ;; first of all, unregister any articles that are no longer ham or spam
713 ;; we have to iterate over the processors, or else we'll be too slow
714 (dolist (classification '(spam ham))
715 (let* ((old-articles (if (eq classification 'spam)
716 spam-old-spam-articles
717 spam-old-ham-articles))
718 (new-articles (spam-list-articles
719 gnus-newsgroup-articles
721 (changed-articles (spam-set-difference new-articles old-articles)))
722 ;; now that we have the changed articles, we go through the processors
723 (dolist (processor-param spam-list-of-processors)
724 (let ((processor (nth 0 processor-param))
725 (processor-classification (nth 1 processor-param))
726 (check (nth 2 processor-param))
728 (dolist (article changed-articles)
729 (let ((id (spam-fetch-field-message-id-fast article)))
730 (when (spam-log-unregistration-needed-p
731 id 'process classification check)
732 (push article unregister-list))))
733 ;; call spam-register-routine with specific articles to unregister,
734 ;; when there are articles to unregister and the check is enabled
735 (when (and unregister-list (symbol-value check))
736 (spam-register-routine classification check t unregister-list))))))
738 ;; find all the spam processors applicable to this group
739 (dolist (processor-param spam-list-of-processors)
740 (let ((processor (nth 0 processor-param))
741 (classification (nth 1 processor-param))
742 (check (nth 2 processor-param)))
743 (when (and (eq 'spam classification)
744 (spam-group-processor-p gnus-newsgroup-name processor))
745 (spam-register-routine classification check))))
747 (if spam-move-spam-nonspam-groups-only
748 (when (not (spam-group-spam-contents-p gnus-newsgroup-name))
749 (spam-mark-spam-as-expired-and-move-routine
750 (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
751 (gnus-message 5 "Marking spam as expired and moving it to %s"
753 (spam-mark-spam-as-expired-and-move-routine
754 (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
756 ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
757 ;; expire spam, in case the above did not expire them
758 (gnus-message 5 "Marking spam as expired without moving it")
759 (spam-mark-spam-as-expired-and-move-routine nil)
761 (when (or (spam-group-ham-contents-p gnus-newsgroup-name)
762 (and (spam-group-spam-contents-p gnus-newsgroup-name)
763 spam-process-ham-in-spam-groups)
764 spam-process-ham-in-nonham-groups)
765 ;; find all the ham processors applicable to this group
766 (dolist (processor-param spam-list-of-processors)
767 (let ((processor (nth 0 processor-param))
768 (classification (nth 1 processor-param))
769 (check (nth 2 processor-param)))
770 (when (and (eq 'ham classification)
771 (spam-group-processor-p gnus-newsgroup-name processor))
772 (spam-register-routine classification check)))))
774 (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
775 (gnus-message 5 "Copying ham")
776 (spam-ham-copy-routine
777 (gnus-parameter-ham-process-destination gnus-newsgroup-name)))
779 ;; now move all ham articles out of spam groups
780 (when (spam-group-spam-contents-p gnus-newsgroup-name)
781 (gnus-message 5 "Moving ham messages from spam group")
782 (spam-ham-move-routine
783 (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
785 (setq spam-old-ham-articles nil)
786 (setq spam-old-spam-articles nil))
788 (defun spam-set-difference (list1 list2)
789 "Return a set difference of LIST1 and LIST2.
790 When either list is nil, the other is returned."
791 (if (and list1 list2)
792 ;; we have two non-nil lists
794 (dolist (item (append list1 list2))
795 (when (and (memq item list1) (memq item list2))
796 (setq list1 (delq item list1))
797 (setq list2 (delq item list2))))
798 (append list1 list2))
799 ;; if either of the lists was nil, return the other one
800 (if list1 list1 list2)))
802 (defun spam-mark-junk-as-spam-routine ()
803 ;; check the global list of group names spam-junk-mailgroups and the
805 (when (spam-group-spam-contents-p gnus-newsgroup-name)
806 (gnus-message 5 "Marking %s articles as spam"
807 (if spam-mark-only-unseen-as-spam
810 (let ((articles (if spam-mark-only-unseen-as-spam
811 gnus-newsgroup-unseen
812 gnus-newsgroup-unreads)))
813 (dolist (article articles)
814 (gnus-summary-mark-article article gnus-spam-mark)))))
816 (defun spam-mark-spam-as-expired-and-move-routine (&rest groups)
817 (if (and (car-safe groups) (listp (car-safe groups)))
818 (apply 'spam-mark-spam-as-expired-and-move-routine (car groups))
819 (gnus-summary-kill-process-mark)
820 (let ((articles gnus-newsgroup-articles)
821 (backend-supports-deletions
822 (gnus-check-backend-function
823 'request-move-article gnus-newsgroup-name))
824 article tomove deletep)
825 (dolist (article articles)
826 (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
827 (gnus-summary-mark-article article gnus-expirable-mark)
828 (push article tomove)))
830 ;; now do the actual copies
831 (dolist (group groups)
834 (dolist (article tomove)
835 (gnus-summary-set-process-mark article))
837 (if (or (not backend-supports-deletions)
838 (> (length groups) 1))
840 (gnus-summary-copy-article nil group)
842 (gnus-summary-move-article nil group)))))
844 ;; now delete the articles, if there was a copy done, and the
846 (when (and deletep backend-supports-deletions)
847 (dolist (article tomove)
848 (gnus-summary-set-process-mark article))
850 (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
851 (gnus-summary-delete-article nil))))
853 (gnus-summary-yank-process-mark))))
855 (defun spam-ham-copy-or-move-routine (copy groups)
856 (gnus-summary-kill-process-mark)
857 (let ((todo (spam-list-articles gnus-newsgroup-articles 'ham))
858 (backend-supports-deletions
859 (gnus-check-backend-function
860 'request-move-article gnus-newsgroup-name))
861 (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
862 article mark todo deletep respool)
864 (when (member 'respool groups)
865 (setq respool t) ; boolean for later