Mercurial > emacs
comparison lisp/gnus/spam.el @ 111968:1156a55fd2a9
spam.el: Reindent and fix long lines.
(spam-copy-or-move-routine): Exclude invalid move destinations.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Tue, 14 Dec 2010 23:08:31 +0000 |
parents | e36c65ac23bf |
children | 417b1e4d63cd |
comparison
equal
deleted
inserted
replaced
111967:4de98954e350 | 111968:1156a55fd2a9 |
---|---|
43 (eval-and-compile | 43 (eval-and-compile |
44 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | 44 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) |
45 | 45 |
46 (eval-when-compile (require 'cl)) | 46 (eval-when-compile (require 'cl)) |
47 | 47 |
48 (require 'message) ;for the message-fetch-field functions | 48 (require 'message) ;for the message-fetch-field functions |
49 (require 'gnus-sum) | 49 (require 'gnus-sum) |
50 (require 'gnus-uu) ; because of key prefix issues | 50 (require 'gnus-uu) ; because of key prefix issues |
51 ;;; for the definitions of group content classification and spam processors | 51 ;;; for the definitions of group content classification and spam processors |
52 (require 'gnus) | 52 (require 'gnus) |
53 | 53 |
54 (eval-when-compile (require 'spam-report)) | 54 (eval-when-compile (require 'spam-report)) |
55 (eval-when-compile (require 'hashcash)) | 55 (eval-when-compile (require 'hashcash)) |
91 | 91 |
92 (defcustom spam-summary-exit-behavior 'default | 92 (defcustom spam-summary-exit-behavior 'default |
93 "Exit behavior at the time of summary exit. | 93 "Exit behavior at the time of summary exit. |
94 Note that setting the `spam-use-move' or `spam-use-copy' backends on | 94 Note that setting the `spam-use-move' or `spam-use-copy' backends on |
95 a group through group/topic parameters overrides this mechanism." | 95 a group through group/topic parameters overrides this mechanism." |
96 :type '(choice (const 'default :tag | 96 :type '(choice |
97 "Move spam out of all groups. Move ham out of spam groups.") | 97 (const |
98 (const 'move-all :tag | 98 'default |
99 "Move spam out of all groups. Move ham out of all groups.") | 99 :tag "Move spam out of all groups and ham out of spam groups.") |
100 (const 'move-none :tag | 100 (const |
101 "Never move spam or ham out of any groups.")) | 101 'move-all |
102 :tag "Move spam out of all groups and ham out of all groups.") | |
103 (const | |
104 'move-none | |
105 :tag "Never move spam or ham out of any groups.")) | |
102 :group 'spam) | 106 :group 'spam) |
103 | 107 |
104 (defcustom spam-directory (nnheader-concat gnus-directory "spam/") | 108 (defcustom spam-directory (nnheader-concat gnus-directory "spam/") |
105 "Directory for spam whitelists and blacklists." | 109 "Directory for spam whitelists and blacklists." |
106 :type 'directory | 110 :type 'directory |
294 "Whether the CRM114 Mailfilter should be used by `spam-split'." | 298 "Whether the CRM114 Mailfilter should be used by `spam-split'." |
295 :type 'boolean | 299 :type 'boolean |
296 :group 'spam) | 300 :group 'spam) |
297 | 301 |
298 (defcustom spam-install-hooks (or | 302 (defcustom spam-install-hooks (or |
299 spam-use-dig | 303 spam-use-dig |
300 spam-use-gmane-xref | 304 spam-use-gmane-xref |
301 spam-use-blacklist | 305 spam-use-blacklist |
302 spam-use-whitelist | 306 spam-use-whitelist |
303 spam-use-whitelist-exclusive | 307 spam-use-whitelist-exclusive |
304 spam-use-blackholes | 308 spam-use-blackholes |
305 spam-use-hashcash | 309 spam-use-hashcash |
306 spam-use-regex-headers | 310 spam-use-regex-headers |
307 spam-use-regex-body | 311 spam-use-regex-body |
308 spam-use-bogofilter | 312 spam-use-bogofilter |
309 spam-use-bogofilter-headers | 313 spam-use-bogofilter-headers |
310 spam-use-spamassassin | 314 spam-use-spamassassin |
311 spam-use-spamassassin-headers | 315 spam-use-spamassassin-headers |
312 spam-use-bsfilter | 316 spam-use-bsfilter |
313 spam-use-bsfilter-headers | 317 spam-use-bsfilter-headers |
314 spam-use-BBDB | 318 spam-use-BBDB |
315 spam-use-BBDB-exclusive | 319 spam-use-BBDB-exclusive |
316 spam-use-ifile | 320 spam-use-ifile |
317 spam-use-stat | 321 spam-use-stat |
318 spam-use-spamoracle | 322 spam-use-spamoracle |
319 spam-use-crm114) | 323 spam-use-crm114) |
320 "Whether the spam hooks should be installed. | 324 "Whether the spam hooks should be installed. |
321 Default to t if one of the spam-use-* variables is set." | 325 Default to t if one of the spam-use-* variables is set." |
322 :group 'spam | 326 :group 'spam |
323 :type 'boolean) | 327 :type 'boolean) |
324 | 328 |
328 :group 'spam) | 332 :group 'spam) |
329 | 333 |
330 ;;; TODO: deprecate this variable, it's confusing since it's a list of strings, | 334 ;;; TODO: deprecate this variable, it's confusing since it's a list of strings, |
331 ;;; not regular expressions | 335 ;;; not regular expressions |
332 (defcustom spam-junk-mailgroups (cons | 336 (defcustom spam-junk-mailgroups (cons |
333 spam-split-group | 337 spam-split-group |
334 '("mail.junk" "poste.pourriel")) | 338 '("mail.junk" "poste.pourriel")) |
335 "Mailgroups with spam contents. | 339 "Mailgroups with spam contents. |
336 All unmarked article in such group receive the spam mark on group entry." | 340 All unmarked article in such group receive the spam mark on group entry." |
337 :type '(repeat (string :tag "Group")) | 341 :type '(repeat (string :tag "Group")) |
338 :group 'spam) | 342 :group 'spam) |
339 | 343 |
343 Only meaningful if you enable `spam-use-gmane-xref'." | 347 Only meaningful if you enable `spam-use-gmane-xref'." |
344 :type 'string | 348 :type 'string |
345 :group 'spam) | 349 :group 'spam) |
346 | 350 |
347 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org" | 351 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org" |
348 "dev.null.dk" "relays.visi.com") | 352 "dev.null.dk" "relays.visi.com") |
349 "List of blackhole servers. | 353 "List of blackhole servers. |
350 Only meaningful if you enable `spam-use-blackholes'." | 354 Only meaningful if you enable `spam-use-blackholes'." |
351 :type '(repeat (string :tag "Server")) | 355 :type '(repeat (string :tag "Server")) |
352 :group 'spam) | 356 :group 'spam) |
353 | 357 |
403 :group 'spam) | 407 :group 'spam) |
404 | 408 |
405 (defcustom spam-summary-score-preferred-header nil | 409 (defcustom spam-summary-score-preferred-header nil |
406 "Preferred header to use for `spam-summary-score'." | 410 "Preferred header to use for `spam-summary-score'." |
407 :type '(choice :tag "Header name" | 411 :type '(choice :tag "Header name" |
408 (symbol :tag "SpamAssassin etc" X-Spam-Status) | 412 (symbol :tag "SpamAssassin etc" X-Spam-Status) |
409 (symbol :tag "Bogofilter" X-Bogosity) | 413 (symbol :tag "Bogofilter" X-Bogosity) |
410 (const :tag "No preference, take best guess." nil)) | 414 (const :tag "No preference, take best guess." nil)) |
411 :group 'spam) | 415 :group 'spam) |
412 | 416 |
413 (defgroup spam-ifile nil | 417 (defgroup spam-ifile nil |
414 "Spam ifile configuration." | 418 "Spam ifile configuration." |
415 :group 'spam) | 419 :group 'spam) |
417 (make-obsolete-variable 'spam-ifile-path 'spam-ifile-program | 421 (make-obsolete-variable 'spam-ifile-path 'spam-ifile-program |
418 "Gnus 5.10.9 (Emacs 22.1)") | 422 "Gnus 5.10.9 (Emacs 22.1)") |
419 (defcustom spam-ifile-program (executable-find "ifile") | 423 (defcustom spam-ifile-program (executable-find "ifile") |
420 "Name of the ifile program." | 424 "Name of the ifile program." |
421 :type '(choice (file :tag "Location of ifile") | 425 :type '(choice (file :tag "Location of ifile") |
422 (const :tag "ifile is not installed")) | 426 (const :tag "ifile is not installed")) |
423 :group 'spam-ifile) | 427 :group 'spam-ifile) |
424 | 428 |
425 (make-obsolete-variable 'spam-ifile-database-path 'spam-ifile-database | 429 (make-obsolete-variable 'spam-ifile-database-path 'spam-ifile-database |
426 "Gnus 5.10.9 (Emacs 22.1)") | 430 "Gnus 5.10.9 (Emacs 22.1)") |
427 (defcustom spam-ifile-database nil | 431 (defcustom spam-ifile-database nil |
428 "File name of the ifile database." | 432 "File name of the ifile database." |
429 :type '(choice (file :tag "Location of the ifile database") | 433 :type '(choice (file :tag "Location of the ifile database") |
430 (const :tag "Use the default")) | 434 (const :tag "Use the default")) |
431 :group 'spam-ifile) | 435 :group 'spam-ifile) |
432 | 436 |
433 (defcustom spam-ifile-spam-category "spam" | 437 (defcustom spam-ifile-spam-category "spam" |
434 "Name of the spam ifile category." | 438 "Name of the spam ifile category." |
435 :type 'string | 439 :type 'string |
437 | 441 |
438 (defcustom spam-ifile-ham-category nil | 442 (defcustom spam-ifile-ham-category nil |
439 "Name of the ham ifile category. | 443 "Name of the ham ifile category. |
440 If nil, the current group name will be used." | 444 If nil, the current group name will be used." |
441 :type '(choice (string :tag "Use a fixed category") | 445 :type '(choice (string :tag "Use a fixed category") |
442 (const :tag "Use the current group name")) | 446 (const :tag "Use the current group name")) |
443 :group 'spam-ifile) | 447 :group 'spam-ifile) |
444 | 448 |
445 (defcustom spam-ifile-all-categories nil | 449 (defcustom spam-ifile-all-categories nil |
446 "Whether the ifile check will return all categories, or just spam. | 450 "Whether the ifile check will return all categories, or just spam. |
447 Set this to t if you want to use the `spam-split' invocation of ifile as | 451 Set this to t if you want to use the `spam-split' invocation of ifile as |
456 (make-obsolete-variable 'spam-bogofilter-path 'spam-bogofilter-program | 460 (make-obsolete-variable 'spam-bogofilter-path 'spam-bogofilter-program |
457 "Gnus 5.10.9 (Emacs 22.1)") | 461 "Gnus 5.10.9 (Emacs 22.1)") |
458 (defcustom spam-bogofilter-program (executable-find "bogofilter") | 462 (defcustom spam-bogofilter-program (executable-find "bogofilter") |
459 "Name of the Bogofilter program." | 463 "Name of the Bogofilter program." |
460 :type '(choice (file :tag "Location of bogofilter") | 464 :type '(choice (file :tag "Location of bogofilter") |
461 (const :tag "Bogofilter is not installed")) | 465 (const :tag "Bogofilter is not installed")) |
462 :group 'spam-bogofilter) | 466 :group 'spam-bogofilter) |
463 | 467 |
464 (defvar spam-bogofilter-valid 'unknown "Is the bogofilter version valid?") | 468 (defvar spam-bogofilter-valid 'unknown "Is the bogofilter version valid?") |
465 | 469 |
466 (defcustom spam-bogofilter-header "X-Bogosity" | 470 (defcustom spam-bogofilter-header "X-Bogosity" |
495 | 499 |
496 (defcustom spam-bogofilter-database-directory nil | 500 (defcustom spam-bogofilter-database-directory nil |
497 "Location of the Bogofilter database. | 501 "Location of the Bogofilter database. |
498 When nil, use the default location." | 502 When nil, use the default location." |
499 :type '(choice (directory | 503 :type '(choice (directory |
500 :tag "Location of the Bogofilter database directory") | 504 :tag "Location of the Bogofilter database directory") |
501 (const :tag "Use the default")) | 505 (const :tag "Use the default")) |
502 :group 'spam-bogofilter) | 506 :group 'spam-bogofilter) |
503 | 507 |
504 (defgroup spam-bsfilter nil | 508 (defgroup spam-bsfilter nil |
505 "Spam bsfilter configuration." | 509 "Spam bsfilter configuration." |
506 :group 'spam) | 510 :group 'spam) |
508 (make-obsolete-variable 'spam-bsfilter-path 'spam-bsfilter-program | 512 (make-obsolete-variable 'spam-bsfilter-path 'spam-bsfilter-program |
509 "Gnus 5.10.9 (Emacs 22.1)") | 513 "Gnus 5.10.9 (Emacs 22.1)") |
510 (defcustom spam-bsfilter-program (executable-find "bsfilter") | 514 (defcustom spam-bsfilter-program (executable-find "bsfilter") |
511 "Name of the Bsfilter program." | 515 "Name of the Bsfilter program." |
512 :type '(choice (file :tag "Location of bsfilter") | 516 :type '(choice (file :tag "Location of bsfilter") |
513 (const :tag "Bsfilter is not installed")) | 517 (const :tag "Bsfilter is not installed")) |
514 :group 'spam-bsfilter) | 518 :group 'spam-bsfilter) |
515 | 519 |
516 (defcustom spam-bsfilter-header "X-Spam-Flag" | 520 (defcustom spam-bsfilter-header "X-Spam-Flag" |
517 "The header inserted by Bsfilter to flag spam." | 521 "The header inserted by Bsfilter to flag spam." |
518 :type 'string | 522 :type 'string |
544 :group 'spam-bsfilter) | 548 :group 'spam-bsfilter) |
545 | 549 |
546 (defcustom spam-bsfilter-database-directory nil | 550 (defcustom spam-bsfilter-database-directory nil |
547 "Directory path of the Bsfilter databases." | 551 "Directory path of the Bsfilter databases." |
548 :type '(choice (directory | 552 :type '(choice (directory |
549 :tag "Location of the Bsfilter database directory") | 553 :tag "Location of the Bsfilter database directory") |
550 (const :tag "Use the default")) | 554 (const :tag "Use the default")) |
551 :group 'spam-bsfilter) | 555 :group 'spam-bsfilter) |
552 | 556 |
553 (defgroup spam-spamoracle nil | 557 (defgroup spam-spamoracle nil |
554 "Spam spamoracle configuration." | 558 "Spam spamoracle configuration." |
555 :group 'spam) | 559 :group 'spam) |
556 | 560 |
557 (defcustom spam-spamoracle-database nil | 561 (defcustom spam-spamoracle-database nil |
558 "Location of spamoracle database file. | 562 "Location of spamoracle database file. |
559 When nil, use the default spamoracle database." | 563 When nil, use the default spamoracle database." |
560 :type '(choice (directory :tag "Location of spamoracle database file.") | 564 :type '(choice (directory :tag "Location of spamoracle database file.") |
561 (const :tag "Use the default")) | 565 (const :tag "Use the default")) |
562 :group 'spam-spamoracle) | 566 :group 'spam-spamoracle) |
563 | 567 |
564 (defcustom spam-spamoracle-binary (executable-find "spamoracle") | 568 (defcustom spam-spamoracle-binary (executable-find "spamoracle") |
565 "Location of the spamoracle binary." | 569 "Location of the spamoracle binary." |
566 :type '(choice (directory :tag "Location of the spamoracle binary") | 570 :type '(choice (directory :tag "Location of the spamoracle binary") |
567 (const :tag "Use the default")) | 571 (const :tag "Use the default")) |
568 :group 'spam-spamoracle) | 572 :group 'spam-spamoracle) |
569 | 573 |
570 (defgroup spam-spamassassin nil | 574 (defgroup spam-spamassassin nil |
571 "Spam SpamAssassin configuration." | 575 "Spam SpamAssassin configuration." |
572 :group 'spam) | 576 :group 'spam) |
576 (defcustom spam-assassin-program (executable-find "spamassassin") | 580 (defcustom spam-assassin-program (executable-find "spamassassin") |
577 "Name of the spamassassin program. | 581 "Name of the spamassassin program. |
578 Hint: set this to \"spamc\" if you have spamd running. See the spamc and | 582 Hint: set this to \"spamc\" if you have spamd running. See the spamc and |
579 spamd man pages for more information on these programs." | 583 spamd man pages for more information on these programs." |
580 :type '(choice (file :tag "Location of spamc") | 584 :type '(choice (file :tag "Location of spamc") |
581 (const :tag "spamassassin is not installed")) | 585 (const :tag "spamassassin is not installed")) |
582 :group 'spam-spamassassin) | 586 :group 'spam-spamassassin) |
583 | 587 |
584 (defcustom spam-spamassassin-arguments () | 588 (defcustom spam-spamassassin-arguments () |
585 "Arguments to pass to the spamassassin executable. | 589 "Arguments to pass to the spamassassin executable. |
586 This must be a list. For example, `(\"-C\" \"configfile\")'." | 590 This must be a list. For example, `(\"-C\" \"configfile\")'." |
606 (make-obsolete-variable 'spam-sa-learn-path 'spam-sa-learn-program | 610 (make-obsolete-variable 'spam-sa-learn-path 'spam-sa-learn-program |
607 "Gnus 5.10.9 (Emacs 22.1)") | 611 "Gnus 5.10.9 (Emacs 22.1)") |
608 (defcustom spam-sa-learn-program (executable-find "sa-learn") | 612 (defcustom spam-sa-learn-program (executable-find "sa-learn") |
609 "Name of the sa-learn program." | 613 "Name of the sa-learn program." |
610 :type '(choice (file :tag "Location of spamassassin") | 614 :type '(choice (file :tag "Location of spamassassin") |
611 (const :tag "spamassassin is not installed")) | 615 (const :tag "spamassassin is not installed")) |
612 :group 'spam-spamassassin) | 616 :group 'spam-spamassassin) |
613 | 617 |
614 (defcustom spam-sa-learn-rebuild t | 618 (defcustom spam-sa-learn-rebuild t |
615 "Whether sa-learn should rebuild the database every time it is called | 619 "Whether sa-learn should rebuild the database every time it is called |
616 Enable this if you want sa-learn to rebuild the database automatically. Doing | 620 Enable this if you want sa-learn to rebuild the database automatically. Doing |
640 :group 'spam) | 644 :group 'spam) |
641 | 645 |
642 (defcustom spam-crm114-program (executable-find "mailfilter.crm") | 646 (defcustom spam-crm114-program (executable-find "mailfilter.crm") |
643 "File path of the CRM114 Mailfilter executable program." | 647 "File path of the CRM114 Mailfilter executable program." |
644 :type '(choice (file :tag "Location of CRM114 Mailfilter") | 648 :type '(choice (file :tag "Location of CRM114 Mailfilter") |
645 (const :tag "CRM114 Mailfilter is not installed")) | 649 (const :tag "CRM114 Mailfilter is not installed")) |
646 :group 'spam-crm114) | 650 :group 'spam-crm114) |
647 | 651 |
648 (defcustom spam-crm114-header "X-CRM114-Status" | 652 (defcustom spam-crm114-header "X-CRM114-Status" |
649 "The header that CRM114 Mailfilter inserts in messages." | 653 "The header that CRM114 Mailfilter inserts in messages." |
650 :type 'string | 654 :type 'string |
676 :group 'spam-crm114) | 680 :group 'spam-crm114) |
677 | 681 |
678 (defcustom spam-crm114-database-directory nil | 682 (defcustom spam-crm114-database-directory nil |
679 "Directory path of the CRM114 Mailfilter databases." | 683 "Directory path of the CRM114 Mailfilter databases." |
680 :type '(choice (directory | 684 :type '(choice (directory |
681 :tag "Location of the CRM114 Mailfilter database directory") | 685 :tag "Location of the CRM114 Mailfilter database directory") |
682 (const :tag "Use the default")) | 686 (const :tag "Use the default")) |
683 :group 'spam-crm114) | 687 :group 'spam-crm114) |
684 | 688 |
685 ;;; Key bindings for spam control. | 689 ;;; Key bindings for spam control. |
686 | 690 |
687 (gnus-define-keys gnus-summary-mode-map | 691 (gnus-define-keys gnus-summary-mode-map |
694 | 698 |
695 (defvar spam-cache-lookups t | 699 (defvar spam-cache-lookups t |
696 "Whether spam.el will try to cache lookups using `spam-caches'.") | 700 "Whether spam.el will try to cache lookups using `spam-caches'.") |
697 | 701 |
698 (defvar spam-caches (make-hash-table | 702 (defvar spam-caches (make-hash-table |
699 :size 10 | 703 :size 10 |
700 :test 'equal) | 704 :test 'equal) |
701 "Cache of spam detection entries.") | 705 "Cache of spam detection entries.") |
702 | 706 |
703 (defvar spam-old-articles nil | 707 (defvar spam-old-articles nil |
704 "List of old ham and spam articles, generated when a group is entered.") | 708 "List of old ham and spam articles, generated when a group is entered.") |
705 | 709 |
734 "Return a set difference of LIST1 and LIST2. | 738 "Return a set difference of LIST1 and LIST2. |
735 When either list is nil, the other is returned." | 739 When either list is nil, the other is returned." |
736 (if (and list1 list2) | 740 (if (and list1 list2) |
737 ;; we have two non-nil lists | 741 ;; we have two non-nil lists |
738 (progn | 742 (progn |
739 (dolist (item (append list1 list2)) | 743 (dolist (item (append list1 list2)) |
740 (when (and (memq item list1) (memq item list2)) | 744 (when (and (memq item list1) (memq item list2)) |
741 (setq list1 (delq item list1)) | 745 (setq list1 (delq item list1)) |
742 (setq list2 (delq item list2)))) | 746 (setq list2 (delq item list2)))) |
743 (append list1 list2)) | 747 (append list1 list2)) |
744 ;; if either of the lists was nil, return the other one | 748 ;; if either of the lists was nil, return the other one |
745 (if list1 list1 list2))) | 749 (if list1 list1 list2))) |
746 | 750 |
747 (defun spam-group-ham-mark-p (group mark &optional spam) | 751 (defun spam-group-ham-mark-p (group mark &optional spam) |
748 "Checks if MARK is considered a ham mark in GROUP." | 752 "Checks if MARK is considered a ham mark in GROUP." |
749 (when (stringp group) | 753 (when (stringp group) |
750 (let* ((marks (spam-group-ham-marks group spam)) | 754 (let* ((marks (spam-group-ham-marks group spam)) |
751 (marks (if (symbolp mark) | 755 (marks (if (symbolp mark) |
752 marks | 756 marks |
753 (mapcar 'symbol-value marks)))) | 757 (mapcar 'symbol-value marks)))) |
754 (memq mark marks)))) | 758 (memq mark marks)))) |
755 | 759 |
756 (defun spam-group-spam-mark-p (group mark) | 760 (defun spam-group-spam-mark-p (group mark) |
757 "Checks if MARK is considered a spam mark in GROUP." | 761 "Checks if MARK is considered a spam mark in GROUP." |
758 (spam-group-ham-mark-p group mark t)) | 762 (spam-group-ham-mark-p group mark t)) |
759 | 763 |
760 (defun spam-group-ham-marks (group &optional spam) | 764 (defun spam-group-ham-marks (group &optional spam) |
761 "In GROUP, get all the ham marks." | 765 "In GROUP, get all the ham marks." |
762 (when (stringp group) | 766 (when (stringp group) |
763 (let* ((marks (if spam | 767 (let* ((marks (if spam |
764 (gnus-parameter-spam-marks group) | 768 (gnus-parameter-spam-marks group) |
765 (gnus-parameter-ham-marks group))) | 769 (gnus-parameter-ham-marks group))) |
766 (marks (car marks)) | 770 (marks (car marks)) |
767 (marks (if (listp (car marks)) (car marks) marks))) | 771 (marks (if (listp (car marks)) (car marks) marks))) |
768 marks))) | 772 marks))) |
769 | 773 |
770 (defun spam-group-spam-marks (group) | 774 (defun spam-group-spam-marks (group) |
771 "In GROUP, get all the spam marks." | 775 "In GROUP, get all the spam marks." |
772 (spam-group-ham-marks group t)) | 776 (spam-group-ham-marks group t)) |
773 | 777 |
774 (defun spam-group-spam-contents-p (group) | 778 (defun spam-group-spam-contents-p (group) |
775 "Is GROUP a spam group?" | 779 "Is GROUP a spam group?" |
776 (if (and (stringp group) (< 0 (length group))) | 780 (if (and (stringp group) (< 0 (length group))) |
777 (or (member group spam-junk-mailgroups) | 781 (or (member group spam-junk-mailgroups) |
778 (memq 'gnus-group-spam-classification-spam | 782 (memq 'gnus-group-spam-classification-spam |
779 (gnus-parameter-spam-contents group))) | 783 (gnus-parameter-spam-contents group))) |
780 nil)) | 784 nil)) |
781 | 785 |
782 (defun spam-group-ham-contents-p (group) | 786 (defun spam-group-ham-contents-p (group) |
783 "Is GROUP a ham group?" | 787 "Is GROUP a ham group?" |
784 (if (stringp group) | 788 (if (stringp group) |
785 (memq 'gnus-group-spam-classification-ham | 789 (memq 'gnus-group-spam-classification-ham |
786 (gnus-parameter-spam-contents group)) | 790 (gnus-parameter-spam-contents group)) |
787 nil)) | 791 nil)) |
788 | 792 |
789 (defun spam-classifications () | 793 (defun spam-classifications () |
790 "Return list of valid classifications" | 794 "Return list of valid classifications" |
791 '(spam ham)) | 795 '(spam ham)) |
810 (or (eq process-type 'incoming) | 814 (or (eq process-type 'incoming) |
811 (eq process-type 'process))) | 815 (eq process-type 'process))) |
812 | 816 |
813 (defun spam-list-articles (articles classification) | 817 (defun spam-list-articles (articles classification) |
814 (let ((mark-check (if (eq classification 'spam) | 818 (let ((mark-check (if (eq classification 'spam) |
815 'spam-group-spam-mark-p | 819 'spam-group-spam-mark-p |
816 'spam-group-ham-mark-p)) | 820 'spam-group-ham-mark-p)) |
817 alist mark-cache-yes mark-cache-no) | 821 alist mark-cache-yes mark-cache-no) |
818 (dolist (article articles) | 822 (dolist (article articles) |
819 (let ((mark (gnus-summary-article-mark article))) | 823 (let ((mark (gnus-summary-article-mark article))) |
820 (unless (or (memq mark mark-cache-yes) | 824 (unless (or (memq mark mark-cache-yes) |
821 (memq mark mark-cache-no)) | 825 (memq mark mark-cache-no)) |
822 (if (funcall mark-check | 826 (if (funcall mark-check |
823 gnus-newsgroup-name | 827 gnus-newsgroup-name |
824 mark) | 828 mark) |
825 (push mark mark-cache-yes) | 829 (push mark mark-cache-yes) |
826 (push mark mark-cache-no))) | 830 (push mark mark-cache-no))) |
827 (when (memq mark mark-cache-yes) | 831 (when (memq mark mark-cache-yes) |
828 (push article alist)))) | 832 (push article alist)))) |
829 alist)) | 833 alist)) |
830 | 834 |
831 ;;}}} | 835 ;;}}} |
832 | 836 |
833 ;;{{{ backend installation functions and procedures | 837 ;;{{{ backend installation functions and procedures |
839 unregistration function SUF, and an indication whether the | 843 unregistration function SUF, and an indication whether the |
840 backend is STATISTICAL." | 844 backend is STATISTICAL." |
841 (setq spam-backends (add-to-list 'spam-backends backend)) | 845 (setq spam-backends (add-to-list 'spam-backends backend)) |
842 (while properties | 846 (while properties |
843 (let ((property (pop properties)) | 847 (let ((property (pop properties)) |
844 (value (pop properties))) | 848 (value (pop properties))) |
845 (if (spam-backend-property-valid-p property) | 849 (if (spam-backend-property-valid-p property) |
846 (put backend property value) | 850 (put backend property value) |
847 (gnus-error | 851 (gnus-error |
848 5 | 852 5 |
849 "spam-install-backend-super got an invalid property %s" | 853 "spam-install-backend-super got an invalid property %s" |
850 property))))) | 854 property))))) |
851 | 855 |
852 (defun spam-backend-list (&optional type) | 856 (defun spam-backend-list (&optional type) |
853 "Return a list of all the backend symbols, constrained by TYPE. | 857 "Return a list of all the backend symbols, constrained by TYPE. |
854 When TYPE is 'non-mover, only non-mover backends are returned. | 858 When TYPE is 'non-mover, only non-mover backends are returned. |
855 When TYPE is 'mover, only mover backends are returned." | 859 When TYPE is 'mover, only mover backends are returned." |
856 (let (list) | 860 (let (list) |
857 (dolist (backend spam-backends) | 861 (dolist (backend spam-backends) |
858 (when (or | 862 (when (or |
859 (null type) ;either no type was requested | 863 (null type) ;either no type was requested |
860 ;; or the type is 'mover and the backend is a mover | 864 ;; or the type is 'mover and the backend is a mover |
861 (and | 865 (and |
862 (eq type 'mover) | 866 (eq type 'mover) |
863 (spam-backend-mover-p backend)) | 867 (spam-backend-mover-p backend)) |
864 ;; or the type is 'non-mover and the backend is not a mover | 868 ;; or the type is 'non-mover and the backend is not a mover |
865 (and | 869 (and |
866 (eq type 'non-mover) | 870 (eq type 'non-mover) |
867 (not (spam-backend-mover-p backend)))) | 871 (not (spam-backend-mover-p backend)))) |
868 (push backend list))) | 872 (push backend list))) |
869 list)) | 873 list)) |
870 | 874 |
871 (defun spam-backend-check (backend) | 875 (defun spam-backend-check (backend) |
872 "Get the check function for BACKEND. | 876 "Get the check function for BACKEND. |
873 Each individual check may return nil, t, or a mailgroup name. | 877 Each individual check may return nil, t, or a mailgroup name. |
887 | 891 |
888 (defun spam-backend-info (backend) | 892 (defun spam-backend-info (backend) |
889 "Return information about BACKEND." | 893 "Return information about BACKEND." |
890 (if (spam-backend-valid-p backend) | 894 (if (spam-backend-valid-p backend) |
891 (let (info) | 895 (let (info) |
892 (setq info (format "Backend %s has the following properties:\n" | 896 (setq info (format "Backend %s has the following properties:\n" |
893 backend)) | 897 backend)) |
894 (dolist (property (spam-backend-properties)) | 898 (dolist (property (spam-backend-properties)) |
895 (setq info (format "%s%s=%s\n" | 899 (setq info (format "%s%s=%s\n" |
896 info | 900 info |
897 property | 901 property |
898 (get backend property)))) | 902 (get backend property)))) |
899 info) | 903 info) |
900 (gnus-error 5 "spam-backend-info was asked about an invalid backend %s" | 904 (gnus-error 5 "spam-backend-info was asked about an invalid backend %s" |
901 backend))) | 905 backend))) |
902 | 906 |
903 (defun spam-backend-function (backend classification type) | 907 (defun spam-backend-function (backend classification type) |
904 "Get the BACKEND function for CLASSIFICATION and TYPE. | 908 "Get the BACKEND function for CLASSIFICATION and TYPE. |
905 TYPE is 'registration or 'unregistration. | 909 TYPE is 'registration or 'unregistration. |
906 CLASSIFICATION is 'ham or 'spam." | 910 CLASSIFICATION is 'ham or 'spam." |
907 (if (and | 911 (if (and |
908 (spam-classification-valid-p classification) | 912 (spam-classification-valid-p classification) |
909 (spam-backend-function-type-valid-p type)) | 913 (spam-backend-function-type-valid-p type)) |
910 (let ((retrieval | 914 (let ((retrieval |
911 (intern | 915 (intern |
912 (format "spam-backend-%s-%s-function" | 916 (format "spam-backend-%s-%s-function" |
913 classification | 917 classification |
914 type)))) | 918 type)))) |
915 (funcall retrieval backend)) | 919 (funcall retrieval backend)) |
916 (gnus-error | 920 (gnus-error |
917 5 | 921 5 |
918 "%s was passed invalid backend %s, classification %s, or type %s" | 922 "%s was passed invalid backend %s, classification %s, or type %s" |
919 "spam-backend-function" | 923 "spam-backend-function" |
920 backend | 924 backend |
921 classification | 925 classification |
922 type))) | 926 type))) |
923 | 927 |
924 (defun spam-backend-article-list-property (classification | 928 (defun spam-backend-article-list-property (classification |
925 &optional unregister) | 929 &optional unregister) |
926 "Property name of article list with CLASSIFICATION and UNREGISTER." | 930 "Property name of article list with CLASSIFICATION and UNREGISTER." |
927 (let* ((r (if unregister "unregister" "register")) | 931 (let* ((r (if unregister "unregister" "register")) |
928 (prop (format "%s-%s" classification r))) | 932 (prop (format "%s-%s" classification r))) |
929 prop)) | 933 prop)) |
930 | 934 |
931 (defun spam-backend-get-article-todo-list (backend | 935 (defun spam-backend-get-article-todo-list (backend |
932 classification | 936 classification |
933 &optional unregister) | 937 &optional unregister) |
934 "Get the articles to be processed for BACKEND and CLASSIFICATION. | 938 "Get the articles to be processed for BACKEND and CLASSIFICATION. |
935 With UNREGISTER, get articles to be unregistered. | 939 With UNREGISTER, get articles to be unregistered. |
936 This is a temporary storage function - nothing here persists." | 940 This is a temporary storage function - nothing here persists." |
937 (get | 941 (get |
938 backend | 942 backend |
939 (intern (spam-backend-article-list-property classification unregister)))) | 943 (intern (spam-backend-article-list-property classification unregister)))) |
940 | 944 |
941 (defun spam-backend-put-article-todo-list (backend classification list &optional unregister) | 945 (defun spam-backend-put-article-todo-list (backend classification list |
946 &optional unregister) | |
942 "Set the LIST of articles to be processed for BACKEND and CLASSIFICATION. | 947 "Set the LIST of articles to be processed for BACKEND and CLASSIFICATION. |
943 With UNREGISTER, set articles to be unregistered. | 948 With UNREGISTER, set articles to be unregistered. |
944 This is a temporary storage function - nothing here persists." | 949 This is a temporary storage function - nothing here persists." |
945 (put | 950 (put |
946 backend | 951 backend |
1034 | 1039 |
1035 ;;}}} | 1040 ;;}}} |
1036 | 1041 |
1037 ;;{{{ backend installations | 1042 ;;{{{ backend installations |
1038 (spam-install-checkonly-backend 'spam-use-blackholes | 1043 (spam-install-checkonly-backend 'spam-use-blackholes |
1039 'spam-check-blackholes) | 1044 'spam-check-blackholes) |
1040 | 1045 |
1041 (spam-install-checkonly-backend 'spam-use-hashcash | 1046 (spam-install-checkonly-backend 'spam-use-hashcash |
1042 'spam-check-hashcash) | 1047 'spam-check-hashcash) |
1043 | 1048 |
1044 (spam-install-checkonly-backend 'spam-use-spamassassin-headers | 1049 (spam-install-checkonly-backend 'spam-use-spamassassin-headers |
1045 'spam-check-spamassassin-headers) | 1050 'spam-check-spamassassin-headers) |
1046 | 1051 |
1047 (spam-install-checkonly-backend 'spam-use-bogofilter-headers | 1052 (spam-install-checkonly-backend 'spam-use-bogofilter-headers |
1048 'spam-check-bogofilter-headers) | 1053 'spam-check-bogofilter-headers) |
1049 | 1054 |
1050 (spam-install-checkonly-backend 'spam-use-bsfilter-headers | 1055 (spam-install-checkonly-backend 'spam-use-bsfilter-headers |
1051 'spam-check-bsfilter-headers) | 1056 'spam-check-bsfilter-headers) |
1052 | 1057 |
1053 (spam-install-checkonly-backend 'spam-use-gmane-xref | 1058 (spam-install-checkonly-backend 'spam-use-gmane-xref |
1054 'spam-check-gmane-xref) | 1059 'spam-check-gmane-xref) |
1055 | 1060 |
1056 (spam-install-checkonly-backend 'spam-use-regex-headers | 1061 (spam-install-checkonly-backend 'spam-use-regex-headers |
1057 'spam-check-regex-headers) | 1062 'spam-check-regex-headers) |
1058 | 1063 |
1059 (spam-install-statistical-checkonly-backend 'spam-use-regex-body | 1064 (spam-install-statistical-checkonly-backend 'spam-use-regex-body |
1060 'spam-check-regex-body) | 1065 'spam-check-regex-body) |
1061 | 1066 |
1062 ;; TODO: NOTE: spam-use-ham-copy is now obsolete, use (ham spam-use-copy) instead | 1067 ;; TODO: NOTE: spam-use-ham-copy is now obsolete, use (ham spam-use-copy) |
1063 (spam-install-mover-backend 'spam-use-move | 1068 (spam-install-mover-backend 'spam-use-move |
1064 'spam-move-ham-routine | 1069 'spam-move-ham-routine |
1065 'spam-move-spam-routine | 1070 'spam-move-spam-routine |
1066 nil | 1071 nil |
1067 nil) | 1072 nil) |
1068 | 1073 |
1069 (spam-install-nocheck-backend 'spam-use-copy | 1074 (spam-install-nocheck-backend 'spam-use-copy |
1070 'spam-copy-ham-routine | 1075 'spam-copy-ham-routine |
1071 'spam-copy-spam-routine | 1076 'spam-copy-spam-routine |
1072 nil | 1077 nil |
1073 nil) | 1078 nil) |
1074 | 1079 |
1075 (spam-install-nocheck-backend 'spam-use-gmane | 1080 (spam-install-nocheck-backend 'spam-use-gmane |
1076 'spam-report-gmane-unregister-routine | 1081 'spam-report-gmane-unregister-routine |
1077 'spam-report-gmane-register-routine | 1082 'spam-report-gmane-register-routine |
1078 'spam-report-gmane-register-routine | 1083 'spam-report-gmane-register-routine |
1079 'spam-report-gmane-unregister-routine) | 1084 'spam-report-gmane-unregister-routine) |
1080 | 1085 |
1081 (spam-install-nocheck-backend 'spam-use-resend | 1086 (spam-install-nocheck-backend 'spam-use-resend |
1082 'spam-report-resend-register-ham-routine | 1087 'spam-report-resend-register-ham-routine |
1083 'spam-report-resend-register-routine | 1088 'spam-report-resend-register-routine |
1084 nil | 1089 nil |
1085 nil) | 1090 nil) |
1086 | 1091 |
1087 (spam-install-backend 'spam-use-BBDB | 1092 (spam-install-backend 'spam-use-BBDB |
1088 'spam-check-BBDB | 1093 'spam-check-BBDB |
1089 'spam-BBDB-register-routine | 1094 'spam-BBDB-register-routine |
1090 nil | 1095 nil |
1091 'spam-BBDB-unregister-routine | 1096 'spam-BBDB-unregister-routine |
1092 nil) | 1097 nil) |
1093 | 1098 |
1094 (spam-install-backend-alias 'spam-use-BBDB 'spam-use-BBDB-exclusive) | 1099 (spam-install-backend-alias 'spam-use-BBDB 'spam-use-BBDB-exclusive) |
1095 | 1100 |
1096 (spam-install-backend 'spam-use-blacklist | 1101 (spam-install-backend 'spam-use-blacklist |
1097 'spam-check-blacklist | 1102 'spam-check-blacklist |
1098 nil | 1103 nil |
1099 'spam-blacklist-register-routine | 1104 'spam-blacklist-register-routine |
1100 nil | 1105 nil |
1101 'spam-blacklist-unregister-routine) | 1106 'spam-blacklist-unregister-routine) |
1102 | 1107 |
1103 (spam-install-backend 'spam-use-whitelist | 1108 (spam-install-backend 'spam-use-whitelist |
1104 'spam-check-whitelist | 1109 'spam-check-whitelist |
1105 'spam-whitelist-register-routine | 1110 'spam-whitelist-register-routine |
1106 nil | 1111 nil |
1107 'spam-whitelist-unregister-routine | 1112 'spam-whitelist-unregister-routine |
1108 nil) | 1113 nil) |
1109 | 1114 |
1110 (spam-install-statistical-backend 'spam-use-ifile | 1115 (spam-install-statistical-backend 'spam-use-ifile |
1111 'spam-check-ifile | 1116 'spam-check-ifile |
1112 'spam-ifile-register-ham-routine | 1117 'spam-ifile-register-ham-routine |
1113 'spam-ifile-register-spam-routine | 1118 'spam-ifile-register-spam-routine |
1114 'spam-ifile-unregister-ham-routine | 1119 'spam-ifile-unregister-ham-routine |
1115 'spam-ifile-unregister-spam-routine) | 1120 'spam-ifile-unregister-spam-routine) |
1116 | 1121 |
1117 (spam-install-statistical-backend 'spam-use-spamoracle | 1122 (spam-install-statistical-backend 'spam-use-spamoracle |
1118 'spam-check-spamoracle | 1123 'spam-check-spamoracle |
1119 'spam-spamoracle-learn-ham | 1124 'spam-spamoracle-learn-ham |
1120 'spam-spamoracle-learn-spam | 1125 'spam-spamoracle-learn-spam |
1121 'spam-spamoracle-unlearn-ham | 1126 'spam-spamoracle-unlearn-ham |
1122 'spam-spamoracle-unlearn-spam) | 1127 'spam-spamoracle-unlearn-spam) |
1123 | 1128 |
1124 (spam-install-statistical-backend 'spam-use-stat | 1129 (spam-install-statistical-backend 'spam-use-stat |
1125 'spam-check-stat | 1130 'spam-check-stat |
1126 'spam-stat-register-ham-routine | 1131 'spam-stat-register-ham-routine |
1127 'spam-stat-register-spam-routine | 1132 'spam-stat-register-spam-routine |
1128 'spam-stat-unregister-ham-routine | 1133 'spam-stat-unregister-ham-routine |
1129 'spam-stat-unregister-spam-routine) | 1134 'spam-stat-unregister-spam-routine) |
1130 | 1135 |
1131 (spam-install-statistical-backend 'spam-use-spamassassin | 1136 (spam-install-statistical-backend 'spam-use-spamassassin |
1132 'spam-check-spamassassin | 1137 'spam-check-spamassassin |
1133 'spam-spamassassin-register-ham-routine | 1138 'spam-spamassassin-register-ham-routine |
1134 'spam-spamassassin-register-spam-routine | 1139 'spam-spamassassin-register-spam-routine |
1135 'spam-spamassassin-unregister-ham-routine | 1140 'spam-spamassassin-unregister-ham-routine |
1136 'spam-spamassassin-unregister-spam-routine) | 1141 'spam-spamassassin-unregister-spam-routine) |
1137 | 1142 |
1138 (spam-install-statistical-backend 'spam-use-bogofilter | 1143 (spam-install-statistical-backend 'spam-use-bogofilter |
1139 'spam-check-bogofilter | 1144 'spam-check-bogofilter |
1140 'spam-bogofilter-register-ham-routine | 1145 'spam-bogofilter-register-ham-routine |
1141 'spam-bogofilter-register-spam-routine | 1146 'spam-bogofilter-register-spam-routine |
1142 'spam-bogofilter-unregister-ham-routine | 1147 'spam-bogofilter-unregister-ham-routine |
1143 'spam-bogofilter-unregister-spam-routine) | 1148 'spam-bogofilter-unregister-spam-routine) |
1144 | 1149 |
1145 (spam-install-statistical-backend 'spam-use-bsfilter | 1150 (spam-install-statistical-backend 'spam-use-bsfilter |
1146 'spam-check-bsfilter | 1151 'spam-check-bsfilter |
1147 'spam-bsfilter-register-ham-routine | 1152 'spam-bsfilter-register-ham-routine |
1148 'spam-bsfilter-register-spam-routine | 1153 'spam-bsfilter-register-spam-routine |
1149 'spam-bsfilter-unregister-ham-routine | 1154 'spam-bsfilter-unregister-ham-routine |
1150 'spam-bsfilter-unregister-spam-routine) | 1155 'spam-bsfilter-unregister-spam-routine) |
1151 | 1156 |
1152 (spam-install-statistical-backend 'spam-use-crm114 | 1157 (spam-install-statistical-backend 'spam-use-crm114 |
1153 'spam-check-crm114 | 1158 'spam-check-crm114 |
1154 'spam-crm114-register-ham-routine | 1159 'spam-crm114-register-ham-routine |
1155 'spam-crm114-register-spam-routine | 1160 'spam-crm114-register-spam-routine |
1156 'spam-crm114-unregister-ham-routine | 1161 'spam-crm114-unregister-ham-routine |
1157 'spam-crm114-unregister-spam-routine) | 1162 'spam-crm114-unregister-spam-routine) |
1158 ;;}}} | 1163 ;;}}} |
1159 | 1164 |
1160 ;;{{{ scoring and summary formatting | 1165 ;;{{{ scoring and summary formatting |
1161 (defun spam-necessary-extra-headers () | 1166 (defun spam-necessary-extra-headers () |
1162 "Return the extra headers spam.el thinks are necessary." | 1167 "Return the extra headers spam.el thinks are necessary." |
1163 (let (list) | 1168 (let (list) |
1164 (when (or spam-use-spamassassin | 1169 (when (or spam-use-spamassassin |
1165 spam-use-spamassassin-headers | 1170 spam-use-spamassassin-headers |
1166 spam-use-regex-headers) | 1171 spam-use-regex-headers) |
1167 (push 'X-Spam-Status list)) | 1172 (push 'X-Spam-Status list)) |
1168 (when (or spam-use-bogofilter | 1173 (when (or spam-use-bogofilter |
1169 spam-use-regex-headers) | 1174 spam-use-regex-headers) |
1170 (push 'X-Bogosity list)) | 1175 (push 'X-Bogosity list)) |
1171 (when (or spam-use-crm114 | 1176 (when (or spam-use-crm114 |
1172 spam-use-regex-headers) | 1177 spam-use-regex-headers) |
1173 (push 'X-CRM114-Status list)) | 1178 (push 'X-CRM114-Status list)) |
1174 list)) | 1179 list)) |
1175 | 1180 |
1176 (defun spam-user-format-function-S (headers) | 1181 (defun spam-user-format-function-S (headers) |
1177 (when headers | 1182 (when headers |
1178 (format "%3.2f" | 1183 (format "%3.2f" |
1179 (spam-summary-score headers spam-summary-score-preferred-header)))) | 1184 (spam-summary-score headers spam-summary-score-preferred-header)))) |
1180 | 1185 |
1181 (defun spam-article-sort-by-spam-status (h1 h2) | 1186 (defun spam-article-sort-by-spam-status (h1 h2) |
1182 "Sort articles by score." | 1187 "Sort articles by score." |
1183 (let (result) | 1188 (let (result) |
1184 (dolist (header (spam-necessary-extra-headers)) | 1189 (dolist (header (spam-necessary-extra-headers)) |
1185 (let ((s1 (spam-summary-score h1 header)) | 1190 (let ((s1 (spam-summary-score h1 header)) |
1186 (s2 (spam-summary-score h2 header))) | 1191 (s2 (spam-summary-score h2 header))) |
1187 (unless (= s1 s2) | 1192 (unless (= s1 s2) |
1188 (setq result (< s1 s2)) | 1193 (setq result (< s1 s2)) |
1189 (return)))) | 1194 (return)))) |
1190 result)) | 1195 result)) |
1191 | 1196 |
1192 (defvar spam-spamassassin-score-regexp | 1197 (defvar spam-spamassassin-score-regexp |
1193 ".*\\b\\(?:score\\|hits\\)=\\(-?[0-9.]+\\)" | 1198 ".*\\b\\(?:score\\|hits\\)=\\(-?[0-9.]+\\)" |
1194 "Regexp matching SpamAssassin score header. | 1199 "Regexp matching SpamAssassin score header. |
1221 "Score an article for the summary buffer, as fast as possible. | 1226 "Score an article for the summary buffer, as fast as possible. |
1222 With SPECIFIC-HEADER, returns only that header's score. | 1227 With SPECIFIC-HEADER, returns only that header's score. |
1223 Will not return a nil score." | 1228 Will not return a nil score." |
1224 (let (score) | 1229 (let (score) |
1225 (dolist (header | 1230 (dolist (header |
1226 (if specific-header | 1231 (if specific-header |
1227 (list specific-header) | 1232 (list specific-header) |
1228 (spam-necessary-extra-headers))) | 1233 (spam-necessary-extra-headers))) |
1229 (setq score | 1234 (setq score |
1230 (spam-extra-header-to-number header headers)) | 1235 (spam-extra-header-to-number header headers)) |
1231 (when score | 1236 (when score |
1232 (return))) | 1237 (return))) |
1233 (or score 0))) | 1238 (or score 0))) |
1234 | 1239 |
1235 (defun spam-generic-score (&optional recheck) | 1240 (defun spam-generic-score (&optional recheck) |
1236 "Invoke whatever scoring method we can." | 1241 "Invoke whatever scoring method we can." |
1237 (interactive "P") | 1242 (interactive "P") |
1254 | 1259 |
1255 (defun spam-widening-needed-p (&optional force-symbols) | 1260 (defun spam-widening-needed-p (&optional force-symbols) |
1256 (let (found) | 1261 (let (found) |
1257 (dolist (backend (spam-backend-list)) | 1262 (dolist (backend (spam-backend-list)) |
1258 (when (and (spam-backend-statistical-p backend) | 1263 (when (and (spam-backend-statistical-p backend) |
1259 (or (symbol-value backend) | 1264 (or (symbol-value backend) |
1260 (memq backend force-symbols))) | 1265 (memq backend force-symbols))) |
1261 (setq found backend))) | 1266 (setq found backend))) |
1262 found)) | 1267 found)) |
1263 | 1268 |
1264 (defvar spam-list-of-processors | 1269 (defvar spam-list-of-processors |
1265 ;; note the nil processors are not defined in gnus.el | 1270 ;; note the nil processors are not defined in gnus.el |
1266 '((gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter) | 1271 '((gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter) |
1267 (gnus-group-spam-exit-processor-bsfilter spam spam-use-bsfilter) | 1272 (gnus-group-spam-exit-processor-bsfilter spam spam-use-bsfilter) |
1268 (gnus-group-spam-exit-processor-blacklist spam spam-use-blacklist) | 1273 (gnus-group-spam-exit-processor-blacklist spam spam-use-blacklist) |
1269 (gnus-group-spam-exit-processor-ifile spam spam-use-ifile) | 1274 (gnus-group-spam-exit-processor-ifile spam spam-use-ifile) |
1270 (gnus-group-spam-exit-processor-stat spam spam-use-stat) | 1275 (gnus-group-spam-exit-processor-stat spam spam-use-stat) |
1271 (gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle) | 1276 (gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle) |
1272 (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin) | 1277 (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin) |
1294 Also accepts the obsolete processors, which can be found in | 1299 Also accepts the obsolete processors, which can be found in |
1295 gnus.el and in spam-list-of-processors. In the case of mover | 1300 gnus.el and in spam-list-of-processors. In the case of mover |
1296 backends, checks the setting of `spam-summary-exit-behavior' in | 1301 backends, checks the setting of `spam-summary-exit-behavior' in |
1297 addition to the set values for the group." | 1302 addition to the set values for the group." |
1298 (if (and (stringp group) | 1303 (if (and (stringp group) |
1299 (symbolp backend)) | 1304 (symbolp backend)) |
1300 (let ((old-style (assq backend spam-list-of-processors)) | 1305 (let ((old-style (assq backend spam-list-of-processors)) |
1301 (parameters (nth 0 (gnus-parameter-spam-process group))) | 1306 (parameters (nth 0 (gnus-parameter-spam-process group))) |
1302 found) | 1307 found) |
1303 (if old-style ; old-style processor | 1308 (if old-style ; old-style processor |
1304 (spam-group-processor-p group (nth 2 old-style) (nth 1 old-style)) | 1309 (spam-group-processor-p group (nth 2 old-style) (nth 1 old-style)) |
1305 ;; now search for the parameter | 1310 ;; now search for the parameter |
1306 (dolist (parameter parameters) | 1311 (dolist (parameter parameters) |
1307 (when (and (null found) | 1312 (when (and (null found) |
1308 (listp parameter) | 1313 (listp parameter) |
1309 (eq classification (nth 0 parameter)) | 1314 (eq classification (nth 0 parameter)) |
1310 (eq backend (nth 1 parameter))) | 1315 (eq backend (nth 1 parameter))) |
1311 (setq found t))) | 1316 (setq found t))) |
1312 | 1317 |
1313 ;; now, if the parameter was not found, do the | 1318 ;; now, if the parameter was not found, do the |
1314 ;; spam-summary-exit-behavior-logic for mover backends | 1319 ;; spam-summary-exit-behavior-logic for mover backends |
1315 (unless found | 1320 (unless found |
1316 (when (spam-backend-mover-p backend) | 1321 (when (spam-backend-mover-p backend) |
1317 (setq | 1322 (setq |
1318 found | 1323 found |
1319 (cond | 1324 (cond |
1320 ((eq spam-summary-exit-behavior 'move-all) t) | 1325 ((eq spam-summary-exit-behavior 'move-all) t) |
1321 ((eq spam-summary-exit-behavior 'move-none) nil) | 1326 ((eq spam-summary-exit-behavior 'move-none) nil) |
1322 ((eq spam-summary-exit-behavior 'default) | 1327 ((eq spam-summary-exit-behavior 'default) |
1323 (or (eq classification 'spam) ;move spam out of all groups | 1328 (or (eq classification 'spam) ;move spam out of all groups |
1324 ;; move ham out of spam groups | 1329 ;; move ham out of spam groups |
1325 (and (eq classification 'ham) | 1330 (and (eq classification 'ham) |
1326 (spam-group-spam-contents-p group)))) | 1331 (spam-group-spam-contents-p group)))) |
1327 (t (gnus-error 5 "Unknown spam-summary-exit-behavior: %s" | 1332 (t (gnus-error 5 "Unknown spam-summary-exit-behavior: %s" |
1328 spam-summary-exit-behavior)))))) | 1333 spam-summary-exit-behavior)))))) |
1329 | 1334 |
1330 found)) | 1335 found)) |
1331 nil)) | 1336 nil)) |
1332 | 1337 |
1333 ;;}}} | 1338 ;;}}} |
1334 | 1339 |
1335 ;;{{{ Summary entry and exit processing. | 1340 ;;{{{ Summary entry and exit processing. |
1337 (defun spam-mark-junk-as-spam-routine () | 1342 (defun spam-mark-junk-as-spam-routine () |
1338 ;; check the global list of group names spam-junk-mailgroups and the | 1343 ;; check the global list of group names spam-junk-mailgroups and the |
1339 ;; group parameters | 1344 ;; group parameters |
1340 (when (spam-group-spam-contents-p gnus-newsgroup-name) | 1345 (when (spam-group-spam-contents-p gnus-newsgroup-name) |
1341 (gnus-message 6 "Marking %s articles as spam" | 1346 (gnus-message 6 "Marking %s articles as spam" |
1342 (if spam-mark-only-unseen-as-spam | 1347 (if spam-mark-only-unseen-as-spam |
1343 "unseen" | 1348 "unseen" |
1344 "unread")) | 1349 "unread")) |
1345 (let ((articles (if spam-mark-only-unseen-as-spam | 1350 (let ((articles (if spam-mark-only-unseen-as-spam |
1346 gnus-newsgroup-unseen | 1351 gnus-newsgroup-unseen |
1347 gnus-newsgroup-unreads))) | 1352 gnus-newsgroup-unreads))) |
1348 (if spam-mark-new-messages-in-spam-group-as-spam | 1353 (if spam-mark-new-messages-in-spam-group-as-spam |
1349 (dolist (article articles) | 1354 (dolist (article articles) |
1350 (gnus-summary-mark-article article gnus-spam-mark)) | 1355 (gnus-summary-mark-article article gnus-spam-mark)) |
1351 (gnus-message 9 "Did not mark new messages as spam."))))) | 1356 (gnus-message 9 "Did not mark new messages as spam."))))) |
1352 | 1357 |
1353 (defun spam-summary-prepare () | 1358 (defun spam-summary-prepare () |
1354 (setq spam-old-articles | 1359 (setq spam-old-articles |
1355 (list (cons 'ham (spam-list-articles gnus-newsgroup-articles 'ham)) | 1360 (list (cons 'ham (spam-list-articles gnus-newsgroup-articles 'ham)) |
1356 (cons 'spam (spam-list-articles gnus-newsgroup-articles 'spam)))) | 1361 (cons 'spam (spam-list-articles gnus-newsgroup-articles 'spam)))) |
1357 (spam-mark-junk-as-spam-routine)) | 1362 (spam-mark-junk-as-spam-routine)) |
1358 | 1363 |
1359 ;; The spam processors are invoked for any group, spam or ham or neither | 1364 ;; The spam processors are invoked for any group, spam or ham or neither |
1360 (defun spam-summary-prepare-exit () | 1365 (defun spam-summary-prepare-exit () |
1361 (unless gnus-group-is-exiting-without-update-p | 1366 (unless gnus-group-is-exiting-without-update-p |
1367 | 1372 |
1368 ;; first of all, unregister any articles that are no longer ham or spam | 1373 ;; first of all, unregister any articles that are no longer ham or spam |
1369 ;; we have to iterate over the processors, or else we'll be too slow | 1374 ;; we have to iterate over the processors, or else we'll be too slow |
1370 (dolist (classification (spam-classifications)) | 1375 (dolist (classification (spam-classifications)) |
1371 (let* ((old-articles (cdr-safe (assq classification spam-old-articles))) | 1376 (let* ((old-articles (cdr-safe (assq classification spam-old-articles))) |
1372 (new-articles (spam-list-articles | 1377 (new-articles (spam-list-articles |
1373 gnus-newsgroup-articles | 1378 gnus-newsgroup-articles |
1374 classification)) | 1379 classification)) |
1375 (changed-articles (spam-set-difference new-articles old-articles))) | 1380 (changed-articles (spam-set-difference new-articles old-articles))) |
1376 ;; now that we have the changed articles, we go through the processors | 1381 ;; now that we have the changed articles, we go through the processors |
1377 (dolist (backend (spam-backend-list)) | 1382 (dolist (backend (spam-backend-list)) |
1378 (let (unregister-list) | 1383 (let (unregister-list) |
1379 (dolist (article changed-articles) | 1384 (dolist (article changed-articles) |
1380 (let ((id (spam-fetch-field-message-id-fast article))) | 1385 (let ((id (spam-fetch-field-message-id-fast article))) |
1381 (when (spam-log-unregistration-needed-p | 1386 (when (spam-log-unregistration-needed-p |
1382 id 'process classification backend) | 1387 id 'process classification backend) |
1383 (push article unregister-list)))) | 1388 (push article unregister-list)))) |
1384 ;; call spam-register-routine with specific articles to unregister, | 1389 ;; call spam-register-routine with specific articles to unregister, |
1385 ;; when there are articles to unregister and the check is enabled | 1390 ;; when there are articles to unregister and the check is enabled |
1386 (when (and unregister-list (symbol-value backend)) | 1391 (when (and unregister-list (symbol-value backend)) |
1387 (spam-backend-put-article-todo-list backend | 1392 (spam-backend-put-article-todo-list backend |
1388 classification | 1393 classification |
1389 unregister-list | 1394 unregister-list |
1390 t)))))) | 1395 t)))))) |
1391 | 1396 |
1392 ;; do the non-moving backends first, then the moving ones | 1397 ;; do the non-moving backends first, then the moving ones |
1393 (dolist (backend-type '(non-mover mover)) | 1398 (dolist (backend-type '(non-mover mover)) |
1394 (dolist (classification (spam-classifications)) | 1399 (dolist (classification (spam-classifications)) |
1395 (dolist (backend (spam-backend-list backend-type)) | 1400 (dolist (backend (spam-backend-list backend-type)) |
1396 (when (spam-group-processor-p | 1401 (when (spam-group-processor-p |
1397 gnus-newsgroup-name | 1402 gnus-newsgroup-name |
1398 backend | 1403 backend |
1399 classification) | 1404 classification) |
1400 (spam-backend-put-article-todo-list backend | 1405 (spam-backend-put-article-todo-list backend |
1401 classification | 1406 classification |
1402 (spam-list-articles | 1407 (spam-list-articles |
1403 gnus-newsgroup-articles | 1408 gnus-newsgroup-articles |
1404 classification)))))) | 1409 classification)))))) |
1405 | 1410 |
1406 (spam-resolve-registrations-routine) ; do the registrations now | 1411 (spam-resolve-registrations-routine) ; do the registrations now |
1407 | 1412 |
1408 ;; we mark all the leftover spam articles as expired at the end | 1413 ;; we mark all the leftover spam articles as expired at the end |
1409 (dolist (article (spam-list-articles | 1414 (dolist (article (spam-list-articles |
1410 gnus-newsgroup-articles | 1415 gnus-newsgroup-articles |
1411 'spam)) | 1416 'spam)) |
1412 (gnus-summary-mark-article article gnus-expirable-mark))) | 1417 (gnus-summary-mark-article article gnus-expirable-mark))) |
1413 | 1418 |
1414 (setq spam-old-articles nil)) | 1419 (setq spam-old-articles nil)) |
1415 | 1420 |
1416 ;;}}} | 1421 ;;}}} |
1427 | 1432 |
1428 ;; remove the current process mark | 1433 ;; remove the current process mark |
1429 (gnus-summary-kill-process-mark) | 1434 (gnus-summary-kill-process-mark) |
1430 | 1435 |
1431 (let ((backend-supports-deletions | 1436 (let ((backend-supports-deletions |
1432 (gnus-check-backend-function | 1437 (gnus-check-backend-function |
1433 'request-move-article gnus-newsgroup-name)) | 1438 'request-move-article gnus-newsgroup-name)) |
1434 (respool-method (gnus-find-method-for-group gnus-newsgroup-name)) | 1439 (respool-method (gnus-find-method-for-group gnus-newsgroup-name)) |
1435 article mark deletep respool) | 1440 article mark deletep respool valid-move-destinations) |
1436 | 1441 |
1437 (when (member 'respool groups) | 1442 (when (member 'respool groups) |
1438 (setq respool t) ; boolean for later | 1443 (setq respool t) ; boolean for later |
1439 (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it | 1444 (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it |
1445 | |
1446 ;; exclude invalid move destinations | |
1447 (dolist (group groups) | |
1448 (unless | |
1449 (or | |
1450 (and | |
1451 (eq classification 'spam) | |
1452 (spam-group-spam-contents-p gnus-newsgroup-name) | |
1453 (spam-group-spam-contents-p group) | |
1454 (gnus-message | |
1455 3 | |
1456 "Sorry, can't move spam from spam group %s to spam group %s" | |
1457 gnus-newsgroup-name | |
1458 group)) | |
1459 (and | |
1460 (eq classification 'ham) | |
1461 (spam-group-ham-contents-p gnus-newsgroup-name) | |
1462 (spam-group-ham-contents-p group) | |
1463 (gnus-message | |
1464 3 | |
1465 "Sorry, can't move ham from ham group %s to ham group %s" | |
1466 gnus-newsgroup-name | |
1467 group))) | |
1468 (push group valid-move-destinations))) | |
1469 | |
1470 (setq groups (nreverse valid-move-destinations)) | |
1440 | 1471 |
1441 ;; now do the actual move | 1472 ;; now do the actual move |
1442 (dolist (group groups) | 1473 (dolist (group groups) |
1474 | |
1443 (when (and articles (stringp group)) | 1475 (when (and articles (stringp group)) |
1444 | 1476 |
1445 ;; first, mark the article with the process mark and, if needed, | 1477 ;; first, mark the article with the process mark and, if needed, |
1446 ;; the unread or expired mark (for ham and spam respectively) | 1478 ;; the unread or expired mark (for ham and spam respectively) |
1479 (dolist (article articles) | |
1480 (when (and (eq classification 'ham) | |
1481 spam-mark-ham-unread-before-move-from-spam-group) | |
1482 (gnus-message 9 "Marking ham article %d unread before move" | |
1483 article) | |
1484 (gnus-summary-mark-article article gnus-unread-mark)) | |
1485 (when (and (eq classification 'spam) | |
1486 (not copy)) | |
1487 (gnus-message 9 "Marking spam article %d expirable before move" | |
1488 article) | |
1489 (gnus-summary-mark-article article gnus-expirable-mark)) | |
1490 (gnus-summary-set-process-mark article) | |
1491 | |
1492 (if respool ; respooling is with a "fake" group | |
1493 (let ((spam-split-disabled | |
1494 (or spam-split-disabled | |
1495 (and (eq classification 'ham) | |
1496 spam-disable-spam-split-during-ham-respool)))) | |
1497 (gnus-message 9 "Respooling article %d with method %s" | |
1498 article respool-method) | |
1499 (gnus-summary-respool-article nil respool-method)) | |
1500 ;; else, we are not respooling | |
1501 (if (or (not backend-supports-deletions) | |
1502 (> (length groups) 1)) | |
1503 (progn ; if copying, copy and set deletep | |
1504 (gnus-message 9 "Copying article %d to group %s" | |
1505 article group) | |
1506 (gnus-summary-copy-article nil group) | |
1507 (setq deletep t)) | |
1508 (gnus-message 9 "Moving article %d to group %s" | |
1509 article group) | |
1510 (gnus-summary-move-article nil group)))))) ; else move articles | |
1511 | |
1512 ;; now delete the articles, unless a) copy is t, and there was a copy done | |
1513 ;; b) a move was done to a single group | |
1514 ;; c) backend-supports-deletions is nil | |
1515 (unless copy | |
1516 (when (and deletep backend-supports-deletions) | |
1447 (dolist (article articles) | 1517 (dolist (article articles) |
1448 (when (and (eq classification 'ham) | |
1449 spam-mark-ham-unread-before-move-from-spam-group) | |
1450 (gnus-message 9 "Marking ham article %d unread before move" | |
1451 article) | |
1452 (gnus-summary-mark-article article gnus-unread-mark)) | |
1453 (when (and (eq classification 'spam) | |
1454 (not copy)) | |
1455 (gnus-message 9 "Marking spam article %d expirable before move" | |
1456 article) | |
1457 (gnus-summary-mark-article article gnus-expirable-mark)) | |
1458 (gnus-summary-set-process-mark article) | 1518 (gnus-summary-set-process-mark article) |
1459 | 1519 (gnus-message 9 "Deleting article %d" article)) |
1460 (if respool ; respooling is with a "fake" group | 1520 (when articles |
1461 (let ((spam-split-disabled | 1521 (let ((gnus-novice-user nil)) ; don't ask me if I'm sure |
1462 (or spam-split-disabled | 1522 (gnus-summary-delete-article nil))))) |
1463 (and (eq classification 'ham) | 1523 (gnus-summary-yank-process-mark) |
1464 spam-disable-spam-split-during-ham-respool)))) | 1524 (length articles))) |
1465 (gnus-message 9 "Respooling article %d with method %s" | |
1466 article respool-method) | |
1467 (gnus-summary-respool-article nil respool-method)) | |
1468 (if (or (not backend-supports-deletions) ; else, we are not respooling | |
1469 (> (length groups) 1)) | |
1470 (progn ; if copying, copy and set deletep | |
1471 (gnus-message 9 "Copying article %d to group %s" | |
1472 article group) | |
1473 (gnus-summary-copy-article nil group) | |
1474 (setq deletep t)) | |
1475 (gnus-message 9 "Moving article %d to group %s" | |
1476 article group) | |
1477 (gnus-summary-move-article nil group))))) ; else move articles | |
1478 | |
1479 ;; now delete the articles, unless a) copy is t, and there was a copy done | |
1480 ;; b) a move was done to a single group | |
1481 ;; c) backend-supports-deletions is nil | |
1482 (unless copy | |
1483 (when (and deletep backend-supports-deletions) | |
1484 (dolist (article articles) | |
1485 (gnus-summary-set-process-mark article) | |
1486 (gnus-message 9 "Deleting article %d" article)) | |
1487 (when articles | |
1488 (let ((gnus-novice-user nil)) ; don't ask me if I'm sure | |
1489 (gnus-summary-delete-article nil))))) | |
1490 | |
1491 (gnus-summary-yank-process-mark) | |
1492 (length articles)))) | |
1493 | 1525 |
1494 (defun spam-copy-spam-routine (articles) | 1526 (defun spam-copy-spam-routine (articles) |
1495 (spam-copy-or-move-routine | 1527 (spam-copy-or-move-routine |
1496 t | 1528 t |
1497 (gnus-parameter-spam-process-destination gnus-newsgroup-name) | 1529 (gnus-parameter-spam-process-destination gnus-newsgroup-name) |
1535 ;; (let ((article-filename)) | 1567 ;; (let ((article-filename)) |
1536 ;; (when (numberp article) | 1568 ;; (when (numberp article) |
1537 ;; (nnml-possibly-change-directory | 1569 ;; (nnml-possibly-change-directory |
1538 ;; (gnus-group-real-name gnus-newsgroup-name)) | 1570 ;; (gnus-group-real-name gnus-newsgroup-name)) |
1539 ;; (setq article-filename (expand-file-name | 1571 ;; (setq article-filename (expand-file-name |
1540 ;; (int-to-string article) nnml-current-directory))) | 1572 ;; (int-to-string article) nnml-current-directory))) |
1541 ;; (if (file-exists-p article-filename) | 1573 ;; (if (file-exists-p article-filename) |
1542 ;; article-filename | 1574 ;; article-filename |
1543 ;; nil))) | 1575 ;; nil))) |
1544 | 1576 |
1545 (defun spam-fetch-field-fast (article field &optional prepared-data-header) | 1577 (defun spam-fetch-field-fast (article field &optional prepared-data-header) |
1546 "Fetch a FIELD for ARTICLE quickly, using the internal gnus-data-list function. | 1578 "Fetch a FIELD for ARTICLE with the internal `gnus-data-list' function. |
1547 When PREPARED-DATA-HEADER is given, don't look in the Gnus data. | 1579 When PREPARED-DATA-HEADER is given, don't look in the Gnus data. |
1548 When FIELD is 'number, ARTICLE can be any number (since we want | 1580 When FIELD is 'number, ARTICLE can be any number (since we want |
1549 to find it out)." | 1581 to find it out)." |
1550 (when (numberp article) | 1582 (when (numberp article) |
1551 (let* ((data-header (or prepared-data-header | 1583 (let* ((data-header (or prepared-data-header |
1552 (spam-fetch-article-header article)))) | 1584 (spam-fetch-article-header article)))) |
1553 (if (arrayp data-header) | 1585 (if (arrayp data-header) |
1554 (cond | 1586 (cond |
1555 ((equal field 'number) | 1587 ((equal field 'number) |
1556 (mail-header-number data-header)) | 1588 (mail-header-number data-header)) |
1557 ((equal field 'from) | 1589 ((equal field 'from) |
1558 (mail-header-from data-header)) | 1590 (mail-header-from data-header)) |
1559 ((equal field 'message-id) | 1591 ((equal field 'message-id) |
1560 (mail-header-message-id data-header)) | 1592 (mail-header-message-id data-header)) |
1561 ((equal field 'subject) | 1593 ((equal field 'subject) |
1562 (mail-header-subject data-header)) | 1594 (mail-header-subject data-header)) |
1563 ((equal field 'references) | 1595 ((equal field 'references) |
1564 (mail-header-references data-header)) | 1596 (mail-header-references data-header)) |
1565 ((equal field 'date) | 1597 ((equal field 'date) |
1566 (mail-header-date data-header)) | 1598 (mail-header-date data-header)) |
1567 ((equal field 'xref) | 1599 ((equal field 'xref) |
1568 (mail-header-xref data-header)) | 1600 (mail-header-xref data-header)) |
1569 ((equal field 'extra) | 1601 ((equal field 'extra) |
1570 (mail-header-extra data-header)) | 1602 (mail-header-extra data-header)) |
1571 (t | 1603 (t |
1572 (gnus-error | 1604 (gnus-error |
1573 5 | 1605 5 |
1574 "spam-fetch-field-fast: unknown field %s requested" | 1606 "spam-fetch-field-fast: unknown field %s requested" |
1575 field) | 1607 field) |
1576 nil)) | 1608 nil)) |
1577 (gnus-message 6 "Article %d has a nil data header" article))))) | 1609 (gnus-message 6 "Article %d has a nil data header" article))))) |
1578 | 1610 |
1579 (defun spam-fetch-field-from-fast (article &optional prepared-data-header) | 1611 (defun spam-fetch-field-from-fast (article &optional prepared-data-header) |
1580 (spam-fetch-field-fast article 'from prepared-data-header)) | 1612 (spam-fetch-field-fast article 'from prepared-data-header)) |
1581 | 1613 |
1582 (defun spam-fetch-field-subject-fast (article &optional prepared-data-header) | 1614 (defun spam-fetch-field-subject-fast (article &optional prepared-data-header) |
1586 (spam-fetch-field-fast article 'message-id prepared-data-header)) | 1618 (spam-fetch-field-fast article 'message-id prepared-data-header)) |
1587 | 1619 |
1588 (defun spam-generate-fake-headers (article) | 1620 (defun spam-generate-fake-headers (article) |
1589 (let ((dh (spam-fetch-article-header article))) | 1621 (let ((dh (spam-fetch-article-header article))) |
1590 (if dh | 1622 (if dh |
1591 (concat | 1623 (concat |
1592 (format | 1624 (format |
1593 ;; 80-character limit makes for strange constructs | 1625 ;; 80-character limit makes for strange constructs |
1594 (concat "From: %s\nSubject: %s\nMessage-ID: %s\n" | 1626 (concat "From: %s\nSubject: %s\nMessage-ID: %s\n" |
1595 "Date: %s\nReferences: %s\nXref: %s\n") | 1627 "Date: %s\nReferences: %s\nXref: %s\n") |
1596 (spam-fetch-field-fast article 'from dh) | 1628 (spam-fetch-field-fast article 'from dh) |
1597 (spam-fetch-field-fast article 'subject dh) | 1629 (spam-fetch-field-fast article 'subject dh) |
1598 (spam-fetch-field-fast article 'message-id dh) | 1630 (spam-fetch-field-fast article 'message-id dh) |
1599 (spam-fetch-field-fast article 'date dh) | 1631 (spam-fetch-field-fast article 'date dh) |
1600 (spam-fetch-field-fast article 'references dh) | 1632 (spam-fetch-field-fast article 'references dh) |
1601 (spam-fetch-field-fast article 'xref dh)) | 1633 (spam-fetch-field-fast article 'xref dh)) |
1602 (when (spam-fetch-field-fast article 'extra dh) | 1634 (when (spam-fetch-field-fast article 'extra dh) |
1603 (format "%s\n" (spam-fetch-field-fast article 'extra dh)))) | 1635 (format "%s\n" (spam-fetch-field-fast article 'extra dh)))) |
1604 (gnus-message | 1636 (gnus-message |
1605 5 | 1637 5 |
1606 "spam-generate-fake-headers: article %d didn't have a valid header" | 1638 "spam-generate-fake-headers: article %d didn't have a valid header" |
1607 article)))) | 1639 article)))) |
1608 | 1640 |
1625 (interactive) | 1657 (interactive) |
1626 (setq spam-split-last-successful-check nil) | 1658 (setq spam-split-last-successful-check nil) |
1627 (unless spam-split-disabled | 1659 (unless spam-split-disabled |
1628 (let ((spam-split-group-choice spam-split-group)) | 1660 (let ((spam-split-group-choice spam-split-group)) |
1629 (dolist (check specific-checks) | 1661 (dolist (check specific-checks) |
1630 (when (stringp check) | 1662 (when (stringp check) |
1631 (setq spam-split-group-choice check) | 1663 (setq spam-split-group-choice check) |
1632 (setq specific-checks (delq check specific-checks)))) | 1664 (setq specific-checks (delq check specific-checks)))) |
1633 | 1665 |
1634 (let ((spam-split-group spam-split-group-choice) | 1666 (let ((spam-split-group spam-split-group-choice) |
1635 (widening-needed-check (spam-widening-needed-p specific-checks))) | 1667 (widening-needed-check (spam-widening-needed-p specific-checks))) |
1636 (save-excursion | 1668 (save-excursion |
1637 (save-restriction | 1669 (save-restriction |
1638 (when widening-needed-check | 1670 (when widening-needed-check |
1639 (widen) | 1671 (widen) |
1640 (gnus-message 8 "spam-split: widening the buffer (%s requires it)" | 1672 (gnus-message 8 "spam-split: widening the buffer (%s requires it)" |
1641 widening-needed-check)) | 1673 widening-needed-check)) |
1642 (let ((backends (spam-backend-list)) | 1674 (let ((backends (spam-backend-list)) |
1643 decision) | 1675 decision) |
1644 (while (and backends (not decision)) | 1676 (while (and backends (not decision)) |
1645 (let* ((backend (pop backends)) | 1677 (let* ((backend (pop backends)) |
1646 (check-function (spam-backend-check backend)) | 1678 (check-function (spam-backend-check backend)) |
1647 (spam-split-group (if spam-split-symbolic-return | 1679 (spam-split-group (if spam-split-symbolic-return |
1648 'spam | 1680 'spam |
1649 spam-split-group))) | 1681 spam-split-group))) |
1650 (when (or | 1682 (when (or |
1651 ;; either, given specific checks, this is one of them | 1683 ;; either, given specific checks, this is one of them |
1652 (memq backend specific-checks) | 1684 (memq backend specific-checks) |
1653 ;; or, given no specific checks, spam-use-CHECK is set | 1685 ;; or, given no specific checks, spam-use-CHECK is set |
1654 (and (null specific-checks) (symbol-value backend))) | 1686 (and (null specific-checks) (symbol-value backend))) |
1655 (gnus-message 6 "spam-split: calling the %s function" | 1687 (gnus-message 6 "spam-split: calling the %s function" |
1656 check-function) | 1688 check-function) |
1657 (setq decision (funcall check-function)) | 1689 (setq decision (funcall check-function)) |
1658 ;; if we got a decision at all, save the current check | 1690 ;; if we got a decision at all, save the current check |
1659 (when decision | 1691 (when decision |
1660 (setq spam-split-last-successful-check backend)) | 1692 (setq spam-split-last-successful-check backend)) |
1661 | 1693 |
1662 (when (eq decision 'spam) | 1694 (when (eq decision 'spam) |
1663 (unless spam-split-symbolic-return | 1695 (unless spam-split-symbolic-return |
1664 (gnus-error | 1696 (gnus-error |
1665 5 | 1697 5 |
1666 (format "spam-split got %s but %s is nil" | 1698 (format "spam-split got %s but %s is nil" |
1667 decision | 1699 decision |
1668 spam-split-symbolic-return))))))) | 1700 spam-split-symbolic-return))))))) |
1669 (if (eq decision t) | 1701 (if (eq decision t) |
1670 (if spam-split-symbolic-return-positive 'ham nil) | 1702 (if spam-split-symbolic-return-positive 'ham nil) |
1671 decision)))))))) | 1703 decision)))))))) |
1672 | 1704 |
1673 (defun spam-find-spam () | 1705 (defun spam-find-spam () |
1674 "Detect spam in the current newsgroup using `spam-split'." | 1706 "Detect spam in the current newsgroup using `spam-split'." |
1675 (interactive) | 1707 (interactive) |
1676 | 1708 |
1677 (let* ((group gnus-newsgroup-name) | 1709 (let* ((group gnus-newsgroup-name) |
1678 (autodetect (gnus-parameter-spam-autodetect group)) | 1710 (autodetect (gnus-parameter-spam-autodetect group)) |
1679 (methods (gnus-parameter-spam-autodetect-methods group)) | 1711 (methods (gnus-parameter-spam-autodetect-methods group)) |
1680 (first-method (nth 0 methods)) | 1712 (first-method (nth 0 methods)) |
1681 (articles (if spam-autodetect-recheck-messages | 1713 (articles (if spam-autodetect-recheck-messages |
1682 gnus-newsgroup-articles | 1714 gnus-newsgroup-articles |
1683 gnus-newsgroup-unseen)) | 1715 gnus-newsgroup-unseen)) |
1684 article-cannot-be-faked) | 1716 article-cannot-be-faked) |
1685 | 1717 |
1686 | 1718 |
1687 (dolist (backend methods) | 1719 (dolist (backend methods) |
1688 (when (spam-backend-statistical-p backend) | 1720 (when (spam-backend-statistical-p backend) |
1689 (setq article-cannot-be-faked t) | 1721 (setq article-cannot-be-faked t) |
1690 (return))) | 1722 (return))) |
1691 | 1723 |
1692 (when (memq 'default methods) | 1724 (when (memq 'default methods) |
1693 (setq article-cannot-be-faked t)) | 1725 (setq article-cannot-be-faked t)) |
1694 | 1726 |
1695 (when (and autodetect | 1727 (when (and autodetect |
1696 (not (equal first-method 'none))) | 1728 (not (equal first-method 'none))) |
1697 (mapcar | 1729 (mapcar |
1698 (lambda (article) | 1730 (lambda (article) |
1699 (let ((id (spam-fetch-field-message-id-fast article)) | 1731 (let ((id (spam-fetch-field-message-id-fast article)) |
1700 (subject (spam-fetch-field-subject-fast article)) | 1732 (subject (spam-fetch-field-subject-fast article)) |
1701 (sender (spam-fetch-field-from-fast article)) | 1733 (sender (spam-fetch-field-from-fast article)) |
1702 registry-lookup) | 1734 registry-lookup) |
1703 | 1735 |
1704 (unless id | 1736 (unless id |
1705 (gnus-message 6 "Article %d has no message ID!" article)) | 1737 (gnus-message 6 "Article %d has no message ID!" article)) |
1706 | 1738 |
1707 (when (and id spam-log-to-registry) | 1739 (when (and id spam-log-to-registry) |
1708 (setq registry-lookup (spam-log-registration-type id 'incoming)) | 1740 (setq registry-lookup (spam-log-registration-type id 'incoming)) |
1709 (when registry-lookup | 1741 (when registry-lookup |
1710 (gnus-message | 1742 (gnus-message |
1711 9 | 1743 9 |
1712 "spam-find-spam: message %s was already registered incoming" | 1744 "spam-find-spam: message %s was already registered incoming" |
1713 id))) | 1745 id))) |
1714 | 1746 |
1715 (let* ((spam-split-symbolic-return t) | 1747 (let* ((spam-split-symbolic-return t) |
1716 (spam-split-symbolic-return-positive t) | 1748 (spam-split-symbolic-return-positive t) |
1717 (fake-headers (spam-generate-fake-headers article)) | 1749 (fake-headers (spam-generate-fake-headers article)) |
1718 (split-return | 1750 (split-return |
1719 (or registry-lookup | 1751 (or registry-lookup |
1720 (with-temp-buffer | 1752 (with-temp-buffer |
1721 (if article-cannot-be-faked | 1753 (if article-cannot-be-faked |
1722 (gnus-request-article-this-buffer | 1754 (gnus-request-article-this-buffer |
1723 article | 1755 article |
1724 group) | 1756 group) |
1725 ;; else, we fake the article | 1757 ;; else, we fake the article |
1726 (when fake-headers (insert fake-headers))) | 1758 (when fake-headers (insert fake-headers))) |
1727 (if (or (null first-method) | 1759 (if (or (null first-method) |
1728 (equal first-method 'default)) | 1760 (equal first-method 'default)) |
1729 (spam-split) | 1761 (spam-split) |
1730 (apply 'spam-split methods)))))) | 1762 (apply 'spam-split methods)))))) |
1731 (if (equal split-return 'spam) | 1763 (if (equal split-return 'spam) |
1732 (gnus-summary-mark-article article gnus-spam-mark)) | 1764 (gnus-summary-mark-article article gnus-spam-mark)) |
1733 | 1765 |
1734 (when (and id split-return spam-log-to-registry) | 1766 (when (and id split-return spam-log-to-registry) |
1735 (when (zerop (gnus-registry-group-count id)) | 1767 (when (zerop (gnus-registry-group-count id)) |
1736 (gnus-registry-add-group | 1768 (gnus-registry-add-group |
1737 id group subject sender)) | 1769 id group subject sender)) |
1738 | 1770 |
1739 (unless registry-lookup | 1771 (unless registry-lookup |
1740 (spam-log-processing-to-registry | 1772 (spam-log-processing-to-registry |
1741 id | 1773 id |
1742 'incoming | 1774 'incoming |
1743 split-return | 1775 split-return |
1744 spam-split-last-successful-check | 1776 spam-split-last-successful-check |
1745 group)))))) | 1777 group)))))) |
1746 articles)))) | 1778 articles)))) |
1747 | 1779 |
1748 ;;}}} | 1780 ;;}}} |
1749 | 1781 |
1750 ;;{{{ registration/unregistration functions | 1782 ;;{{{ registration/unregistration functions |
1752 (defun spam-resolve-registrations-routine () | 1784 (defun spam-resolve-registrations-routine () |
1753 "Go through the backends and register or unregister articles as needed." | 1785 "Go through the backends and register or unregister articles as needed." |
1754 (dolist (backend-type '(non-mover mover)) | 1786 (dolist (backend-type '(non-mover mover)) |
1755 (dolist (classification (spam-classifications)) | 1787 (dolist (classification (spam-classifications)) |
1756 (dolist (backend (spam-backend-list backend-type)) | 1788 (dolist (backend (spam-backend-list backend-type)) |
1757 (let ((rlist (spam-backend-get-article-todo-list | 1789 (let ((rlist (spam-backend-get-article-todo-list |
1758 backend classification)) | 1790 backend classification)) |
1759 (ulist (spam-backend-get-article-todo-list | 1791 (ulist (spam-backend-get-article-todo-list |
1760 backend classification t)) | 1792 backend classification t)) |
1761 (delcount 0)) | 1793 (delcount 0)) |
1762 | 1794 |
1763 ;; clear the old lists right away | 1795 ;; clear the old lists right away |
1764 (spam-backend-put-article-todo-list backend | 1796 (spam-backend-put-article-todo-list backend |
1765 classification | 1797 classification |
1766 nil | 1798 nil |
1767 nil) | 1799 nil) |
1768 (spam-backend-put-article-todo-list backend | 1800 (spam-backend-put-article-todo-list backend |
1769 classification | 1801 classification |
1770 nil | 1802 nil |
1771 t) | 1803 t) |
1772 | 1804 |
1773 ;; eliminate duplicates | 1805 ;; eliminate duplicates |
1774 (dolist (article (copy-sequence ulist)) | 1806 (dolist (article (copy-sequence ulist)) |
1775 (when (memq article rlist) | 1807 (when (memq article rlist) |
1776 (incf delcount) | 1808 (incf delcount) |
1777 (setq rlist (delq article rlist)) | 1809 (setq rlist (delq article rlist)) |
1778 (setq ulist (delq article ulist)))) | 1810 (setq ulist (delq article ulist)))) |
1779 | 1811 |
1780 (unless (zerop delcount) | 1812 (unless (zerop delcount) |
1781 (gnus-message | 1813 (gnus-message |
1782 9 | 1814 9 |
1783 "%d messages were saved the trouble of unregistering and then registering" | 1815 "%d messages did not have to unregister and then register" |
1784 delcount)) | 1816 delcount)) |
1785 | 1817 |
1786 ;; unregister articles | 1818 ;; unregister articles |
1787 (unless (zerop (length ulist)) | 1819 (unless (zerop (length ulist)) |
1788 (let ((num (spam-unregister-routine classification backend ulist))) | 1820 (let ((num (spam-unregister-routine classification backend ulist))) |
1789 (when (> num 0) | 1821 (when (> num 0) |
1790 (gnus-message | 1822 (gnus-message |
1791 6 | 1823 6 |
1792 "%d %s messages were unregistered by backend %s." | 1824 "%d %s messages were unregistered by backend %s." |
1793 num | 1825 num |
1794 classification | 1826 classification |
1795 backend)))) | 1827 backend)))) |
1796 | 1828 |
1797 ;; register articles | 1829 ;; register articles |
1798 (unless (zerop (length rlist)) | 1830 (unless (zerop (length rlist)) |
1799 (let ((num (spam-register-routine classification backend rlist))) | 1831 (let ((num (spam-register-routine classification backend rlist))) |
1800 (when (> num 0) | 1832 (when (> num 0) |
1801 (gnus-message | 1833 (gnus-message |
1802 6 | 1834 6 |
1803 "%d %s messages were registered by backend %s." | 1835 "%d %s messages were registered by backend %s." |
1804 num | 1836 num |
1805 classification | 1837 classification |
1806 backend))))))))) | 1838 backend))))))))) |
1807 | 1839 |
1808 (defun spam-unregister-routine (classification | 1840 (defun spam-unregister-routine (classification |
1809 backend | 1841 backend |
1810 specific-articles) | 1842 specific-articles) |
1811 (spam-register-routine classification backend specific-articles t)) | 1843 (spam-register-routine classification backend specific-articles t)) |
1812 | 1844 |
1813 (defun spam-register-routine (classification | 1845 (defun spam-register-routine (classification |
1814 backend | 1846 backend |
1815 specific-articles | 1847 specific-articles |
1816 &optional unregister) | 1848 &optional unregister) |
1817 (when (and (spam-classification-valid-p classification) | 1849 (when (and (spam-classification-valid-p classification) |
1818 (spam-backend-valid-p backend)) | 1850 (spam-backend-valid-p backend)) |
1819 (let* ((register-function | 1851 (let* ((register-function |
1820 (spam-backend-function backend classification 'registration)) | 1852 (spam-backend-function backend classification 'registration)) |
1821 (unregister-function | 1853 (unregister-function |
1822 (spam-backend-function backend classification 'unregistration)) | 1854 (spam-backend-function backend classification 'unregistration)) |
1823 (run-function (if unregister | 1855 (run-function (if unregister |
1824 unregister-function | 1856 unregister-function |
1825 register-function)) | 1857 register-function)) |
1826 (log-function (if unregister | 1858 (log-function (if unregister |
1827 'spam-log-undo-registration | 1859 'spam-log-undo-registration |
1828 'spam-log-processing-to-registry)) | 1860 'spam-log-processing-to-registry)) |
1829 article articles) | 1861 article articles) |
1830 | 1862 |
1831 (when run-function | 1863 (when run-function |
1832 ;; make list of articles, using specific-articles if given | 1864 ;; make list of articles, using specific-articles if given |
1833 (setq articles (or specific-articles | 1865 (setq articles (or specific-articles |
1834 (spam-list-articles | 1866 (spam-list-articles |
1835 gnus-newsgroup-articles | 1867 gnus-newsgroup-articles |
1836 classification))) | 1868 classification))) |
1837 ;; process them | 1869 ;; process them |
1838 (when (> (length articles) 0) | 1870 (when (> (length articles) 0) |
1839 (gnus-message 5 "%s %d %s articles as %s using backend %s" | 1871 (gnus-message 5 "%s %d %s articles as %s using backend %s" |
1840 (if unregister "Unregistering" "Registering") | 1872 (if unregister "Unregistering" "Registering") |
1841 (length articles) | 1873 (length articles) |
1842 (if specific-articles "specific" "") | 1874 (if specific-articles "specific" "") |
1843 classification | 1875 classification |
1844 backend) | 1876 backend) |
1845 (funcall run-function articles) | 1877 (funcall run-function articles) |
1846 ;; now log all the registrations (or undo them, depending on | 1878 ;; now log all the registrations (or undo them, depending on |
1847 ;; unregister) | 1879 ;; unregister) |
1848 (dolist (article articles) | 1880 (dolist (article articles) |
1849 (funcall log-function | 1881 (funcall log-function |
1850 (spam-fetch-field-message-id-fast article) | 1882 (spam-fetch-field-message-id-fast article) |
1851 'process | 1883 'process |
1852 classification | 1884 classification |
1853 backend | 1885 backend |
1854 gnus-newsgroup-name)))) | 1886 gnus-newsgroup-name)))) |
1855 ;; return the number of articles processed | 1887 ;; return the number of articles processed |
1856 (length articles)))) | 1888 (length articles)))) |
1857 | 1889 |
1858 ;;; log a ham- or spam-processor invocation to the registry | 1890 ;;; log a ham- or spam-processor invocation to the registry |
1859 (defun spam-log-processing-to-registry (id type classification backend group) | 1891 (defun spam-log-processing-to-registry (id type classification backend group) |
1860 (when spam-log-to-registry | 1892 (when spam-log-to-registry |
1861 (if (and (stringp id) | 1893 (if (and (stringp id) |
1862 (stringp group) | 1894 (stringp group) |
1863 (spam-process-type-valid-p type) | 1895 (spam-process-type-valid-p type) |
1864 (spam-classification-valid-p classification) | 1896 (spam-classification-valid-p classification) |
1865 (spam-backend-valid-p backend)) | 1897 (spam-backend-valid-p backend)) |
1866 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) | 1898 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) |
1867 (cell (list classification backend group))) | 1899 (cell (list classification backend group))) |
1868 (push cell cell-list) | 1900 (push cell cell-list) |
1869 (gnus-registry-store-extra-entry | 1901 (gnus-registry-store-extra-entry |
1870 id | 1902 id |
1871 type | 1903 type |
1872 cell-list)) | 1904 cell-list)) |
1873 | 1905 |
1874 (gnus-error | 1906 (gnus-error |
1875 7 | 1907 7 |
1876 (format "%s call with bad ID, type, classification, spam-backend, or group" | 1908 (format |
1877 "spam-log-processing-to-registry"))))) | 1909 "%s call with bad ID, type, classification, spam-backend, or group" |
1910 "spam-log-processing-to-registry"))))) | |
1878 | 1911 |
1879 ;;; check if a ham- or spam-processor registration has been done | 1912 ;;; check if a ham- or spam-processor registration has been done |
1880 (defun spam-log-registered-p (id type) | 1913 (defun spam-log-registered-p (id type) |
1881 (when spam-log-to-registry | 1914 (when spam-log-to-registry |
1882 (if (and (stringp id) | 1915 (if (and (stringp id) |
1883 (spam-process-type-valid-p type)) | 1916 (spam-process-type-valid-p type)) |
1884 (cdr-safe (gnus-registry-fetch-extra id type)) | 1917 (cdr-safe (gnus-registry-fetch-extra id type)) |
1885 (progn | 1918 (progn |
1886 (gnus-error | 1919 (gnus-error |
1887 7 | 1920 7 |
1888 (format "%s called with bad ID, type, classification, or spam-backend" | 1921 (format "%s called with bad ID, type, classification, or spam-backend" |
1889 "spam-log-registered-p")) | 1922 "spam-log-registered-p")) |
1890 nil)))) | 1923 nil)))) |
1891 | 1924 |
1892 ;;; check what a ham- or spam-processor registration says | 1925 ;;; check what a ham- or spam-processor registration says |
1893 ;;; returns nil if conflicting registrations are found | 1926 ;;; returns nil if conflicting registrations are found |
1894 (defun spam-log-registration-type (id type) | 1927 (defun spam-log-registration-type (id type) |
1895 (let ((count 0) | 1928 (let ((count 0) |
1896 decision) | 1929 decision) |
1897 (dolist (reg (spam-log-registered-p id type)) | 1930 (dolist (reg (spam-log-registered-p id type)) |
1898 (let ((classification (nth 0 reg))) | 1931 (let ((classification (nth 0 reg))) |
1899 (when (spam-classification-valid-p classification) | 1932 (when (spam-classification-valid-p classification) |
1900 (when (and decision | 1933 (when (and decision |
1901 (not (eq classification decision))) | 1934 (not (eq classification decision))) |
1902 (setq count (+ 1 count))) | 1935 (setq count (+ 1 count))) |
1903 (setq decision classification)))) | 1936 (setq decision classification)))) |
1904 (if (< 0 count) | 1937 (if (< 0 count) |
1905 nil | 1938 nil |
1906 decision))) | 1939 decision))) |
1907 | 1940 |
1908 | 1941 |
1909 ;;; check if a ham- or spam-processor registration needs to be undone | 1942 ;;; check if a ham- or spam-processor registration needs to be undone |
1910 (defun spam-log-unregistration-needed-p (id type classification backend) | 1943 (defun spam-log-unregistration-needed-p (id type classification backend) |
1911 (when spam-log-to-registry | 1944 (when spam-log-to-registry |
1912 (if (and (stringp id) | 1945 (if (and (stringp id) |
1913 (spam-process-type-valid-p type) | 1946 (spam-process-type-valid-p type) |
1914 (spam-classification-valid-p classification) | 1947 (spam-classification-valid-p classification) |
1915 (spam-backend-valid-p backend)) | 1948 (spam-backend-valid-p backend)) |
1916 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) | 1949 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) |
1917 found) | 1950 found) |
1918 (dolist (cell cell-list) | 1951 (dolist (cell cell-list) |
1919 (unless found | 1952 (unless found |
1920 (when (and (eq classification (nth 0 cell)) | 1953 (when (and (eq classification (nth 0 cell)) |
1921 (eq backend (nth 1 cell))) | 1954 (eq backend (nth 1 cell))) |
1922 (setq found t)))) | 1955 (setq found t)))) |
1923 found) | 1956 found) |
1924 (progn | 1957 (progn |
1925 (gnus-error | 1958 (gnus-error |
1926 7 | 1959 7 |
1927 (format "%s called with bad ID, type, classification, or spam-backend" | 1960 (format "%s called with bad ID, type, classification, or spam-backend" |
1928 "spam-log-unregistration-needed-p")) | 1961 "spam-log-unregistration-needed-p")) |
1929 nil)))) | 1962 nil)))) |
1930 | 1963 |
1931 | 1964 |
1932 ;;; undo a ham- or spam-processor registration (the group is not used) | 1965 ;;; undo a ham- or spam-processor registration (the group is not used) |
1933 (defun spam-log-undo-registration (id type classification backend &optional group) | 1966 (defun spam-log-undo-registration (id type classification backend |
1967 &optional group) | |
1934 (when (and spam-log-to-registry | 1968 (when (and spam-log-to-registry |
1935 (spam-log-unregistration-needed-p id type classification backend)) | 1969 (spam-log-unregistration-needed-p id type classification backend)) |
1936 (if (and (stringp id) | 1970 (if (and (stringp id) |
1937 (spam-process-type-valid-p type) | 1971 (spam-process-type-valid-p type) |
1938 (spam-classification-valid-p classification) | 1972 (spam-classification-valid-p classification) |
1939 (spam-backend-valid-p backend)) | 1973 (spam-backend-valid-p backend)) |
1940 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) | 1974 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) |
1941 new-cell-list found) | 1975 new-cell-list found) |
1942 (dolist (cell cell-list) | 1976 (dolist (cell cell-list) |
1943 (unless (and (eq classification (nth 0 cell)) | 1977 (unless (and (eq classification (nth 0 cell)) |
1944 (eq backend (nth 1 cell))) | 1978 (eq backend (nth 1 cell))) |
1945 (push cell new-cell-list))) | 1979 (push cell new-cell-list))) |
1946 (gnus-registry-store-extra-entry | 1980 (gnus-registry-store-extra-entry |
1947 id | 1981 id |
1948 type | 1982 type |
1949 new-cell-list)) | 1983 new-cell-list)) |
1950 (progn | 1984 (progn |
1951 (gnus-error 7 (format "%s call with bad ID, type, spam-backend, or group" | 1985 (gnus-error 7 (format |
1952 "spam-log-undo-registration")) | 1986 "%s call with bad ID, type, spam-backend, or group" |
1953 nil)))) | 1987 "spam-log-undo-registration")) |
1988 nil)))) | |
1954 | 1989 |
1955 ;;}}} | 1990 ;;}}} |
1956 | 1991 |
1957 ;;{{{ backend functions | 1992 ;;{{{ backend functions |
1958 | 1993 |
1959 ;;{{{ Gmane xrefs | 1994 ;;{{{ Gmane xrefs |
1960 (defun spam-check-gmane-xref () | 1995 (defun spam-check-gmane-xref () |
1961 (let ((header (or | 1996 (let ((header (or |
1962 (message-fetch-field "Xref") | 1997 (message-fetch-field "Xref") |
1963 (message-fetch-field "Newsgroups")))) | 1998 (message-fetch-field "Newsgroups")))) |
1964 (when header ; return nil when no header | 1999 (when header ; return nil when no header |
1965 (when (string-match spam-gmane-xref-spam-group | 2000 (when (string-match spam-gmane-xref-spam-group |
1966 header) | 2001 header) |
1967 spam-split-group)))) | 2002 spam-split-group)))) |
1968 | 2003 |
1969 ;;}}} | 2004 ;;}}} |
1970 | 2005 |
1971 ;;{{{ Regex body | 2006 ;;{{{ Regex body |
1972 | 2007 |
1973 (defun spam-check-regex-body () | 2008 (defun spam-check-regex-body () |
1974 (let ((spam-regex-headers-ham spam-regex-body-ham) | 2009 (let ((spam-regex-headers-ham spam-regex-body-ham) |
1975 (spam-regex-headers-spam spam-regex-body-spam)) | 2010 (spam-regex-headers-spam spam-regex-body-spam)) |
1976 (spam-check-regex-headers t))) | 2011 (spam-check-regex-headers t))) |
1977 | 2012 |
1978 ;;}}} | 2013 ;;}}} |
1979 | 2014 |
1980 ;;{{{ Regex headers | 2015 ;;{{{ Regex headers |
1981 | 2016 |
1982 (defun spam-check-regex-headers (&optional body) | 2017 (defun spam-check-regex-headers (&optional body) |
1983 (let ((type (if body "body" "header")) | 2018 (let ((type (if body "body" "header")) |
1984 ret found) | 2019 ret found) |
1985 (dolist (h-regex spam-regex-headers-ham) | 2020 (dolist (h-regex spam-regex-headers-ham) |
1986 (unless found | 2021 (unless found |
1987 (goto-char (point-min)) | 2022 (goto-char (point-min)) |
1988 (when (re-search-forward h-regex nil t) | 2023 (when (re-search-forward h-regex nil t) |
1989 (message "Ham regex %s search positive." type) | 2024 (message "Ham regex %s search positive." type) |
1990 (setq found t)))) | 2025 (setq found t)))) |
1991 (dolist (s-regex spam-regex-headers-spam) | 2026 (dolist (s-regex spam-regex-headers-spam) |
1992 (unless found | 2027 (unless found |
1993 (goto-char (point-min)) | 2028 (goto-char (point-min)) |
1994 (when (re-search-forward s-regex nil t) | 2029 (when (re-search-forward s-regex nil t) |
1995 (message "Spam regex %s search positive." type) | 2030 (message "Spam regex %s search positive." type) |
1996 (setq found t) | 2031 (setq found t) |
1997 (setq ret spam-split-group)))) | 2032 (setq ret spam-split-group)))) |
1998 ret)) | 2033 ret)) |
1999 | 2034 |
2000 ;;}}} | 2035 ;;}}} |
2001 | 2036 |
2002 ;;{{{ Blackholes. | 2037 ;;{{{ Blackholes. |
2003 | 2038 |
2004 (defun spam-reverse-ip-string (ip) | 2039 (defun spam-reverse-ip-string (ip) |
2005 (when (stringp ip) | 2040 (when (stringp ip) |
2006 (mapconcat 'identity | 2041 (mapconcat 'identity |
2007 (nreverse (split-string ip "\\.")) | 2042 (nreverse (split-string ip "\\.")) |
2008 "."))) | 2043 "."))) |
2009 | 2044 |
2010 (defun spam-check-blackholes () | 2045 (defun spam-check-blackholes () |
2011 "Check the Received headers for blackholed relays." | 2046 "Check the Received headers for blackholed relays." |
2012 (let ((headers (message-fetch-field "received")) | 2047 (let ((headers (message-fetch-field "received")) |
2013 ips matches) | 2048 ips matches) |
2014 (when headers | 2049 (when headers |
2015 (with-temp-buffer | 2050 (with-temp-buffer |
2016 (insert headers) | 2051 (insert headers) |
2017 (goto-char (point-min)) | 2052 (goto-char (point-min)) |
2018 (gnus-message 6 "Checking headers for relay addresses") | 2053 (gnus-message 6 "Checking headers for relay addresses") |
2019 (while (re-search-forward | 2054 (while (re-search-forward |
2020 "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) | 2055 "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) |
2021 (gnus-message 9 "Blackhole search found host IP %s." (match-string 1)) | 2056 (gnus-message 9 "Blackhole search found host IP %s." (match-string 1)) |
2022 (push (spam-reverse-ip-string (match-string 1)) | 2057 (push (spam-reverse-ip-string (match-string 1)) |
2023 ips))) | 2058 ips))) |
2024 (dolist (server spam-blackhole-servers) | 2059 (dolist (server spam-blackhole-servers) |
2025 (dolist (ip ips) | 2060 (dolist (ip ips) |
2026 (unless (and spam-blackhole-good-server-regex | 2061 (unless (and spam-blackhole-good-server-regex |
2027 ;; match the good-server-regex against the reversed (again) IP string | 2062 ;; match against the reversed (again) IP string |
2028 (string-match | 2063 (string-match |
2029 spam-blackhole-good-server-regex | 2064 spam-blackhole-good-server-regex |
2030 (spam-reverse-ip-string ip))) | 2065 (spam-reverse-ip-string ip))) |
2031 (unless matches | 2066 (unless matches |
2032 (let ((query-string (concat ip "." server))) | 2067 (let ((query-string (concat ip "." server))) |
2033 (if spam-use-dig | 2068 (if spam-use-dig |
2034 (let ((query-result (query-dig query-string))) | 2069 (let ((query-result (query-dig query-string))) |
2035 (when query-result | 2070 (when query-result |
2036 (gnus-message 6 "(DIG): positive blackhole check '%s'" | 2071 (gnus-message 6 "(DIG): positive blackhole check '%s'" |
2037 query-result) | 2072 query-result) |
2038 (push (list ip server query-result) | 2073 (push (list ip server query-result) |
2039 matches))) | 2074 matches))) |
2040 ;; else, if not using dig.el | 2075 ;; else, if not using dig.el |
2041 (when (dns-query query-string) | 2076 (when (dns-query query-string) |
2042 (gnus-message 6 "positive blackhole check") | 2077 (gnus-message 6 "positive blackhole check") |
2043 (push (list ip server (dns-query query-string 'TXT)) | 2078 (push (list ip server (dns-query query-string 'TXT)) |
2044 matches))))))))) | 2079 matches))))))))) |
2045 (when matches | 2080 (when matches |
2046 spam-split-group))) | 2081 spam-split-group))) |
2047 ;;}}} | 2082 ;;}}} |
2048 | 2083 |
2049 ;;{{{ Hashcash. | 2084 ;;{{{ Hashcash. |
2050 | 2085 |
2051 (defun spam-check-hashcash () | 2086 (defun spam-check-hashcash () |
2052 "Check the headers for hashcash payments." | 2087 "Check the headers for hashcash payments." |
2053 (ignore-errors (mail-check-payment))) ;mail-check-payment returns a boolean | 2088 (ignore-errors (mail-check-payment))) ;mail-check-payment returns a boolean |
2054 | 2089 |
2055 ;;}}} | 2090 ;;}}} |
2056 | 2091 |
2057 ;;{{{ BBDB | 2092 ;;{{{ BBDB |
2058 | 2093 |
2069 ;; Autoloaded in message, which we require. | 2104 ;; Autoloaded in message, which we require. |
2070 (declare-function gnus-extract-address-components "gnus-util" (from)) | 2105 (declare-function gnus-extract-address-components "gnus-util" (from)) |
2071 | 2106 |
2072 (eval-and-compile | 2107 (eval-and-compile |
2073 (when (condition-case nil | 2108 (when (condition-case nil |
2074 (progn | 2109 (progn |
2075 (require 'bbdb) | 2110 (require 'bbdb) |
2076 (require 'bbdb-com)) | 2111 (require 'bbdb-com)) |
2077 (file-error | 2112 (file-error |
2078 ;; `bbdb-records' should not be bound as an autoload function | 2113 ;; `bbdb-records' should not be bound as an autoload function |
2079 ;; before loading bbdb because of `bbdb-hashtable-size'. | 2114 ;; before loading bbdb because of `bbdb-hashtable-size'. |
2080 (defalias 'bbdb-records 'ignore) | 2115 (defalias 'bbdb-records 'ignore) |
2081 (defalias 'spam-BBDB-register-routine 'ignore) | 2116 (defalias 'spam-BBDB-register-routine 'ignore) |
2082 (defalias 'spam-enter-ham-BBDB 'ignore) | 2117 (defalias 'spam-enter-ham-BBDB 'ignore) |
2083 nil)) | 2118 nil)) |
2084 | 2119 |
2085 ;; when the BBDB changes, we want to clear out our cache | 2120 ;; when the BBDB changes, we want to clear out our cache |
2086 (defun spam-clear-cache-BBDB (&rest immaterial) | 2121 (defun spam-clear-cache-BBDB (&rest immaterial) |
2087 (spam-clear-cache 'spam-use-BBDB)) | 2122 (spam-clear-cache 'spam-use-BBDB)) |
2088 | 2123 |
2089 (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB) | 2124 (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB) |
2090 | 2125 |
2091 (defun spam-enter-ham-BBDB (addresses &optional remove) | 2126 (defun spam-enter-ham-BBDB (addresses &optional remove) |
2092 "Enter an address into the BBDB; implies ham (non-spam) sender" | 2127 "Enter an address into the BBDB; implies ham (non-spam) sender" |
2093 (dolist (from addresses) | 2128 (dolist (from addresses) |
2094 (when (stringp from) | 2129 (when (stringp from) |
2095 (let* ((parsed-address (gnus-extract-address-components from)) | 2130 (let* ((parsed-address (gnus-extract-address-components from)) |
2096 (name (or (nth 0 parsed-address) "Ham Sender")) | 2131 (name (or (nth 0 parsed-address) "Ham Sender")) |
2097 (remove-function (if remove | 2132 (remove-function (if remove |
2098 'bbdb-delete-record-internal | 2133 'bbdb-delete-record-internal |
2099 'ignore)) | 2134 'ignore)) |
2100 (net-address (nth 1 parsed-address)) | 2135 (net-address (nth 1 parsed-address)) |
2101 (record (and net-address | 2136 (record (and net-address |
2102 (bbdb-search-simple nil net-address)))) | 2137 (bbdb-search-simple nil net-address)))) |
2103 (when net-address | 2138 (when net-address |
2104 (gnus-message 6 "%s address %s %s BBDB" | 2139 (gnus-message 6 "%s address %s %s BBDB" |
2105 (if remove "Deleting" "Adding") | 2140 (if remove "Deleting" "Adding") |
2106 from | 2141 from |
2107 (if remove "from" "to")) | 2142 (if remove "from" "to")) |
2108 (if record | 2143 (if record |
2109 (funcall remove-function record) | 2144 (funcall remove-function record) |
2110 (bbdb-create-internal name nil net-address nil nil | 2145 (bbdb-create-internal name nil net-address nil nil |
2111 "ham sender added by spam.el"))))))) | 2146 "ham sender added by spam.el"))))))) |
2112 | 2147 |
2113 (defun spam-BBDB-register-routine (articles &optional unregister) | 2148 (defun spam-BBDB-register-routine (articles &optional unregister) |
2114 (let (addresses) | 2149 (let (addresses) |
2115 (dolist (article articles) | 2150 (dolist (article articles) |
2116 (when (stringp (spam-fetch-field-from-fast article)) | 2151 (when (stringp (spam-fetch-field-from-fast article)) |
2117 (push (spam-fetch-field-from-fast article) addresses))) | 2152 (push (spam-fetch-field-from-fast article) addresses))) |
2118 ;; now do the register/unregister action | 2153 ;; now do the register/unregister action |
2119 (spam-enter-ham-BBDB addresses unregister))) | 2154 (spam-enter-ham-BBDB addresses unregister))) |
2120 | 2155 |
2121 (defun spam-BBDB-unregister-routine (articles) | 2156 (defun spam-BBDB-unregister-routine (articles) |
2122 (spam-BBDB-register-routine articles t)) | 2157 (spam-BBDB-register-routine articles t)) |
2123 | 2158 |
2124 (defun spam-check-BBDB () | 2159 (defun spam-check-BBDB () |
2125 "Mail from people in the BBDB is classified as ham or non-spam" | 2160 "Mail from people in the BBDB is classified as ham or non-spam" |
2126 (let ((who (message-fetch-field "from")) | 2161 (let ((who (message-fetch-field "from")) |
2127 bbdb-cache bbdb-hashtable) | 2162 bbdb-cache bbdb-hashtable) |
2128 (when spam-cache-lookups | 2163 (when spam-cache-lookups |
2129 (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches)) | 2164 (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches)) |
2130 (unless bbdb-cache | 2165 (unless bbdb-cache |
2131 (setq bbdb-cache (make-vector 17 0)) ; a good starting hash value | 2166 (setq bbdb-cache (make-vector 17 0)) ; a good starting hash value |
2132 ;; this is based on the expanded (bbdb-hashtable) macro | 2167 ;; this is based on the expanded (bbdb-hashtable) macro |
2133 ;; without the debugging support | 2168 ;; without the debugging support |
2134 (with-current-buffer (bbdb-buffer) | 2169 (with-current-buffer (bbdb-buffer) |
2135 (save-excursion | 2170 (save-excursion |
2136 (save-window-excursion | 2171 (save-window-excursion |
2137 (bbdb-records nil t) | 2172 (bbdb-records nil t) |
2138 (mapatoms | 2173 (mapatoms |
2139 (lambda (symbol) | 2174 (lambda (symbol) |
2140 (intern (downcase (symbol-name symbol)) bbdb-cache)) | 2175 (intern (downcase (symbol-name symbol)) bbdb-cache)) |
2141 bbdb-hashtable)))) | 2176 bbdb-hashtable)))) |
2142 (puthash 'spam-use-BBDB bbdb-cache spam-caches))) | 2177 (puthash 'spam-use-BBDB bbdb-cache spam-caches))) |
2143 (when who | 2178 (when who |
2144 (setq who (nth 1 (gnus-extract-address-components who))) | 2179 (setq who (nth 1 (gnus-extract-address-components who))) |
2145 (if | 2180 (if |
2146 (if spam-cache-lookups | 2181 (if spam-cache-lookups |
2147 (intern-soft (downcase who) bbdb-cache) | 2182 (intern-soft (downcase who) bbdb-cache) |
2148 (bbdb-search-simple nil who)) | 2183 (bbdb-search-simple nil who)) |
2149 t | 2184 t |
2150 (if spam-use-BBDB-exclusive | 2185 (if spam-use-BBDB-exclusive |
2151 spam-split-group | 2186 spam-split-group |
2152 nil))))))) | 2187 nil))))))) |
2153 | 2188 |
2154 ;;}}} | 2189 ;;}}} |
2155 | 2190 |
2156 ;;{{{ ifile | 2191 ;;{{{ ifile |
2157 | 2192 |
2167 nil)) | 2202 nil)) |
2168 | 2203 |
2169 (defun spam-check-ifile () | 2204 (defun spam-check-ifile () |
2170 "Check the ifile backend for the classification of this message." | 2205 "Check the ifile backend for the classification of this message." |
2171 (let ((article-buffer-name (buffer-name)) | 2206 (let ((article-buffer-name (buffer-name)) |
2172 category return) | 2207 category return) |
2173 (with-temp-buffer | 2208 (with-temp-buffer |
2174 (let ((temp-buffer-name (buffer-name)) | 2209 (let ((temp-buffer-name (buffer-name)) |
2175 (db-param (spam-get-ifile-database-parameter))) | 2210 (db-param (spam-get-ifile-database-parameter))) |
2176 (with-current-buffer article-buffer-name | 2211 (with-current-buffer article-buffer-name |
2177 (apply 'call-process-region | 2212 (apply 'call-process-region |
2178 (point-min) (point-max) spam-ifile-program | 2213 (point-min) (point-max) spam-ifile-program |
2179 nil temp-buffer-name nil "-c" | 2214 nil temp-buffer-name nil "-c" |
2180 (if db-param `(,db-param "-q") `("-q")))) | 2215 (if db-param `(,db-param "-q") `("-q")))) |
2181 ;; check the return now (we're back in the temp buffer) | 2216 ;; check the return now (we're back in the temp buffer) |
2182 (goto-char (point-min)) | 2217 (goto-char (point-min)) |
2183 (if (not (eobp)) | 2218 (if (not (eobp)) |
2184 (setq category (buffer-substring (point) (point-at-eol)))) | 2219 (setq category (buffer-substring (point) (point-at-eol)))) |
2185 (when (not (zerop (length category))) ; we need a category here | 2220 (when (not (zerop (length category))) ; we need a category here |
2186 (if spam-ifile-all-categories | 2221 (if spam-ifile-all-categories |
2187 (setq return category) | 2222 (setq return category) |
2188 ;; else, if spam-ifile-all-categories is not set... | 2223 ;; else, if spam-ifile-all-categories is not set... |
2189 (when (string-equal spam-ifile-spam-category category) | 2224 (when (string-equal spam-ifile-spam-category category) |
2190 (setq return spam-split-group)))))) ; note return is nil otherwise | 2225 (setq return spam-split-group)))))) ; note return is nil otherwise |
2191 return)) | 2226 return)) |
2192 | 2227 |
2193 (defun spam-ifile-register-with-ifile (articles category &optional unregister) | 2228 (defun spam-ifile-register-with-ifile (articles category &optional unregister) |
2194 "Register an article, given as a string, with a category. | 2229 "Register an article, given as a string, with a category. |
2195 Uses `gnus-newsgroup-name' if category is nil (for ham registration)." | 2230 Uses `gnus-newsgroup-name' if category is nil (for ham registration)." |
2196 (let ((category (or category gnus-newsgroup-name)) | 2231 (let ((category (or category gnus-newsgroup-name)) |
2197 (add-or-delete-option (if unregister "-d" "-i")) | 2232 (add-or-delete-option (if unregister "-d" "-i")) |
2198 (db (spam-get-ifile-database-parameter)) | 2233 (db (spam-get-ifile-database-parameter)) |
2199 parameters) | 2234 parameters) |
2200 (with-temp-buffer | 2235 (with-temp-buffer |
2201 (dolist (article articles) | 2236 (dolist (article articles) |
2202 (let ((article-string (spam-get-article-as-string article))) | 2237 (let ((article-string (spam-get-article-as-string article))) |
2203 (when (stringp article-string) | 2238 (when (stringp article-string) |
2204 (insert article-string)))) | 2239 (insert article-string)))) |
2205 (apply 'call-process-region | 2240 (apply 'call-process-region |
2206 (point-min) (point-max) spam-ifile-program | 2241 (point-min) (point-max) spam-ifile-program |
2207 nil nil nil | 2242 nil nil nil |
2208 add-or-delete-option category | 2243 add-or-delete-option category |
2209 (if db `(,db "-h") `("-h")))))) | 2244 (if db `(,db "-h") `("-h")))))) |
2210 | 2245 |
2211 (defun spam-ifile-register-spam-routine (articles &optional unregister) | 2246 (defun spam-ifile-register-spam-routine (articles &optional unregister) |
2212 (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister)) | 2247 (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister)) |
2213 | 2248 |
2214 (defun spam-ifile-unregister-spam-routine (articles) | 2249 (defun spam-ifile-unregister-spam-routine (articles) |
2233 (autoload 'spam-stat-save "spam-stat") | 2268 (autoload 'spam-stat-save "spam-stat") |
2234 (autoload 'spam-stat-split-fancy "spam-stat")) | 2269 (autoload 'spam-stat-split-fancy "spam-stat")) |
2235 | 2270 |
2236 (eval-and-compile | 2271 (eval-and-compile |
2237 (when (condition-case nil | 2272 (when (condition-case nil |
2238 (let ((spam-stat-install-hooks nil)) | 2273 (let ((spam-stat-install-hooks nil)) |
2239 (require 'spam-stat)) | 2274 (require 'spam-stat)) |
2240 (file-error | 2275 (file-error |
2241 (defalias 'spam-stat-register-ham-routine 'ignore) | 2276 (defalias 'spam-stat-register-ham-routine 'ignore) |
2242 (defalias 'spam-stat-register-spam-routine 'ignore) | 2277 (defalias 'spam-stat-register-spam-routine 'ignore) |
2243 nil)) | 2278 nil)) |
2244 | 2279 |
2245 (defun spam-check-stat () | 2280 (defun spam-check-stat () |
2246 "Check the spam-stat backend for the classification of this message" | 2281 "Check the spam-stat backend for the classification of this message" |
2247 (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override | 2282 (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override |
2248 (spam-stat-buffer (buffer-name)) ; stat the current buffer | 2283 (spam-stat-buffer (buffer-name)) ; stat the current buffer |
2249 category return) | 2284 category return) |
2250 (spam-stat-split-fancy))) | 2285 (spam-stat-split-fancy))) |
2251 | 2286 |
2252 (defun spam-stat-register-spam-routine (articles &optional unregister) | 2287 (defun spam-stat-register-spam-routine (articles &optional unregister) |
2253 (dolist (article articles) | 2288 (dolist (article articles) |
2254 (let ((article-string (spam-get-article-as-string article))) | 2289 (let ((article-string (spam-get-article-as-string article))) |
2255 (with-temp-buffer | 2290 (with-temp-buffer |
2256 (insert article-string) | 2291 (insert article-string) |
2257 (if unregister | 2292 (if unregister |
2258 (spam-stat-buffer-change-to-non-spam) | 2293 (spam-stat-buffer-change-to-non-spam) |
2259 (spam-stat-buffer-is-spam)))))) | 2294 (spam-stat-buffer-is-spam)))))) |
2260 | 2295 |
2261 (defun spam-stat-unregister-spam-routine (articles) | 2296 (defun spam-stat-unregister-spam-routine (articles) |
2262 (spam-stat-register-spam-routine articles t)) | 2297 (spam-stat-register-spam-routine articles t)) |
2263 | 2298 |
2264 (defun spam-stat-register-ham-routine (articles &optional unregister) | 2299 (defun spam-stat-register-ham-routine (articles &optional unregister) |
2265 (dolist (article articles) | 2300 (dolist (article articles) |
2266 (let ((article-string (spam-get-article-as-string article))) | 2301 (let ((article-string (spam-get-article-as-string article))) |
2267 (with-temp-buffer | 2302 (with-temp-buffer |
2268 (insert article-string) | 2303 (insert article-string) |
2269 (if unregister | 2304 (if unregister |
2270 (spam-stat-buffer-change-to-spam) | 2305 (spam-stat-buffer-change-to-spam) |
2271 (spam-stat-buffer-is-non-spam)))))) | 2306 (spam-stat-buffer-is-non-spam)))))) |
2272 | 2307 |
2273 (defun spam-stat-unregister-ham-routine (articles) | 2308 (defun spam-stat-unregister-ham-routine (articles) |
2274 (spam-stat-register-ham-routine articles t)) | 2309 (spam-stat-register-ham-routine articles t)) |
2275 | 2310 |
2276 (defun spam-maybe-spam-stat-load () | 2311 (defun spam-maybe-spam-stat-load () |
2319 (unless (file-exists-p (file-name-directory file)) | 2354 (unless (file-exists-p (file-name-directory file)) |
2320 (make-directory (file-name-directory file) t)) | 2355 (make-directory (file-name-directory file) t)) |
2321 (with-current-buffer | 2356 (with-current-buffer |
2322 (find-file-noselect file) | 2357 (find-file-noselect file) |
2323 (dolist (a addresses) | 2358 (dolist (a addresses) |
2324 (when (stringp a) | 2359 (when (stringp a) |
2325 (goto-char (point-min)) | 2360 (goto-char (point-min)) |
2326 (if (re-search-forward (regexp-quote a) nil t) | 2361 (if (re-search-forward (regexp-quote a) nil t) |
2327 ;; found the address | 2362 ;; found the address |
2328 (when remove | 2363 (when remove |
2329 (spam-kill-whole-line)) | 2364 (spam-kill-whole-line)) |
2330 ;; else, the address was not found | 2365 ;; else, the address was not found |
2331 (unless remove | 2366 (unless remove |
2332 (goto-char (point-max)) | 2367 (goto-char (point-max)) |
2333 (unless (bobp) | 2368 (unless (bobp) |
2334 (insert "\n")) | 2369 (insert "\n")) |
2335 (insert a "\n"))))) | 2370 (insert a "\n"))))) |
2336 (save-buffer)))) | 2371 (save-buffer)))) |
2337 | 2372 |
2338 (defun spam-filelist-build-cache (type) | 2373 (defun spam-filelist-build-cache (type) |
2339 (let ((cache (if (eq type 'spam-use-blacklist) | 2374 (let ((cache (if (eq type 'spam-use-blacklist) |
2340 spam-blacklist-cache | 2375 spam-blacklist-cache |
2341 spam-whitelist-cache)) | 2376 spam-whitelist-cache)) |
2342 parsed-cache) | 2377 parsed-cache) |
2343 (unless (gethash type spam-caches) | 2378 (unless (gethash type spam-caches) |
2344 (while cache | 2379 (while cache |
2345 (let ((address (pop cache))) | 2380 (let ((address (pop cache))) |
2346 (unless (zerop (length address)) ; 0 for a nil address too | 2381 (unless (zerop (length address)) ; 0 for a nil address too |
2347 (setq address (regexp-quote address)) | 2382 (setq address (regexp-quote address)) |
2348 ;; fix regexp-quote's treatment of user-intended regexes | 2383 ;; fix regexp-quote's treatment of user-intended regexes |
2349 (while (string-match "\\\\\\*" address) | 2384 (while (string-match "\\\\\\*" address) |
2350 (setq address (replace-match ".*" t t address)))) | 2385 (setq address (replace-match ".*" t t address)))) |
2351 (push address parsed-cache))) | 2386 (push address parsed-cache))) |
2352 (puthash type parsed-cache spam-caches)))) | 2387 (puthash type parsed-cache spam-caches)))) |
2353 | 2388 |
2354 (defun spam-filelist-check-cache (type from) | 2389 (defun spam-filelist-check-cache (type from) |
2355 (when (stringp from) | 2390 (when (stringp from) |
2356 (spam-filelist-build-cache type) | 2391 (spam-filelist-build-cache type) |
2357 (let (found) | 2392 (let (found) |
2358 (dolist (address (gethash type spam-caches)) | 2393 (dolist (address (gethash type spam-caches)) |
2359 (when (and address (string-match address from)) | 2394 (when (and address (string-match address from)) |
2360 (setq found t) | 2395 (setq found t) |
2361 (return))) | 2396 (return))) |
2362 found))) | 2397 found))) |
2363 | 2398 |
2364 ;;; returns t if the sender is in the whitelist, nil or | 2399 ;;; returns t if the sender is in the whitelist, nil or |
2365 ;;; spam-split-group otherwise | 2400 ;;; spam-split-group otherwise |
2366 (defun spam-check-whitelist () | 2401 (defun spam-check-whitelist () |
2368 (unless spam-whitelist-cache | 2403 (unless spam-whitelist-cache |
2369 (setq spam-whitelist-cache (spam-parse-list spam-whitelist))) | 2404 (setq spam-whitelist-cache (spam-parse-list spam-whitelist))) |
2370 (if (spam-from-listed-p 'spam-use-whitelist) | 2405 (if (spam-from-listed-p 'spam-use-whitelist) |
2371 t | 2406 t |
2372 (if spam-use-whitelist-exclusive | 2407 (if spam-use-whitelist-exclusive |
2373 spam-split-group | 2408 spam-split-group |
2374 nil))) | 2409 nil))) |
2375 | 2410 |
2376 (defun spam-check-blacklist () | 2411 (defun spam-check-blacklist () |
2377 ;; FIXME! Should it detect when file timestamps change? | 2412 ;; FIXME! Should it detect when file timestamps change? |
2378 (unless spam-blacklist-cache | 2413 (unless spam-blacklist-cache |
2382 | 2417 |
2383 (defun spam-parse-list (file) | 2418 (defun spam-parse-list (file) |
2384 (when (file-readable-p file) | 2419 (when (file-readable-p file) |
2385 (let (contents address) | 2420 (let (contents address) |
2386 (with-temp-buffer | 2421 (with-temp-buffer |
2387 (insert-file-contents file) | 2422 (insert-file-contents file) |
2388 (while (not (eobp)) | 2423 (while (not (eobp)) |
2389 (setq address (buffer-substring (point) (point-at-eol))) | 2424 (setq address (buffer-substring (point) (point-at-eol))) |
2390 (forward-line 1) | 2425 (forward-line 1) |
2391 ;; insert the e-mail address if detected, otherwise the raw data | 2426 ;; insert the e-mail address if detected, otherwise the raw data |
2392 (unless (zerop (length address)) | 2427 (unless (zerop (length address)) |
2393 (let ((pure-address (nth 1 (gnus-extract-address-components address)))) | 2428 (let ((pure-address |
2394 (push (or pure-address address) contents))))) | 2429 (nth 1 (gnus-extract-address-components address)))) |
2430 (push (or pure-address address) contents))))) | |
2395 (nreverse contents)))) | 2431 (nreverse contents)))) |
2396 | 2432 |
2397 (defun spam-from-listed-p (type) | 2433 (defun spam-from-listed-p (type) |
2398 (let ((from (message-fetch-field "from")) | 2434 (let ((from (message-fetch-field "from")) |
2399 found) | 2435 found) |
2400 (spam-filelist-check-cache type from))) | 2436 (spam-filelist-check-cache type from))) |
2401 | 2437 |
2402 (defun spam-filelist-register-routine (articles blacklist &optional unregister) | 2438 (defun spam-filelist-register-routine (articles blacklist &optional unregister) |
2403 (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist)) | 2439 (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist)) |
2404 (declassification (if blacklist 'ham 'spam)) | 2440 (declassification (if blacklist 'ham 'spam)) |
2405 (enter-function | 2441 (enter-function |
2406 (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist)) | 2442 (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist)) |
2407 (remove-function | 2443 (remove-function |
2408 (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist)) | 2444 (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist)) |
2409 from addresses unregister-list article-unregister-list) | 2445 from addresses unregister-list article-unregister-list) |
2410 (dolist (article articles) | 2446 (dolist (article articles) |
2411 (let ((from (spam-fetch-field-from-fast article)) | 2447 (let ((from (spam-fetch-field-from-fast article)) |
2412 (id (spam-fetch-field-message-id-fast article)) | 2448 (id (spam-fetch-field-message-id-fast article)) |
2413 sender-ignored) | 2449 sender-ignored) |
2414 (when (stringp from) | 2450 (when (stringp from) |
2415 (dolist (ignore-regex spam-blacklist-ignored-regexes) | 2451 (dolist (ignore-regex spam-blacklist-ignored-regexes) |
2416 (when (and (not sender-ignored) | 2452 (when (and (not sender-ignored) |
2417 (stringp ignore-regex) | 2453 (stringp ignore-regex) |
2418 (string-match ignore-regex from)) | 2454 (string-match ignore-regex from)) |
2419 (setq sender-ignored t))) | 2455 (setq sender-ignored t))) |
2420 ;; remember the messages we need to unregister, unless remove is set | 2456 ;; remember the messages we need to unregister, unless remove is set |
2421 (when (and | 2457 (when (and |
2422 (null unregister) | 2458 (null unregister) |
2423 (spam-log-unregistration-needed-p | 2459 (spam-log-unregistration-needed-p |
2424 id 'process declassification de-symbol)) | 2460 id 'process declassification de-symbol)) |
2425 (push article article-unregister-list) | 2461 (push article article-unregister-list) |
2426 (push from unregister-list)) | 2462 (push from unregister-list)) |
2427 (unless sender-ignored | 2463 (unless sender-ignored |
2428 (push from addresses))))) | 2464 (push from addresses))))) |
2429 | 2465 |
2430 (if unregister | 2466 (if unregister |
2431 (funcall enter-function addresses t) ; unregister all these addresses | 2467 (funcall enter-function addresses t) ; unregister all these addresses |
2432 ;; else, register normally and unregister what we need to | 2468 ;; else, register normally and unregister what we need to |
2433 (funcall remove-function unregister-list t) | 2469 (funcall remove-function unregister-list t) |
2434 (dolist (article article-unregister-list) | 2470 (dolist (article article-unregister-list) |
2435 (spam-log-undo-registration | 2471 (spam-log-undo-registration |
2436 (spam-fetch-field-message-id-fast article) | 2472 (spam-fetch-field-message-id-fast article) |
2437 'process | 2473 'process |
2438 declassification | 2474 declassification |
2439 de-symbol)) | 2475 de-symbol)) |
2440 (funcall enter-function addresses nil)))) | 2476 (funcall enter-function addresses nil)))) |
2441 | 2477 |
2442 (defun spam-blacklist-unregister-routine (articles) | 2478 (defun spam-blacklist-unregister-routine (articles) |
2443 (spam-blacklist-register-routine articles t)) | 2479 (spam-blacklist-register-routine articles t)) |
2444 | 2480 |
2465 (defun spam-report-resend-register-ham-routine (articles) | 2501 (defun spam-report-resend-register-ham-routine (articles) |
2466 (spam-report-resend-register-routine articles t)) | 2502 (spam-report-resend-register-routine articles t)) |
2467 | 2503 |
2468 (defun spam-report-resend-register-routine (articles &optional ham) | 2504 (defun spam-report-resend-register-routine (articles &optional ham) |
2469 (let* ((resend-to-gp | 2505 (let* ((resend-to-gp |
2470 (if ham | 2506 (if ham |
2471 (gnus-parameter-ham-resend-to gnus-newsgroup-name) | 2507 (gnus-parameter-ham-resend-to gnus-newsgroup-name) |
2472 (gnus-parameter-spam-resend-to gnus-newsgroup-name))) | 2508 (gnus-parameter-spam-resend-to gnus-newsgroup-name))) |
2473 (spam-report-resend-to (or (car-safe resend-to-gp) | 2509 (spam-report-resend-to (or (car-safe resend-to-gp) |
2474 spam-report-resend-to))) | 2510 spam-report-resend-to))) |
2475 (spam-report-resend articles ham))) | 2511 (spam-report-resend articles ham))) |
2476 | 2512 |
2477 ;;}}} | 2513 ;;}}} |
2478 | 2514 |
2479 ;;{{{ Bogofilter | 2515 ;;{{{ Bogofilter |
2480 (defun spam-check-bogofilter-headers (&optional score) | 2516 (defun spam-check-bogofilter-headers (&optional score) |
2481 (let ((header (message-fetch-field spam-bogofilter-header))) | 2517 (let ((header (message-fetch-field spam-bogofilter-header))) |
2482 (when header ; return nil when no header | 2518 (when header ; return nil when no header |
2483 (if score ; scoring mode | 2519 (if score ; scoring mode |
2484 (if (string-match "spamicity=\\([0-9.]+\\)" header) | 2520 (if (string-match "spamicity=\\([0-9.]+\\)" header) |
2485 (match-string 1 header) | 2521 (match-string 1 header) |
2486 "0") | 2522 "0") |
2487 ;; spam detection mode | 2523 ;; spam detection mode |
2488 (when (string-match spam-bogofilter-bogosity-positive-spam-header | 2524 (when (string-match spam-bogofilter-bogosity-positive-spam-header |
2489 header) | 2525 header) |
2490 spam-split-group))))) | 2526 spam-split-group))))) |
2491 | 2527 |
2492 ;; return something sensible if the score can't be determined | 2528 ;; return something sensible if the score can't be determined |
2493 (defun spam-bogofilter-score (&optional recheck) | 2529 (defun spam-bogofilter-score (&optional recheck) |
2494 "Get the Bogofilter spamicity score." | 2530 "Get the Bogofilter spamicity score." |
2495 (interactive "P") | 2531 (interactive "P") |
2496 (save-window-excursion | 2532 (save-window-excursion |
2497 (gnus-summary-show-article t) | 2533 (gnus-summary-show-article t) |
2498 (set-buffer gnus-article-buffer) | 2534 (set-buffer gnus-article-buffer) |
2499 (let ((score (or (unless recheck | 2535 (let ((score (or (unless recheck |
2500 (spam-check-bogofilter-headers t)) | 2536 (spam-check-bogofilter-headers t)) |
2501 (spam-check-bogofilter t)))) | 2537 (spam-check-bogofilter t)))) |
2502 (gnus-summary-show-article) | 2538 (gnus-summary-show-article) |
2503 (message "Spamicity score %s" score) | 2539 (message "Spamicity score %s" score) |
2504 (or score "0")))) | 2540 (or score "0")))) |
2505 | 2541 |
2506 (defun spam-verify-bogofilter () | 2542 (defun spam-verify-bogofilter () |
2507 "Verify the Bogofilter version is sufficient." | 2543 "Verify the Bogofilter version is sufficient." |
2508 (when (eq spam-bogofilter-valid 'unknown) | 2544 (when (eq spam-bogofilter-valid 'unknown) |
2509 (setq spam-bogofilter-valid | 2545 (setq spam-bogofilter-valid |
2510 (not (string-match "^bogofilter version 0\\.\\([0-9]\\|1[01]\\)\\." | 2546 (not (string-match "^bogofilter version 0\\.\\([0-9]\\|1[01]\\)\\." |
2511 (shell-command-to-string | 2547 (shell-command-to-string |
2512 (format "%s -V" spam-bogofilter-program)))))) | 2548 (format "%s -V" spam-bogofilter-program)))))) |
2513 spam-bogofilter-valid) | 2549 spam-bogofilter-valid) |
2514 | 2550 |
2515 (defun spam-check-bogofilter (&optional score) | 2551 (defun spam-check-bogofilter (&optional score) |
2516 "Check the Bogofilter backend for the classification of this message." | 2552 "Check the Bogofilter backend for the classification of this message." |
2517 (if (spam-verify-bogofilter) | 2553 (if (spam-verify-bogofilter) |
2518 (let ((article-buffer-name (buffer-name)) | 2554 (let ((article-buffer-name (buffer-name)) |
2519 (db spam-bogofilter-database-directory) | 2555 (db spam-bogofilter-database-directory) |
2520 return) | 2556 return) |
2521 (with-temp-buffer | 2557 (with-temp-buffer |
2522 (let ((temp-buffer-name (buffer-name))) | 2558 (let ((temp-buffer-name (buffer-name))) |
2523 (with-current-buffer article-buffer-name | 2559 (with-current-buffer article-buffer-name |
2524 (apply 'call-process-region | 2560 (apply 'call-process-region |
2525 (point-min) (point-max) | 2561 (point-min) (point-max) |
2526 spam-bogofilter-program | 2562 spam-bogofilter-program |
2527 nil temp-buffer-name nil | 2563 nil temp-buffer-name nil |
2528 (if db `("-d" ,db "-v") `("-v")))) | 2564 (if db `("-d" ,db "-v") `("-v")))) |
2529 (setq return (spam-check-bogofilter-headers score)))) | 2565 (setq return (spam-check-bogofilter-headers score)))) |
2530 return) | 2566 return) |
2531 (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions"))) | 2567 (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions"))) |
2532 | 2568 |
2533 (defun spam-bogofilter-register-with-bogofilter (articles | 2569 (defun spam-bogofilter-register-with-bogofilter (articles |
2534 spam | 2570 spam |
2535 &optional unregister) | 2571 &optional unregister) |
2536 "Register an article, given as a string, as spam or non-spam." | 2572 "Register an article, given as a string, as spam or non-spam." |
2537 (if (spam-verify-bogofilter) | 2573 (if (spam-verify-bogofilter) |
2538 (dolist (article articles) | 2574 (dolist (article articles) |
2539 (let ((article-string (spam-get-article-as-string article)) | 2575 (let ((article-string (spam-get-article-as-string article)) |
2540 (db spam-bogofilter-database-directory) | 2576 (db spam-bogofilter-database-directory) |
2541 (switch (if unregister | 2577 (switch (if unregister |
2542 (if spam | 2578 (if spam |
2543 spam-bogofilter-spam-strong-switch | 2579 spam-bogofilter-spam-strong-switch |
2544 spam-bogofilter-ham-strong-switch) | 2580 spam-bogofilter-ham-strong-switch) |
2545 (if spam | 2581 (if spam |
2546 spam-bogofilter-spam-switch | 2582 spam-bogofilter-spam-switch |
2547 spam-bogofilter-ham-switch)))) | 2583 spam-bogofilter-ham-switch)))) |
2548 (when (stringp article-string) | 2584 (when (stringp article-string) |
2549 (with-temp-buffer | 2585 (with-temp-buffer |
2550 (insert article-string) | 2586 (insert article-string) |
2551 | 2587 |
2552 (apply 'call-process-region | 2588 (apply 'call-process-region |
2553 (point-min) (point-max) | 2589 (point-min) (point-max) |
2554 spam-bogofilter-program | 2590 spam-bogofilter-program |
2555 nil nil nil switch | 2591 nil nil nil switch |
2556 (if db `("-d" ,db "-v") `("-v"))))))) | 2592 (if db `("-d" ,db "-v") `("-v"))))))) |
2557 (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions"))) | 2593 (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions"))) |
2558 | 2594 |
2559 (defun spam-bogofilter-register-spam-routine (articles &optional unregister) | 2595 (defun spam-bogofilter-register-spam-routine (articles &optional unregister) |
2560 (spam-bogofilter-register-with-bogofilter articles t unregister)) | 2596 (spam-bogofilter-register-with-bogofilter articles t unregister)) |
2561 | 2597 |
2575 (defun spam-check-spamoracle () | 2611 (defun spam-check-spamoracle () |
2576 "Run spamoracle on an article to determine whether it's spam." | 2612 "Run spamoracle on an article to determine whether it's spam." |
2577 (let ((article-buffer-name (buffer-name))) | 2613 (let ((article-buffer-name (buffer-name))) |
2578 (with-temp-buffer | 2614 (with-temp-buffer |
2579 (let ((temp-buffer-name (buffer-name))) | 2615 (let ((temp-buffer-name (buffer-name))) |
2580 (with-current-buffer article-buffer-name | 2616 (with-current-buffer article-buffer-name |
2581 (let ((status | 2617 (let ((status |
2582 (apply 'call-process-region | 2618 (apply 'call-process-region |
2583 (point-min) (point-max) | 2619 (point-min) (point-max) |
2584 spam-spamoracle-binary | 2620 spam-spamoracle-binary |
2585 nil temp-buffer-name nil | 2621 nil temp-buffer-name nil |
2586 (if spam-spamoracle-database | 2622 (if spam-spamoracle-database |
2587 `("-f" ,spam-spamoracle-database "mark") | 2623 `("-f" ,spam-spamoracle-database "mark") |
2588 '("mark"))))) | 2624 '("mark"))))) |
2589 (if (eq 0 status) | 2625 (if (eq 0 status) |
2590 (progn | 2626 (progn |
2591 (set-buffer temp-buffer-name) | 2627 (set-buffer temp-buffer-name) |
2592 (goto-char (point-min)) | 2628 (goto-char (point-min)) |
2593 (when (re-search-forward "^X-Spam: yes;" nil t) | 2629 (when (re-search-forward "^X-Spam: yes;" nil t) |
2594 spam-split-group)) | 2630 spam-split-group)) |
2595 (error "Error running spamoracle: %s" status)))))))) | 2631 (error "Error running spamoracle: %s" status)))))))) |
2596 | 2632 |
2597 (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister) | 2633 (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister) |
2598 "Run spamoracle in training mode." | 2634 "Run spamoracle in training mode." |
2599 (with-temp-buffer | 2635 (with-temp-buffer |
2600 (let ((temp-buffer-name (buffer-name))) | 2636 (let ((temp-buffer-name (buffer-name))) |
2601 (save-excursion | 2637 (save-excursion |
2602 (goto-char (point-min)) | 2638 (goto-char (point-min)) |
2603 (dolist (article articles) | 2639 (dolist (article articles) |
2604 (insert (spam-get-article-as-string article))) | 2640 (insert (spam-get-article-as-string article))) |
2605 (let* ((arg (if (spam-xor unregister article-is-spam-p) | 2641 (let* ((arg (if (spam-xor unregister article-is-spam-p) |
2606 "-spam" | 2642 "-spam" |
2607 "-good")) | 2643 "-good")) |
2608 (status | 2644 (status |
2609 (apply 'call-process-region | 2645 (apply 'call-process-region |
2610 (point-min) (point-max) | 2646 (point-min) (point-max) |
2611 spam-spamoracle-binary | 2647 spam-spamoracle-binary |
2612 nil temp-buffer-name nil | 2648 nil temp-buffer-name nil |
2613 (if spam-spamoracle-database | 2649 (if spam-spamoracle-database |
2614 `("-f" ,spam-spamoracle-database | 2650 `("-f" ,spam-spamoracle-database |
2615 "add" ,arg) | 2651 "add" ,arg) |
2616 `("add" ,arg))))) | 2652 `("add" ,arg))))) |
2617 (unless (eq 0 status) | 2653 (unless (eq 0 status) |
2618 (error "Error running spamoracle: %s" status))))))) | 2654 (error "Error running spamoracle: %s" status))))))) |
2619 | 2655 |
2620 (defun spam-spamoracle-learn-ham (articles &optional unregister) | 2656 (defun spam-spamoracle-learn-ham (articles &optional unregister) |
2621 (spam-spamoracle-learn articles nil unregister)) | 2657 (spam-spamoracle-learn articles nil unregister)) |
2622 | 2658 |
2623 (defun spam-spamoracle-unlearn-ham (articles &optional unregister) | 2659 (defun spam-spamoracle-unlearn-ham (articles &optional unregister) |
2633 | 2669 |
2634 ;;{{{ SpamAssassin | 2670 ;;{{{ SpamAssassin |
2635 ;;; based mostly on the bogofilter code | 2671 ;;; based mostly on the bogofilter code |
2636 (defun spam-check-spamassassin-headers (&optional score) | 2672 (defun spam-check-spamassassin-headers (&optional score) |
2637 "Check the SpamAssassin headers for the classification of this message." | 2673 "Check the SpamAssassin headers for the classification of this message." |
2638 (if score ; scoring mode | 2674 (if score ; scoring mode |
2639 (let ((header (message-fetch-field spam-spamassassin-spam-status-header))) | 2675 (let ((header (message-fetch-field spam-spamassassin-spam-status-header))) |
2640 (when header | 2676 (when header |
2641 (if (string-match spam-spamassassin-score-regexp header) | 2677 (if (string-match spam-spamassassin-score-regexp header) |
2642 (match-string 1 header) | 2678 (match-string 1 header) |
2643 "0"))) | 2679 "0"))) |
2644 ;; spam detection mode | 2680 ;; spam detection mode |
2645 (let ((header (message-fetch-field spam-spamassassin-spam-flag-header))) | 2681 (let ((header (message-fetch-field spam-spamassassin-spam-flag-header))) |
2646 (when header ; return nil when no header | 2682 (when header ; return nil when no header |
2647 (when (string-match spam-spamassassin-positive-spam-flag-header | 2683 (when (string-match spam-spamassassin-positive-spam-flag-header |
2648 header) | 2684 header) |
2649 spam-split-group))))) | 2685 spam-split-group))))) |
2650 | 2686 |
2651 (defun spam-check-spamassassin (&optional score) | 2687 (defun spam-check-spamassassin (&optional score) |
2652 "Check the SpamAssassin backend for the classification of this message." | 2688 "Check the SpamAssassin backend for the classification of this message." |
2653 (let ((article-buffer-name (buffer-name))) | 2689 (let ((article-buffer-name (buffer-name))) |
2654 (with-temp-buffer | 2690 (with-temp-buffer |
2655 (let ((temp-buffer-name (buffer-name))) | 2691 (let ((temp-buffer-name (buffer-name))) |
2656 (with-current-buffer article-buffer-name | 2692 (with-current-buffer article-buffer-name |
2657 (apply 'call-process-region | 2693 (apply 'call-process-region |
2658 (point-min) (point-max) spam-assassin-program | 2694 (point-min) (point-max) spam-assassin-program |
2659 nil temp-buffer-name nil spam-spamassassin-arguments)) | 2695 nil temp-buffer-name nil spam-spamassassin-arguments)) |
2660 ;; check the return now (we're back in the temp buffer) | 2696 ;; check the return now (we're back in the temp buffer) |
2661 (goto-char (point-min)) | 2697 (goto-char (point-min)) |
2662 (spam-check-spamassassin-headers score))))) | 2698 (spam-check-spamassassin-headers score))))) |
2663 | 2699 |
2664 ;; return something sensible if the score can't be determined | 2700 ;; return something sensible if the score can't be determined |
2665 (defun spam-spamassassin-score (&optional recheck) | 2701 (defun spam-spamassassin-score (&optional recheck) |
2666 "Get the SpamAssassin score" | 2702 "Get the SpamAssassin score" |
2667 (interactive "P") | 2703 (interactive "P") |
2668 (save-window-excursion | 2704 (save-window-excursion |
2669 (gnus-summary-show-article t) | 2705 (gnus-summary-show-article t) |
2670 (set-buffer gnus-article-buffer) | 2706 (set-buffer gnus-article-buffer) |
2671 (let ((score (or (unless recheck | 2707 (let ((score (or (unless recheck |
2672 (spam-check-spamassassin-headers t)) | 2708 (spam-check-spamassassin-headers t)) |
2673 (spam-check-spamassassin t)))) | 2709 (spam-check-spamassassin t)))) |
2674 (gnus-summary-show-article) | 2710 (gnus-summary-show-article) |
2675 (message "SpamAssassin score %s" score) | 2711 (message "SpamAssassin score %s" score) |
2676 (or score "0")))) | 2712 (or score "0")))) |
2677 | 2713 |
2678 (defun spam-spamassassin-register-with-sa-learn (articles spam | 2714 (defun spam-spamassassin-register-with-sa-learn (articles spam |
2679 &optional unregister) | 2715 &optional unregister) |
2680 "Register articles with spamassassin's sa-learn as spam or non-spam." | 2716 "Register articles with spamassassin's sa-learn as spam or non-spam." |
2681 (if articles | 2717 (if articles |
2682 (let ((action (if unregister spam-sa-learn-unregister-switch | 2718 (let ((action (if unregister spam-sa-learn-unregister-switch |
2683 (if spam spam-sa-learn-spam-switch | 2719 (if spam spam-sa-learn-spam-switch |
2684 spam-sa-learn-ham-switch))) | 2720 spam-sa-learn-ham-switch))) |
2685 (summary-buffer-name (buffer-name))) | 2721 (summary-buffer-name (buffer-name))) |
2686 (with-temp-buffer | 2722 (with-temp-buffer |
2687 ;; group the articles into mbox format | 2723 ;; group the articles into mbox format |
2688 (dolist (article articles) | 2724 (dolist (article articles) |
2689 (let (article-string) | 2725 (let (article-string) |
2690 (with-current-buffer summary-buffer-name | 2726 (with-current-buffer summary-buffer-name |
2691 (setq article-string (spam-get-article-as-string article))) | 2727 (setq article-string (spam-get-article-as-string article))) |
2692 (when (stringp article-string) | 2728 (when (stringp article-string) |
2693 (insert "From \n") ; mbox separator (sa-learn only checks the | 2729 (insert "From \n") ; mbox separator (sa-learn only checks the |
2694 ; first five chars, so we can get away with | 2730 ; first five chars, so we can get away with |
2695 ; a bogus line)) | 2731 ; a bogus line)) |
2696 (insert article-string) | 2732 (insert article-string) |
2697 (insert "\n")))) | 2733 (insert "\n")))) |
2698 ;; call sa-learn on all messages at the same time | 2734 ;; call sa-learn on all messages at the same time |
2699 (apply 'call-process-region | 2735 (apply 'call-process-region |
2700 (point-min) (point-max) | 2736 (point-min) (point-max) |
2701 spam-sa-learn-program | 2737 spam-sa-learn-program |
2702 nil nil nil "--mbox" | 2738 nil nil nil "--mbox" |
2703 (if spam-sa-learn-rebuild | 2739 (if spam-sa-learn-rebuild |
2704 (list action) | 2740 (list action) |
2705 `("--no-rebuild" ,action))))))) | 2741 `("--no-rebuild" ,action))))))) |
2706 | 2742 |
2707 (defun spam-spamassassin-register-spam-routine (articles &optional unregister) | 2743 (defun spam-spamassassin-register-spam-routine (articles &optional unregister) |
2708 (spam-spamassassin-register-with-sa-learn articles t unregister)) | 2744 (spam-spamassassin-register-with-sa-learn articles t unregister)) |
2709 | 2745 |
2710 (defun spam-spamassassin-register-ham-routine (articles &optional unregister) | 2746 (defun spam-spamassassin-register-ham-routine (articles &optional unregister) |
2721 ;;{{{ Bsfilter | 2757 ;;{{{ Bsfilter |
2722 ;;; based mostly on the bogofilter code | 2758 ;;; based mostly on the bogofilter code |
2723 (defun spam-check-bsfilter-headers (&optional score) | 2759 (defun spam-check-bsfilter-headers (&optional score) |
2724 (if score | 2760 (if score |
2725 (or (nnmail-fetch-field spam-bsfilter-probability-header) | 2761 (or (nnmail-fetch-field spam-bsfilter-probability-header) |
2726 "0") | 2762 "0") |
2727 (let ((header (nnmail-fetch-field spam-bsfilter-header))) | 2763 (let ((header (nnmail-fetch-field spam-bsfilter-header))) |
2728 (when header ; return nil when no header | 2764 (when header ; return nil when no header |
2729 (when (string-match "YES" header) | 2765 (when (string-match "YES" header) |
2730 spam-split-group))))) | 2766 spam-split-group))))) |
2731 | 2767 |
2732 ;; return something sensible if the score can't be determined | 2768 ;; return something sensible if the score can't be determined |
2733 (defun spam-bsfilter-score (&optional recheck) | 2769 (defun spam-bsfilter-score (&optional recheck) |
2734 "Get the Bsfilter spamicity score." | 2770 "Get the Bsfilter spamicity score." |
2735 (interactive "P") | 2771 (interactive "P") |
2736 (save-window-excursion | 2772 (save-window-excursion |
2737 (gnus-summary-show-article t) | 2773 (gnus-summary-show-article t) |
2738 (set-buffer gnus-article-buffer) | 2774 (set-buffer gnus-article-buffer) |
2739 (let ((score (or (unless recheck | 2775 (let ((score (or (unless recheck |
2740 (spam-check-bsfilter-headers t)) | 2776 (spam-check-bsfilter-headers t)) |
2741 (spam-check-bsfilter t)))) | 2777 (spam-check-bsfilter t)))) |
2742 (gnus-summary-show-article) | 2778 (gnus-summary-show-article) |
2743 (message "Spamicity score %s" score) | 2779 (message "Spamicity score %s" score) |
2744 (or score "0")))) | 2780 (or score "0")))) |
2745 | 2781 |
2746 (defun spam-check-bsfilter (&optional score) | 2782 (defun spam-check-bsfilter (&optional score) |
2747 "Check the Bsfilter backend for the classification of this message." | 2783 "Check the Bsfilter backend for the classification of this message." |
2748 (let ((article-buffer-name (buffer-name)) | 2784 (let ((article-buffer-name (buffer-name)) |
2749 (dir spam-bsfilter-database-directory) | 2785 (dir spam-bsfilter-database-directory) |
2750 return) | 2786 return) |
2751 (with-temp-buffer | 2787 (with-temp-buffer |
2752 (let ((temp-buffer-name (buffer-name))) | 2788 (let ((temp-buffer-name (buffer-name))) |
2753 (with-current-buffer article-buffer-name | 2789 (with-current-buffer article-buffer-name |
2754 (apply 'call-process-region | 2790 (apply 'call-process-region |
2755 (point-min) (point-max) | 2791 (point-min) (point-max) |
2756 spam-bsfilter-program | 2792 spam-bsfilter-program |
2757 nil temp-buffer-name nil | 2793 nil temp-buffer-name nil |
2758 "--pipe" | 2794 "--pipe" |
2759 "--insert-flag" | 2795 "--insert-flag" |
2760 "--insert-probability" | 2796 "--insert-probability" |
2761 (when dir | 2797 (when dir |
2762 (list "--homedir" dir)))) | 2798 (list "--homedir" dir)))) |
2763 (setq return (spam-check-bsfilter-headers score)))) | 2799 (setq return (spam-check-bsfilter-headers score)))) |
2764 return)) | 2800 return)) |
2765 | 2801 |
2766 (defun spam-bsfilter-register-with-bsfilter (articles | 2802 (defun spam-bsfilter-register-with-bsfilter (articles |
2767 spam | 2803 spam |
2768 &optional unregister) | 2804 &optional unregister) |
2769 "Register an article, given as a string, as spam or non-spam." | 2805 "Register an article, given as a string, as spam or non-spam." |
2770 (dolist (article articles) | 2806 (dolist (article articles) |
2771 (let ((article-string (spam-get-article-as-string article)) | 2807 (let ((article-string (spam-get-article-as-string article)) |
2772 (switch (if unregister | 2808 (switch (if unregister |
2773 (if spam | 2809 (if spam |
2774 spam-bsfilter-spam-strong-switch | 2810 spam-bsfilter-spam-strong-switch |
2775 spam-bsfilter-ham-strong-switch) | 2811 spam-bsfilter-ham-strong-switch) |
2776 (if spam | 2812 (if spam |
2777 spam-bsfilter-spam-switch | 2813 spam-bsfilter-spam-switch |
2778 spam-bsfilter-ham-switch)))) | 2814 spam-bsfilter-ham-switch)))) |
2779 (when (stringp article-string) | 2815 (when (stringp article-string) |
2780 (with-temp-buffer | 2816 (with-temp-buffer |
2781 (insert article-string) | 2817 (insert article-string) |
2782 (apply 'call-process-region | 2818 (apply 'call-process-region |
2783 (point-min) (point-max) | 2819 (point-min) (point-max) |
2784 spam-bsfilter-program | 2820 spam-bsfilter-program |
2785 nil nil nil switch | 2821 nil nil nil switch |
2786 "--update" | 2822 "--update" |
2787 (when spam-bsfilter-database-directory | 2823 (when spam-bsfilter-database-directory |
2788 (list "--homedir" | 2824 (list "--homedir" |
2789 spam-bsfilter-database-directory)))))))) | 2825 spam-bsfilter-database-directory)))))))) |
2790 | 2826 |
2791 (defun spam-bsfilter-register-spam-routine (articles &optional unregister) | 2827 (defun spam-bsfilter-register-spam-routine (articles &optional unregister) |
2792 (spam-bsfilter-register-with-bsfilter articles t unregister)) | 2828 (spam-bsfilter-register-with-bsfilter articles t unregister)) |
2793 | 2829 |
2794 (defun spam-bsfilter-unregister-spam-routine (articles) | 2830 (defun spam-bsfilter-unregister-spam-routine (articles) |
2803 ;;}}} | 2839 ;;}}} |
2804 | 2840 |
2805 ;;{{{ CRM114 Mailfilter | 2841 ;;{{{ CRM114 Mailfilter |
2806 (defun spam-check-crm114-headers (&optional score) | 2842 (defun spam-check-crm114-headers (&optional score) |
2807 (let ((header (message-fetch-field spam-crm114-header))) | 2843 (let ((header (message-fetch-field spam-crm114-header))) |
2808 (when header ; return nil when no header | 2844 (when header ; return nil when no header |
2809 (if score ; scoring mode | 2845 (if score ; scoring mode |
2810 (if (string-match "( pR: \\([0-9.-]+\\)" header) | 2846 (if (string-match "( pR: \\([0-9.-]+\\)" header) |
2811 (match-string 1 header) | 2847 (match-string 1 header) |
2812 "0") | 2848 "0") |
2813 ;; spam detection mode | 2849 ;; spam detection mode |
2814 (when (string-match spam-crm114-positive-spam-header | 2850 (when (string-match spam-crm114-positive-spam-header |
2815 header) | 2851 header) |
2816 spam-split-group))))) | 2852 spam-split-group))))) |
2817 | 2853 |
2818 ;; return something sensible if the score can't be determined | 2854 ;; return something sensible if the score can't be determined |
2819 (defun spam-crm114-score () | 2855 (defun spam-crm114-score () |
2820 "Get the CRM114 Mailfilter pR." | 2856 "Get the CRM114 Mailfilter pR." |
2821 (interactive) | 2857 (interactive) |
2822 (save-window-excursion | 2858 (save-window-excursion |
2823 (gnus-summary-show-article t) | 2859 (gnus-summary-show-article t) |
2824 (set-buffer gnus-article-buffer) | 2860 (set-buffer gnus-article-buffer) |
2825 (let ((score (or (spam-check-crm114-headers t) | 2861 (let ((score (or (spam-check-crm114-headers t) |
2826 (spam-check-crm114 t)))) | 2862 (spam-check-crm114 t)))) |
2827 (gnus-summary-show-article) | 2863 (gnus-summary-show-article) |
2828 (message "pR: %s" score) | 2864 (message "pR: %s" score) |
2829 (or score "0")))) | 2865 (or score "0")))) |
2830 | 2866 |
2831 (defun spam-check-crm114 (&optional score) | 2867 (defun spam-check-crm114 (&optional score) |
2832 "Check the CRM114 Mailfilter backend for the classification of this message." | 2868 "Check the CRM114 Mailfilter backend for the classification of this message." |
2833 (let ((article-buffer-name (buffer-name)) | 2869 (let ((article-buffer-name (buffer-name)) |
2834 (db spam-crm114-database-directory) | 2870 (db spam-crm114-database-directory) |
2835 return) | 2871 return) |
2836 (with-temp-buffer | 2872 (with-temp-buffer |
2837 (let ((temp-buffer-name (buffer-name))) | 2873 (let ((temp-buffer-name (buffer-name))) |
2838 (with-current-buffer article-buffer-name | 2874 (with-current-buffer article-buffer-name |
2839 (apply 'call-process-region | 2875 (apply 'call-process-region |
2840 (point-min) (point-max) | 2876 (point-min) (point-max) |
2841 spam-crm114-program | 2877 spam-crm114-program |
2842 nil temp-buffer-name nil | 2878 nil temp-buffer-name nil |
2843 (when db (list (concat "--fileprefix=" db))))) | 2879 (when db (list (concat "--fileprefix=" db))))) |
2844 (setq return (spam-check-crm114-headers score)))) | 2880 (setq return (spam-check-crm114-headers score)))) |
2845 return)) | 2881 return)) |
2846 | 2882 |
2847 (defun spam-crm114-register-with-crm114 (articles | 2883 (defun spam-crm114-register-with-crm114 (articles |
2848 spam | 2884 spam |
2849 &optional unregister) | 2885 &optional unregister) |
2850 "Register an article, given as a string, as spam or non-spam." | 2886 "Register an article, given as a string, as spam or non-spam." |
2851 (dolist (article articles) | 2887 (dolist (article articles) |
2852 (let ((article-string (spam-get-article-as-string article)) | 2888 (let ((article-string (spam-get-article-as-string article)) |
2853 (db spam-crm114-database-directory) | 2889 (db spam-crm114-database-directory) |
2854 (switch (if unregister | 2890 (switch (if unregister |
2855 (if spam | 2891 (if spam |
2856 spam-crm114-spam-strong-switch | 2892 spam-crm114-spam-strong-switch |
2857 spam-crm114-ham-strong-switch) | 2893 spam-crm114-ham-strong-switch) |
2858 (if spam | 2894 (if spam |
2859 spam-crm114-spam-switch | 2895 spam-crm114-spam-switch |
2860 spam-crm114-ham-switch)))) | 2896 spam-crm114-ham-switch)))) |
2861 (when (stringp article-string) | 2897 (when (stringp article-string) |
2862 (with-temp-buffer | 2898 (with-temp-buffer |
2863 (insert article-string) | 2899 (insert article-string) |
2864 | 2900 |
2865 (apply 'call-process-region | 2901 (apply 'call-process-region |
2866 (point-min) (point-max) | 2902 (point-min) (point-max) |
2867 spam-crm114-program | 2903 spam-crm114-program |
2868 nil nil nil | 2904 nil nil nil |
2869 (when db (list switch (concat "--fileprefix=" db))))))))) | 2905 (when db (list switch (concat "--fileprefix=" db))))))))) |
2870 | 2906 |
2871 (defun spam-crm114-register-spam-routine (articles &optional unregister) | 2907 (defun spam-crm114-register-spam-routine (articles &optional unregister) |
2872 (spam-crm114-register-with-crm114 articles t unregister)) | 2908 (spam-crm114-register-with-crm114 articles t unregister)) |
2873 | 2909 |
2903 (add-to-list 'gnus-extra-headers header)) | 2939 (add-to-list 'gnus-extra-headers header)) |
2904 | 2940 |
2905 (setq spam-install-hooks t) | 2941 (setq spam-install-hooks t) |
2906 ;; TODO: How do we redo this every time the `spam' face is customized? | 2942 ;; TODO: How do we redo this every time the `spam' face is customized? |
2907 (push '((eq mark gnus-spam-mark) . spam) | 2943 (push '((eq mark gnus-spam-mark) . spam) |
2908 gnus-summary-highlight) | 2944 gnus-summary-highlight) |
2909 ;; Add hooks for loading and saving the spam stats | 2945 ;; Add hooks for loading and saving the spam stats |
2910 (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) | 2946 (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) |
2911 (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) | 2947 (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) |
2912 (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load) | 2948 (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load) |
2913 (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) | 2949 (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) |