1;;; spam.el --- Identifying spam 2 3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 4 5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 6;; Keywords: network 7 8;; This file is part of GNU Emacs. 9 10;; GNU Emacs is free software; you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation; either version 2, or (at your option) 13;; any later version. 14 15;; GNU Emacs is distributed in the hope that it will be useful, 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; GNU General Public License for more details. 19 20;; You should have received a copy of the GNU General Public License 21;; along with GNU Emacs; see the file COPYING. If not, write to the 22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; Boston, MA 02110-1301, USA. 24 25;;; Commentary: 26 27;;; This module addresses a few aspects of spam control under Gnus. Page 28;;; breaks are used for grouping declarations and documentation relating to 29;;; each particular aspect. 30 31;;; The integration with Gnus is not yet complete. See various `FIXME' 32;;; comments, below, for supplementary explanations or discussions. 33 34;;; Several TODO items are marked as such 35 36;; TODO: spam scores, detection of spam in newsgroups, cross-server splitting, 37;; remote processing, training through files 38 39;;; Code: 40 41(eval-when-compile (require 'cl)) 42 43(require 'gnus-sum) 44 45(require 'gnus-uu) ; because of key prefix issues 46;;; for the definitions of group content classification and spam processors 47(require 'gnus) 48(require 'message) ;for the message-fetch-field functions 49 50;; for nnimap-split-download-body-default 51(eval-when-compile (require 'nnimap)) 52 53;; autoload executable-find 54(eval-and-compile 55 ;; executable-find is not autoloaded in Emacs 20 56 (autoload 'executable-find "executable")) 57 58;; autoload query-dig 59(eval-and-compile 60 (autoload 'query-dig "dig")) 61 62;; autoload spam-report 63(eval-and-compile 64 (autoload 'spam-report-gmane "spam-report")) 65 66;; autoload gnus-registry 67(eval-and-compile 68 (autoload 'gnus-registry-group-count "gnus-registry") 69 (autoload 'gnus-registry-add-group "gnus-registry") 70 (autoload 'gnus-registry-store-extra-entry "gnus-registry") 71 (autoload 'gnus-registry-fetch-extra "gnus-registry")) 72 73;; autoload query-dns 74(eval-and-compile 75 (autoload 'query-dns "dns")) 76 77;;; Main parameters. 78 79(defgroup spam nil 80 "Spam configuration." 81 :version "22.1" 82 :group 'mail 83 :group 'news) 84 85(defcustom spam-directory (nnheader-concat gnus-directory "spam/") 86 "Directory for spam whitelists and blacklists." 87 :type 'directory 88 :group 'spam) 89 90(defcustom spam-move-spam-nonspam-groups-only t 91 "Whether spam should be moved in non-spam groups only. 92When t, only ham and unclassified groups will have their spam moved 93to the spam-process-destination. When nil, spam will also be moved from 94spam groups." 95 :type 'boolean 96 :group 'spam) 97 98(defcustom spam-process-ham-in-nonham-groups nil 99 "Whether ham should be processed in non-ham groups." 100 :type 'boolean 101 :group 'spam) 102 103(defcustom spam-mark-new-messages-in-spam-group-as-spam t 104 "Whether new messages in a spam group should get the spam-mark." 105 :type 'boolean 106 ;; :version "22.1" ;; Gnus 5.10.8 / No Gnus 0.3 107 :group 'spam) 108 109(defcustom spam-log-to-registry nil 110 "Whether spam/ham processing should be logged in the registry." 111 :type 'boolean 112 :group 'spam) 113 114(defcustom spam-split-symbolic-return nil 115 "Whether `spam-split' should work with symbols or group names." 116 :type 'boolean 117 :group 'spam) 118 119(defcustom spam-split-symbolic-return-positive nil 120 "Whether `spam-split' should ALWAYS work with symbols or group names. 121Do not set this if you use `spam-split' in a fancy split 122 method." 123 :type 'boolean 124 :group 'spam) 125 126(defcustom spam-process-ham-in-spam-groups nil 127 "Whether ham should be processed in spam groups." 128 :type 'boolean 129 :group 'spam) 130 131(defcustom spam-mark-only-unseen-as-spam t 132 "Whether only unseen articles should be marked as spam in spam groups. 133When nil, all unread articles in a spam group are marked as 134spam. Set this if you want to leave an article unread in a spam group 135without losing it to the automatic spam-marking process." 136 :type 'boolean 137 :group 'spam) 138 139(defcustom spam-mark-ham-unread-before-move-from-spam-group nil 140 "Whether ham should be marked unread before it's moved. 141The article is moved out of a spam group according to ham-process-destination. 142This variable is an official entry in the international Longest Variable Name 143Competition." 144 :type 'boolean 145 :group 'spam) 146 147(defcustom spam-disable-spam-split-during-ham-respool nil 148 "Whether `spam-split' should be ignored while resplitting ham in a process 149destination. This is useful to prevent ham from ending up in the same spam 150group after the resplit. Don't set this to t if you have spam-split as the 151last rule in your split configuration." 152 :type 'boolean 153 :group 'spam) 154 155(defcustom spam-autodetect-recheck-messages nil 156 "Should spam.el recheck all meessages when autodetecting? 157Normally this is nil, so only unseen messages will be checked." 158 :type 'boolean 159 :group 'spam) 160 161(defcustom spam-whitelist (expand-file-name "whitelist" spam-directory) 162 "The location of the whitelist. 163The file format is one regular expression per line. 164The regular expression is matched against the address." 165 :type 'file 166 :group 'spam) 167 168(defcustom spam-blacklist (expand-file-name "blacklist" spam-directory) 169 "The location of the blacklist. 170The file format is one regular expression per line. 171The regular expression is matched against the address." 172 :type 'file 173 :group 'spam) 174 175(defcustom spam-use-dig t 176 "Whether `query-dig' should be used instead of `query-dns'." 177 :type 'boolean 178 :group 'spam) 179 180(defcustom spam-use-blacklist nil 181 "Whether the blacklist should be used by `spam-split'." 182 :type 'boolean 183 :group 'spam) 184 185(defcustom spam-blacklist-ignored-regexes nil 186 "Regular expressions that the blacklist should ignore." 187 :type '(repeat (regexp :tag "Regular expression to ignore when blacklisting")) 188 :group 'spam) 189 190(defcustom spam-use-whitelist nil 191 "Whether the whitelist should be used by `spam-split'." 192 :type 'boolean 193 :group 'spam) 194 195(defcustom spam-use-whitelist-exclusive nil 196 "Whether whitelist-exclusive should be used by `spam-split'. 197Exclusive whitelisting means that all messages from senders not in the whitelist 198are considered spam." 199 :type 'boolean 200 :group 'spam) 201 202(defcustom spam-use-blackholes nil 203 "Whether blackholes should be used by `spam-split'." 204 :type 'boolean 205 :group 'spam) 206 207(defcustom spam-use-hashcash nil 208 "Whether hashcash payments should be detected by `spam-split'." 209 :type 'boolean 210 :group 'spam) 211 212(defcustom spam-use-regex-headers nil 213 "Whether a header regular expression match should be used by `spam-split'. 214Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'." 215 :type 'boolean 216 :group 'spam) 217 218(defcustom spam-use-regex-body nil 219 "Whether a body regular expression match should be used by `spam-split'. 220Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'." 221 :type 'boolean 222 :group 'spam) 223 224(defcustom spam-use-bogofilter-headers nil 225 "Whether bogofilter headers should be used by `spam-split'. 226Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them." 227 :type 'boolean 228 :group 'spam) 229 230(defcustom spam-use-bogofilter nil 231 "Whether bogofilter should be invoked by `spam-split'. 232Enable this if you want Gnus to invoke Bogofilter on new messages." 233 :type 'boolean 234 :group 'spam) 235 236(defcustom spam-use-BBDB nil 237 "Whether BBDB should be used by `spam-split'." 238 :type 'boolean 239 :group 'spam) 240 241(defcustom spam-use-BBDB-exclusive nil 242 "Whether BBDB-exclusive should be used by `spam-split'. 243Exclusive BBDB means that all messages from senders not in the BBDB are 244considered spam." 245 :type 'boolean 246 :group 'spam) 247 248(defcustom spam-use-ifile nil 249 "Whether ifile should be used by `spam-split'." 250 :type 'boolean 251 :group 'spam) 252 253(defcustom spam-use-stat nil 254 "Whether `spam-stat' should be used by `spam-split'." 255 :type 'boolean 256 :group 'spam) 257 258(defcustom spam-use-spamoracle nil 259 "Whether spamoracle should be used by `spam-split'." 260 :type 'boolean 261 :group 'spam) 262 263(defcustom spam-install-hooks (or 264 spam-use-dig 265 spam-use-blacklist 266 spam-use-whitelist 267 spam-use-whitelist-exclusive 268 spam-use-blackholes 269 spam-use-hashcash 270 spam-use-regex-headers 271 spam-use-regex-body 272 spam-use-bogofilter-headers 273 spam-use-bogofilter 274 spam-use-BBDB 275 spam-use-BBDB-exclusive 276 spam-use-ifile 277 spam-use-stat 278 spam-use-spamoracle) 279 "Whether the spam hooks should be installed. 280Default to t if one of the spam-use-* variables is set." 281 :group 'spam 282 :type 'boolean) 283 284(defcustom spam-split-group "spam" 285 "Group name where incoming spam should be put by `spam-split'." 286 :type 'string 287 :group 'spam) 288 289;;; TODO: deprecate this variable, it's confusing since it's a list of strings, 290;;; not regular expressions 291(defcustom spam-junk-mailgroups (cons 292 spam-split-group 293 '("mail.junk" "poste.pourriel")) 294 "Mailgroups with spam contents. 295All unmarked article in such group receive the spam mark on group entry." 296 :type '(repeat (string :tag "Group")) 297 :group 'spam) 298 299(defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org" 300 "dev.null.dk" "relays.visi.com") 301 "List of blackhole servers." 302 :type '(repeat (string :tag "Server")) 303 :group 'spam) 304 305(defcustom spam-blackhole-good-server-regex nil 306 "String matching IP addresses that should not be checked in the blackholes." 307 :type '(radio (const nil) regexp) 308 :group 'spam) 309 310(defface spam 311 '((((class color) (type tty) (background dark)) 312 (:foreground "gray80" :background "gray50")) 313 (((class color) (type tty) (background light)) 314 (:foreground "gray50" :background "gray80")) 315 (((class color) (background dark)) 316 (:foreground "ivory2")) 317 (((class color) (background light)) 318 (:foreground "ivory4")) 319 (t :inverse-video t)) 320 "Face for spam-marked articles." 321 :group 'spam) 322;; backward-compatibility alias 323(put 'spam-face 'face-alias 'spam) 324 325(defcustom spam-face 'spam 326 "Face for spam-marked articles." 327 :type 'face 328 :group 'spam) 329 330(defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES") 331 "Regular expression for positive header spam matches." 332 :type '(repeat (regexp :tag "Regular expression to match spam header")) 333 :group 'spam) 334 335(defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO") 336 "Regular expression for positive header ham matches." 337 :type '(repeat (regexp :tag "Regular expression to match ham header")) 338 :group 'spam) 339 340(defcustom spam-regex-body-spam '() 341 "Regular expression for positive body spam matches." 342 :type '(repeat (regexp :tag "Regular expression to match spam body")) 343 :group 'spam) 344 345(defcustom spam-regex-body-ham '() 346 "Regular expression for positive body ham matches." 347 :type '(repeat (regexp :tag "Regular expression to match ham body")) 348 :group 'spam) 349 350(defgroup spam-ifile nil 351 "Spam ifile configuration." 352 :group 'spam) 353 354(make-obsolete-variable 'spam-ifile-path 'spam-ifile-program) 355;; "22.1" ;; Gnus 5.10.9 356(defcustom spam-ifile-program (executable-find "ifile") 357 "Name of the ifile program." 358 :type '(choice (file :tag "Location of ifile") 359 (const :tag "ifile is not installed")) 360 :group 'spam-ifile) 361 362(make-obsolete-variable 'spam-ifile-database-path 'spam-ifile-database) 363;; "22.1" ;; Gnus 5.10.9 364(defcustom spam-ifile-database nil 365 "File name of the ifile database." 366 :type '(choice (file :tag "Location of the ifile database") 367 (const :tag "Use the default")) 368 :group 'spam-ifile) 369 370(defcustom spam-ifile-spam-category "spam" 371 "Name of the spam ifile category." 372 :type 'string 373 :group 'spam-ifile) 374 375(defcustom spam-ifile-ham-category nil 376 "Name of the ham ifile category. 377If nil, the current group name will be used." 378 :type '(choice (string :tag "Use a fixed category") 379 (const :tag "Use the current group name")) 380 :group 'spam-ifile) 381 382(defcustom spam-ifile-all-categories nil 383 "Whether the ifile check will return all categories, or just spam. 384Set this to t if you want to use the `spam-split' invocation of ifile as 385your main source of newsgroup names." 386 :type 'boolean 387 :group 'spam-ifile) 388 389(defgroup spam-bogofilter nil 390 "Spam bogofilter configuration." 391 :group 'spam) 392 393(make-obsolete-variable 'spam-bogofilter-path 'spam-bogofilter-program) 394;; "22.1" ;; Gnus 5.10.9 395(defcustom spam-bogofilter-program (executable-find "bogofilter") 396 "Name of the Bogofilter program." 397 :type '(choice (file :tag "Location of bogofilter") 398 (const :tag "Bogofilter is not installed")) 399 :group 'spam-bogofilter) 400 401(defcustom spam-bogofilter-header "X-Bogosity" 402 "The header that Bogofilter inserts in messages." 403 :type 'string 404 :group 'spam-bogofilter) 405 406(defcustom spam-bogofilter-spam-switch "-s" 407 "The switch that Bogofilter uses to register spam messages." 408 :type 'string 409 :group 'spam-bogofilter) 410 411(defcustom spam-bogofilter-ham-switch "-n" 412 "The switch that Bogofilter uses to register ham messages." 413 :type 'string 414 :group 'spam-bogofilter) 415 416(defcustom spam-bogofilter-spam-strong-switch "-S" 417 "The switch that Bogofilter uses to unregister ham messages." 418 :type 'string 419 :group 'spam-bogofilter) 420 421(defcustom spam-bogofilter-ham-strong-switch "-N" 422 "The switch that Bogofilter uses to unregister spam messages." 423 :type 'string 424 :group 'spam-bogofilter) 425 426(defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)" 427 "The regex on `spam-bogofilter-header' for positive spam identification." 428 :type 'regexp 429 :group 'spam-bogofilter) 430 431(defcustom spam-bogofilter-database-directory nil 432 "Location of the Bogofilter database. 433When nil, use the default location." 434 :type '(choice (directory 435 :tag "Location of the Bogofilter database directory") 436 (const :tag "Use the default")) 437 :group 'spam-bogofilter) 438 439(defgroup spam-spamoracle nil 440 "Spam spamoracle configuration." 441 :group 'spam) 442 443(defcustom spam-spamoracle-database nil 444 "Location of spamoracle database file. 445When nil, use the default spamoracle database." 446 :type '(choice (directory :tag "Location of spamoracle database file.") 447 (const :tag "Use the default")) 448 :group 'spam-spamoracle) 449 450(defcustom spam-spamoracle-binary (executable-find "spamoracle") 451 "Location of the spamoracle binary." 452 :type '(choice (directory :tag "Location of the spamoracle binary") 453 (const :tag "Use the default")) 454 :group 'spam-spamoracle) 455 456;;; Key bindings for spam control. 457 458(gnus-define-keys gnus-summary-mode-map 459 "St" spam-bogofilter-score 460 "Sx" gnus-summary-mark-as-spam 461 "Mst" spam-bogofilter-score 462 "Msx" gnus-summary-mark-as-spam 463 "\M-d" gnus-summary-mark-as-spam) 464 465(defvar spam-old-ham-articles nil 466 "List of old ham articles, generated when a group is entered.") 467 468(defvar spam-old-spam-articles nil 469 "List of old spam articles, generated when a group is entered.") 470 471(defvar spam-split-disabled nil 472 "If non-nil, `spam-split' is disabled, and always returns nil.") 473 474(defvar spam-split-last-successful-check nil 475 "`spam-split' will set this to nil or a spam-use-XYZ check if it 476 finds ham or spam.") 477 478;; convenience functions 479(defun spam-xor (a b) 480 "Logical exclusive `or'." 481 (and (or a b) (not (and a b)))) 482 483(defun spam-group-ham-mark-p (group mark &optional spam) 484 (when (stringp group) 485 (let* ((marks (spam-group-ham-marks group spam)) 486 (marks (if (symbolp mark) 487 marks 488 (mapcar 'symbol-value marks)))) 489 (memq mark marks)))) 490 491(defun spam-group-spam-mark-p (group mark) 492 (spam-group-ham-mark-p group mark t)) 493 494(defun spam-group-ham-marks (group &optional spam) 495 (when (stringp group) 496 (let* ((marks (if spam 497 (gnus-parameter-spam-marks group) 498 (gnus-parameter-ham-marks group))) 499 (marks (car marks)) 500 (marks (if (listp (car marks)) (car marks) marks))) 501 marks))) 502 503(defun spam-group-spam-marks (group) 504 (spam-group-ham-marks group t)) 505 506(defun spam-group-spam-contents-p (group) 507 (if (stringp group) 508 (or (member group spam-junk-mailgroups) 509 (memq 'gnus-group-spam-classification-spam 510 (gnus-parameter-spam-contents group))) 511 nil)) 512 513(defun spam-group-ham-contents-p (group) 514 (if (stringp group) 515 (memq 'gnus-group-spam-classification-ham 516 (gnus-parameter-spam-contents group)) 517 nil)) 518 519(defvar spam-list-of-processors 520 '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane) 521 (gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter) 522 (gnus-group-spam-exit-processor-blacklist spam spam-use-blacklist) 523 (gnus-group-spam-exit-processor-ifile spam spam-use-ifile) 524 (gnus-group-spam-exit-processor-stat spam spam-use-stat) 525 (gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle) 526 (gnus-group-ham-exit-processor-ifile ham spam-use-ifile) 527 (gnus-group-ham-exit-processor-bogofilter ham spam-use-bogofilter) 528 (gnus-group-ham-exit-processor-stat ham spam-use-stat) 529 (gnus-group-ham-exit-processor-whitelist ham spam-use-whitelist) 530 (gnus-group-ham-exit-processor-BBDB ham spam-use-BBDB) 531 (gnus-group-ham-exit-processor-copy ham spam-use-ham-copy) 532 (gnus-group-ham-exit-processor-spamoracle ham spam-use-spamoracle)) 533 "The spam-list-of-processors list contains pairs associating a 534ham/spam exit processor variable with a classification and a 535spam-use-* variable.") 536 537(defun spam-group-processor-p (group processor) 538 (if (and (stringp group) 539 (symbolp processor)) 540 (or (member processor (nth 0 (gnus-parameter-spam-process group))) 541 (spam-group-processor-multiple-p 542 group 543 (cdr-safe (assoc processor spam-list-of-processors)))) 544 nil)) 545 546(defun spam-group-processor-multiple-p (group processor-info) 547 (let* ((classification (nth 0 processor-info)) 548 (check (nth 1 processor-info)) 549 (parameters (nth 0 (gnus-parameter-spam-process group))) 550 found) 551 (dolist (parameter parameters) 552 (when (and (null found) 553 (listp parameter) 554 (eq classification (nth 0 parameter)) 555 (eq check (nth 1 parameter))) 556 (setq found t))) 557 found)) 558 559(defun spam-group-spam-processor-report-gmane-p (group) 560 (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane)) 561 562(defun spam-group-spam-processor-bogofilter-p (group) 563 (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter)) 564 565(defun spam-group-spam-processor-blacklist-p (group) 566 (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist)) 567 568(defun spam-group-spam-processor-ifile-p (group) 569 (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile)) 570 571(defun spam-group-ham-processor-ifile-p (group) 572 (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile)) 573 574(defun spam-group-spam-processor-spamoracle-p (group) 575 (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle)) 576 577(defun spam-group-ham-processor-bogofilter-p (group) 578 (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter)) 579 580(defun spam-group-spam-processor-stat-p (group) 581 (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat)) 582 583(defun spam-group-ham-processor-stat-p (group) 584 (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat)) 585 586(defun spam-group-ham-processor-whitelist-p (group) 587 (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist)) 588 589(defun spam-group-ham-processor-BBDB-p (group) 590 (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB)) 591 592(defun spam-group-ham-processor-copy-p (group) 593 (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy)) 594 595(defun spam-group-ham-processor-spamoracle-p (group) 596 (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle)) 597 598;;; Summary entry and exit processing. 599 600(defun spam-summary-prepare () 601 (setq spam-old-ham-articles 602 (spam-list-articles gnus-newsgroup-articles 'ham)) 603 (setq spam-old-spam-articles 604 (spam-list-articles gnus-newsgroup-articles 'spam)) 605 (spam-mark-junk-as-spam-routine)) 606 607;; The spam processors are invoked for any group, spam or ham or neither 608(defun spam-summary-prepare-exit () 609 (unless gnus-group-is-exiting-without-update-p 610 (gnus-message 6 "Exiting summary buffer and applying spam rules") 611 612 ;; first of all, unregister any articles that are no longer ham or spam 613 ;; we have to iterate over the processors, or else we'll be too slow 614 (dolist (classification '(spam ham)) 615 (let* ((old-articles (if (eq classification 'spam) 616 spam-old-spam-articles 617 spam-old-ham-articles)) 618 (new-articles (spam-list-articles 619 gnus-newsgroup-articles 620 classification)) 621 (changed-articles (gnus-set-difference old-articles new-articles))) 622 ;; now that we have the changed articles, we go through the processors 623 (dolist (processor-param spam-list-of-processors) 624 (let ((processor (nth 0 processor-param)) 625 (processor-classification (nth 1 processor-param)) 626 (check (nth 2 processor-param)) 627 unregister-list) 628 (dolist (article changed-articles) 629 (let ((id (spam-fetch-field-message-id-fast article))) 630 (when (spam-log-unregistration-needed-p 631 id 'process classification check) 632 (push article unregister-list)))) 633 ;; call spam-register-routine with specific articles to unregister, 634 ;; when there are articles to unregister and the check is enabled 635 (when (and unregister-list (symbol-value check)) 636 (spam-register-routine classification check t unregister-list)))))) 637 638 ;; find all the spam processors applicable to this group 639 (dolist (processor-param spam-list-of-processors) 640 (let ((processor (nth 0 processor-param)) 641 (classification (nth 1 processor-param)) 642 (check (nth 2 processor-param))) 643 (when (and (eq 'spam classification) 644 (spam-group-processor-p gnus-newsgroup-name processor)) 645 (spam-register-routine classification check)))) 646 647 (if spam-move-spam-nonspam-groups-only 648 (when (not (spam-group-spam-contents-p gnus-newsgroup-name)) 649 (spam-mark-spam-as-expired-and-move-routine 650 (gnus-parameter-spam-process-destination gnus-newsgroup-name))) 651 (gnus-message 5 "Marking spam as expired and moving it to %s" 652 gnus-newsgroup-name) 653 (spam-mark-spam-as-expired-and-move-routine 654 (gnus-parameter-spam-process-destination gnus-newsgroup-name))) 655 656 ;; now we redo spam-mark-spam-as-expired-and-move-routine to only 657 ;; expire spam, in case the above did not expire them 658 (gnus-message 5 "Marking spam as expired without moving it") 659 (spam-mark-spam-as-expired-and-move-routine nil) 660 661 (when (or (spam-group-ham-contents-p gnus-newsgroup-name) 662 (and (spam-group-spam-contents-p gnus-newsgroup-name) 663 spam-process-ham-in-spam-groups) 664 spam-process-ham-in-nonham-groups) 665 ;; find all the ham processors applicable to this group 666 (dolist (processor-param spam-list-of-processors) 667 (let ((processor (nth 0 processor-param)) 668 (classification (nth 1 processor-param)) 669 (check (nth 2 processor-param))) 670 (when (and (eq 'ham classification) 671 (spam-group-processor-p gnus-newsgroup-name processor)) 672 (spam-register-routine classification check))))) 673 674 (when (spam-group-ham-processor-copy-p gnus-newsgroup-name) 675 (gnus-message 5 "Copying ham") 676 (spam-ham-copy-routine 677 (gnus-parameter-ham-process-destination gnus-newsgroup-name))) 678 679 ;; now move all ham articles out of spam groups 680 (when (spam-group-spam-contents-p gnus-newsgroup-name) 681 (gnus-message 5 "Moving ham messages from spam group") 682 (spam-ham-move-routine 683 (gnus-parameter-ham-process-destination gnus-newsgroup-name)))) 684 685 (setq spam-old-ham-articles nil) 686 (setq spam-old-spam-articles nil)) 687 688(defun spam-mark-junk-as-spam-routine () 689 ;; check the global list of group names spam-junk-mailgroups and the 690 ;; group parameters 691 (when (spam-group-spam-contents-p gnus-newsgroup-name) 692 (gnus-message 6 "Marking %s articles as spam" 693 (if spam-mark-only-unseen-as-spam 694 "unseen" 695 "unread")) 696 (let ((articles (if spam-mark-only-unseen-as-spam 697 gnus-newsgroup-unseen 698 gnus-newsgroup-unreads))) 699 (if spam-mark-new-messages-in-spam-group-as-spam 700 (dolist (article articles) 701 (gnus-summary-mark-article article gnus-spam-mark)) 702 (gnus-message 9 "Did not mark new messages as spam."))))) 703 704(defun spam-mark-spam-as-expired-and-move-routine (&rest groups) 705 (if (and (car-safe groups) (listp (car-safe groups))) 706 (apply 'spam-mark-spam-as-expired-and-move-routine (car groups)) 707 (gnus-summary-kill-process-mark) 708 (let ((articles gnus-newsgroup-articles) 709 (backend-supports-deletions 710 (gnus-check-backend-function 711 'request-move-article gnus-newsgroup-name)) 712 article tomove deletep) 713 (dolist (article articles) 714 (when (eq (gnus-summary-article-mark article) gnus-spam-mark) 715 (gnus-summary-mark-article article gnus-expirable-mark) 716 (push article tomove))) 717 718 ;; now do the actual copies 719 (dolist (group groups) 720 (when (and tomove 721 (stringp group)) 722 (dolist (article tomove) 723 (gnus-summary-set-process-mark article)) 724 (when tomove 725 (if (or (not backend-supports-deletions) 726 (> (length groups) 1)) 727 (progn 728 (gnus-summary-copy-article nil group) 729 (setq deletep t)) 730 (gnus-summary-move-article nil group))))) 731 732 ;; now delete the articles, if there was a copy done, and the 733 ;; backend allows it 734 (when (and deletep backend-supports-deletions) 735 (dolist (article tomove) 736 (gnus-summary-set-process-mark article)) 737 (when tomove 738 (let ((gnus-novice-user nil)) ; don't ask me if I'm sure 739 (gnus-summary-delete-article nil)))) 740 741 (gnus-summary-yank-process-mark)))) 742 743(defun spam-ham-copy-or-move-routine (copy groups) 744 (gnus-summary-kill-process-mark) 745 (let ((todo (spam-list-articles gnus-newsgroup-articles 'ham)) 746 (backend-supports-deletions 747 (gnus-check-backend-function 748 'request-move-article gnus-newsgroup-name)) 749 (respool-method (gnus-find-method-for-group gnus-newsgroup-name)) 750 article mark deletep respool) 751 752 (when (member 'respool groups) 753 (setq respool t) ; boolean for later 754 (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it 755 756 ;; now do the actual move 757 (dolist (group groups) 758 (when (and todo (stringp group)) 759 (dolist (article todo) 760 (when spam-mark-ham-unread-before-move-from-spam-group 761 (gnus-summary-mark-article article gnus-unread-mark)) 762 (gnus-summary-set-process-mark article)) 763 764 (if respool ; respooling is with a "fake" group 765 (let ((spam-split-disabled 766 (or spam-split-disabled 767 spam-disable-spam-split-during-ham-respool))) 768 (gnus-summary-respool-article nil respool-method)) 769 (if (or (not backend-supports-deletions) ; else, we are not respooling 770 (> (length groups) 1)) 771 (progn ; if copying, copy and set deletep 772 (gnus-summary-copy-article nil group) 773 (setq deletep t)) 774 (gnus-summary-move-article nil group))))) ; else move articles 775 776 ;; now delete the articles, unless a) copy is t, and there was a copy done 777 ;; b) a move was done to a single group 778 ;; c) backend-supports-deletions is nil 779 (unless copy 780 (when (and deletep backend-supports-deletions) 781 (dolist (article todo) 782 (gnus-summary-set-process-mark article)) 783 (when todo 784 (let ((gnus-novice-user nil)) ; don't ask me if I'm sure 785 (gnus-summary-delete-article nil)))))) 786 787 (gnus-summary-yank-process-mark)) 788 789(defun spam-ham-copy-routine (&rest groups) 790 (if (and (car-safe groups) (listp (car-safe groups))) 791 (apply 'spam-ham-copy-routine (car groups)) 792 (spam-ham-copy-or-move-routine t groups))) 793 794(defun spam-ham-move-routine (&rest groups) 795 (if (and (car-safe groups) (listp (car-safe groups))) 796 (apply 'spam-ham-move-routine (car groups)) 797 (spam-ham-copy-or-move-routine nil groups))) 798 799(eval-and-compile 800 (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol) 801 'point-at-eol 802 'line-end-position))) 803 804(defun spam-get-article-as-string (article) 805 (let ((article-buffer (spam-get-article-as-buffer article)) 806 article-string) 807 (when article-buffer 808 (save-window-excursion 809 (set-buffer article-buffer) 810 (setq article-string (buffer-string)))) 811 article-string)) 812 813(defun spam-get-article-as-buffer (article) 814 (let ((article-buffer)) 815 (when (numberp article) 816 (save-window-excursion 817 (gnus-summary-goto-subject article) 818 (gnus-summary-show-article t) 819 (setq article-buffer (get-buffer gnus-article-buffer)))) 820 article-buffer)) 821 822;; disabled for now 823;; (defun spam-get-article-as-filename (article) 824;; (let ((article-filename)) 825;; (when (numberp article) 826;; (nnml-possibly-change-directory 827;; (gnus-group-real-name gnus-newsgroup-name)) 828;; (setq article-filename (expand-file-name 829;; (int-to-string article) nnml-current-directory))) 830;; (if (file-exists-p article-filename) 831;; article-filename 832;; nil))) 833 834(defun spam-fetch-field-from-fast (article) 835 "Fetch the `from' field quickly, using the internal gnus-data-list function" 836 (if (and (numberp article) 837 (assoc article (gnus-data-list nil))) 838 (mail-header-from 839 (gnus-data-header (assoc article (gnus-data-list nil)))) 840 nil)) 841 842(defun spam-fetch-field-subject-fast (article) 843 "Fetch the `subject' field quickly, using the internal 844 gnus-data-list function" 845 (if (and (numberp article) 846 (assoc article (gnus-data-list nil))) 847 (mail-header-subject 848 (gnus-data-header (assoc article (gnus-data-list nil)))) 849 nil)) 850 851(defun spam-fetch-field-message-id-fast (article) 852 "Fetch the `Message-ID' field quickly, using the internal 853 gnus-data-list function" 854 (if (and (numberp article) 855 (assoc article (gnus-data-list nil))) 856 (mail-header-message-id 857 (gnus-data-header (assoc article (gnus-data-list nil)))) 858 nil)) 859 860 861;;;; Spam determination. 862 863(defvar spam-list-of-checks 864 '((spam-use-blacklist . spam-check-blacklist) 865 (spam-use-regex-headers . spam-check-regex-headers) 866 (spam-use-regex-body . spam-check-regex-body) 867 (spam-use-whitelist . spam-check-whitelist) 868 (spam-use-BBDB . spam-check-BBDB) 869 (spam-use-ifile . spam-check-ifile) 870 (spam-use-spamoracle . spam-check-spamoracle) 871 (spam-use-stat . spam-check-stat) 872 (spam-use-blackholes . spam-check-blackholes) 873 (spam-use-hashcash . spam-check-hashcash) 874 (spam-use-bogofilter-headers . spam-check-bogofilter-headers) 875 (spam-use-bogofilter . spam-check-bogofilter)) 876 "The spam-list-of-checks list contains pairs associating a 877parameter variable with a spam checking function. If the 878parameter variable is true, then the checking function is called, 879and its value decides what happens. Each individual check may 880return nil, t, or a mailgroup name. The value nil means that the 881check does not yield a decision, and so, that further checks are 882needed. The value t means that the message is definitely not 883spam, and that further spam checks should be inhibited. 884Otherwise, a mailgroup name or the symbol 'spam (depending on 885spam-split-symbolic-return) is returned where the mail should go, 886and further checks are also inhibited. The usual mailgroup name 887is the value of `spam-split-group', meaning that the message is 888definitely a spam.") 889 890(defvar spam-list-of-statistical-checks 891 '(spam-use-ifile 892 spam-use-regex-body 893 spam-use-stat 894 spam-use-bogofilter 895 spam-use-spamoracle) 896 "The spam-list-of-statistical-checks list contains all the mail 897splitters that need to have the full message body available.") 898 899;;;TODO: modify to invoke self with each check if invoked without specifics 900(defun spam-split (&rest specific-checks) 901 "Split this message into the `spam' group if it is spam. 902This function can be used as an entry in the variable `nnmail-split-fancy', 903for example like this: (: spam-split). It can take checks as 904parameters. A string as a parameter will set the 905spam-split-group to that string. 906 907See the Info node `(gnus)Fancy Mail Splitting' for more details." 908 (interactive) 909 (setq spam-split-last-successful-check nil) 910 (unless spam-split-disabled 911 (let ((spam-split-group-choice spam-split-group)) 912 (dolist (check specific-checks) 913 (when (stringp check) 914 (setq spam-split-group-choice check) 915 (setq specific-checks (delq check specific-checks)))) 916 917 (let ((spam-split-group spam-split-group-choice)) 918 (save-excursion 919 (save-restriction 920 (dolist (check spam-list-of-statistical-checks) 921 (when (and (symbolp check) (symbol-value check)) 922 (widen) 923 (gnus-message 8 "spam-split: widening the buffer (%s requires it)" 924 (symbol-name check)) 925 (return))) 926 ;; (progn (widen) (debug (buffer-string))) 927 (let ((list-of-checks spam-list-of-checks) 928 decision) 929 (while (and list-of-checks (not decision)) 930 (let ((pair (pop list-of-checks))) 931 (when (and (symbol-value (car pair)) 932 (or (null specific-checks) 933 (memq (car pair) specific-checks))) 934 (gnus-message 5 "spam-split: calling the %s function" 935 (symbol-name (cdr pair))) 936 (setq decision (funcall (cdr pair))) 937 ;; if we got a decision at all, save the current check 938 (when decision 939 (setq spam-split-last-successful-check (car pair))) 940 941 (when (eq decision 'spam) 942 (if spam-split-symbolic-return 943 (setq decision spam-split-group) 944 (gnus-error 945 5 946 (format "spam-split got %s but %s is nil" 947 (symbol-name decision) 948 (symbol-name spam-split-symbolic-return)))))))) 949 (if (eq decision t) 950 (if spam-split-symbolic-return-positive 'ham nil) 951 decision)))))))) 952 953(defun spam-find-spam () 954 "This function will detect spam in the current newsgroup using spam-split." 955 (interactive) 956 957 (let* ((group gnus-newsgroup-name) 958 (autodetect (gnus-parameter-spam-autodetect group)) 959 (methods (gnus-parameter-spam-autodetect-methods group)) 960 (first-method (nth 0 methods))) 961 (when (and autodetect 962 (not (equal first-method 'none))) 963 (mapcar 964 (lambda (article) 965 (let ((id (spam-fetch-field-message-id-fast article)) 966 (subject (spam-fetch-field-subject-fast article)) 967 (sender (spam-fetch-field-from-fast article))) 968 (unless (and spam-log-to-registry 969 (spam-log-registered-p id 'incoming)) 970 (let* ((spam-split-symbolic-return t) 971 (spam-split-symbolic-return-positive t) 972 (split-return 973 (with-temp-buffer 974 (gnus-request-article-this-buffer 975 article 976 group) 977 (if (or (null first-method) 978 (equal first-method 'default)) 979 (spam-split) 980 (apply 'spam-split methods))))) 981 (if (equal split-return 'spam) 982 (gnus-summary-mark-article article gnus-spam-mark)) 983 984 (when (and split-return spam-log-to-registry) 985 (when (zerop (gnus-registry-group-count id)) 986 (gnus-registry-add-group 987 id group subject sender)) 988 989 (spam-log-processing-to-registry 990 id 991 'incoming 992 split-return 993 spam-split-last-successful-check 994 group)))))) 995 (if spam-autodetect-recheck-messages 996 gnus-newsgroup-articles 997 gnus-newsgroup-unseen))))) 998 999(defvar spam-registration-functions 1000 ;; first the ham register, second the spam register function 1001 ;; third the ham unregister, fourth the spam unregister function 1002 '((spam-use-blacklist nil 1003 spam-blacklist-register-routine 1004 nil 1005 spam-blacklist-unregister-routine) 1006 (spam-use-whitelist spam-whitelist-register-routine 1007 nil 1008 spam-whitelist-unregister-routine 1009 nil) 1010 (spam-use-BBDB spam-BBDB-register-routine 1011 nil 1012 spam-BBDB-unregister-routine 1013 nil) 1014 (spam-use-ifile spam-ifile-register-ham-routine 1015 spam-ifile-register-spam-routine 1016 spam-ifile-unregister-ham-routine 1017 spam-ifile-unregister-spam-routine) 1018 (spam-use-spamoracle spam-spamoracle-learn-ham 1019 spam-spamoracle-learn-spam 1020 spam-spamoracle-unlearn-ham 1021 spam-spamoracle-unlearn-spam) 1022 (spam-use-stat spam-stat-register-ham-routine 1023 spam-stat-register-spam-routine 1024 spam-stat-unregister-ham-routine 1025 spam-stat-unregister-spam-routine) 1026 ;; note that spam-use-gmane is not a legitimate check 1027 (spam-use-gmane nil 1028 spam-report-gmane-register-routine 1029 ;; does Gmane support unregistration? 1030 nil 1031 nil) 1032 (spam-use-bogofilter spam-bogofilter-register-ham-routine 1033 spam-bogofilter-register-spam-routine 1034 spam-bogofilter-unregister-ham-routine 1035 spam-bogofilter-unregister-spam-routine)) 1036 "The spam-registration-functions list contains pairs 1037associating a parameter variable with the ham and spam 1038registration functions, and the ham and spam unregistration 1039functions") 1040 1041(defun spam-classification-valid-p (classification) 1042 (or (eq classification 'spam) 1043 (eq classification 'ham))) 1044 1045(defun spam-process-type-valid-p (process-type) 1046 (or (eq process-type 'incoming) 1047 (eq process-type 'process))) 1048 1049(defun spam-registration-check-valid-p (check) 1050 (assoc check spam-registration-functions)) 1051 1052(defun spam-unregistration-check-valid-p (check) 1053 (assoc check spam-registration-functions)) 1054 1055(defun spam-registration-function (classification check) 1056 (let ((flist (cdr-safe (assoc check spam-registration-functions)))) 1057 (if (eq classification 'spam) 1058 (nth 1 flist) 1059 (nth 0 flist)))) 1060 1061(defun spam-unregistration-function (classification check) 1062 (let ((flist (cdr-safe (assoc check spam-registration-functions)))) 1063 (if (eq classification 'spam) 1064 (nth 3 flist) 1065 (nth 2 flist)))) 1066 1067(defun spam-list-articles (articles classification) 1068 (let ((mark-check (if (eq classification 'spam) 1069 'spam-group-spam-mark-p 1070 'spam-group-ham-mark-p)) 1071 list mark-cache-yes mark-cache-no) 1072 (dolist (article articles) 1073 (let ((mark (gnus-summary-article-mark article))) 1074 (unless (memq mark mark-cache-no) 1075 (if (memq mark mark-cache-yes) 1076 (push article list) 1077 ;; else, we have to actually check the mark 1078 (if (funcall mark-check 1079 gnus-newsgroup-name 1080 mark) 1081 (progn 1082 (push article list) 1083 (push mark mark-cache-yes)) 1084 (push mark mark-cache-no)))))) 1085 list)) 1086 1087(defun spam-register-routine (classification 1088 check 1089 &optional unregister 1090 specific-articles) 1091 (when (and (spam-classification-valid-p classification) 1092 (spam-registration-check-valid-p check)) 1093 (let* ((register-function 1094 (spam-registration-function classification check)) 1095 (unregister-function 1096 (spam-unregistration-function classification check)) 1097 (run-function (if unregister 1098 unregister-function 1099 register-function)) 1100 (log-function (if unregister 1101 'spam-log-undo-registration 1102 'spam-log-processing-to-registry)) 1103 article articles) 1104 1105 (when run-function 1106 ;; make list of articles, using specific-articles if given 1107 (setq articles (or specific-articles 1108 (spam-list-articles 1109 gnus-newsgroup-articles 1110 classification))) 1111 ;; process them 1112 (gnus-message 5 "%s %d %s articles with classification %s, check %s" 1113 (if unregister "Unregistering" "Registering") 1114 (length articles) 1115 (if specific-articles "specific" "") 1116 (symbol-name classification) 1117 (symbol-name check)) 1118 (funcall run-function articles) 1119 ;; now log all the registrations (or undo them, depending on unregister) 1120 (dolist (article articles) 1121 (funcall log-function 1122 (spam-fetch-field-message-id-fast article) 1123 'process 1124 classification 1125 check 1126 gnus-newsgroup-name)))))) 1127 1128;;; log a ham- or spam-processor invocation to the registry 1129(defun spam-log-processing-to-registry (id type classification check group) 1130 (when spam-log-to-registry 1131 (if (and (stringp id) 1132 (stringp group) 1133 (spam-process-type-valid-p type) 1134 (spam-classification-valid-p classification) 1135 (spam-registration-check-valid-p check)) 1136 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) 1137 (cell (list classification check group))) 1138 (push cell cell-list) 1139 (gnus-registry-store-extra-entry 1140 id 1141 type 1142 cell-list)) 1143 1144 (gnus-message 5 (format "%s called with bad ID, type, classification, check, or group" 1145 "spam-log-processing-to-registry"))))) 1146 1147;;; check if a ham- or spam-processor registration has been done 1148(defun spam-log-registered-p (id type) 1149 (when spam-log-to-registry 1150 (if (and (stringp id) 1151 (spam-process-type-valid-p type)) 1152 (cdr-safe (gnus-registry-fetch-extra id type)) 1153 (progn 1154 (gnus-message 5 (format "%s called with bad ID, type, classification, or check" 1155 "spam-log-registered-p")) 1156 nil)))) 1157 1158;;; check if a ham- or spam-processor registration needs to be undone 1159(defun spam-log-unregistration-needed-p (id type classification check) 1160 (when spam-log-to-registry 1161 (if (and (stringp id) 1162 (spam-process-type-valid-p type) 1163 (spam-classification-valid-p classification) 1164 (spam-registration-check-valid-p check)) 1165 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) 1166 found) 1167 (dolist (cell cell-list) 1168 (unless found 1169 (when (and (eq classification (nth 0 cell)) 1170 (eq check (nth 1 cell))) 1171 (setq found t)))) 1172 found) 1173 (progn 1174 (gnus-message 5 (format "%s called with bad ID, type, classification, or check" 1175 "spam-log-unregistration-needed-p")) 1176 nil)))) 1177 1178 1179;;; undo a ham- or spam-processor registration (the group is not used) 1180(defun spam-log-undo-registration (id type classification check &optional group) 1181 (when (and spam-log-to-registry 1182 (spam-log-unregistration-needed-p id type classification check)) 1183 (if (and (stringp id) 1184 (spam-process-type-valid-p type) 1185 (spam-classification-valid-p classification) 1186 (spam-registration-check-valid-p check)) 1187 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) 1188 new-cell-list found) 1189 (dolist (cell cell-list) 1190 (unless (and (eq classification (nth 0 cell)) 1191 (eq check (nth 1 cell))) 1192 (push cell new-cell-list))) 1193 (gnus-registry-store-extra-entry 1194 id 1195 type 1196 new-cell-list)) 1197 (progn 1198 (gnus-message 5 (format "%s called with bad ID, type, check, or group" 1199 "spam-log-undo-registration")) 1200 nil)))) 1201 1202;;; set up IMAP widening if it's necessary 1203(defun spam-setup-widening () 1204 (dolist (check spam-list-of-statistical-checks) 1205 (when (symbol-value check) 1206 (setq nnimap-split-download-body-default t)))) 1207 1208 1209;;;; Regex body 1210 1211(defun spam-check-regex-body () 1212 (let ((spam-regex-headers-ham spam-regex-body-ham) 1213 (spam-regex-headers-spam spam-regex-body-spam)) 1214 (spam-check-regex-headers t))) 1215 1216 1217;;;; Regex headers 1218 1219(defun spam-check-regex-headers (&optional body) 1220 (let ((type (if body "body" "header")) 1221 (spam-split-group (if spam-split-symbolic-return 1222 'spam 1223 spam-split-group)) 1224 ret found) 1225 (dolist (h-regex spam-regex-headers-ham) 1226 (unless found 1227 (goto-char (point-min)) 1228 (when (re-search-forward h-regex nil t) 1229 (message "Ham regex %s search positive." type) 1230 (setq found t)))) 1231 (dolist (s-regex spam-regex-headers-spam) 1232 (unless found 1233 (goto-char (point-min)) 1234 (when (re-search-forward s-regex nil t) 1235 (message "Spam regex %s search positive." type) 1236 (setq found t) 1237 (setq ret spam-split-group)))) 1238 ret)) 1239 1240 1241;;;; Blackholes. 1242 1243(defun spam-reverse-ip-string (ip) 1244 (when (stringp ip) 1245 (mapconcat 'identity 1246 (nreverse (split-string ip "\\.")) 1247 "."))) 1248 1249(defun spam-check-blackholes () 1250 "Check the Received headers for blackholed relays." 1251 (let ((headers (nnmail-fetch-field "received")) 1252 (spam-split-group (if spam-split-symbolic-return 1253 'spam 1254 spam-split-group)) 1255 ips matches) 1256 (when headers 1257 (with-temp-buffer 1258 (insert headers) 1259 (goto-char (point-min)) 1260 (gnus-message 5 "Checking headers for relay addresses") 1261 (while (re-search-forward 1262 "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) 1263 (gnus-message 9 "Blackhole search found host IP %s." (match-string 1)) 1264 (push (spam-reverse-ip-string (match-string 1)) 1265 ips))) 1266 (dolist (server spam-blackhole-servers) 1267 (dolist (ip ips) 1268 (unless (and spam-blackhole-good-server-regex 1269 ;; match the good-server-regex against the reversed (again) IP string 1270 (string-match 1271 spam-blackhole-good-server-regex 1272 (spam-reverse-ip-string ip))) 1273 (unless matches 1274 (let ((query-string (concat ip "." server))) 1275 (if spam-use-dig 1276 (let ((query-result (query-dig query-string))) 1277 (when query-result 1278 (gnus-message 5 "(DIG): positive blackhole check '%s'" 1279 query-result) 1280 (push (list ip server query-result) 1281 matches))) 1282 ;; else, if not using dig.el 1283 (when (query-dns query-string) 1284 (gnus-message 5 "positive blackhole check") 1285 (push (list ip server (query-dns query-string 'TXT)) 1286 matches))))))))) 1287 (when matches 1288 spam-split-group))) 1289 1290;;;; Hashcash. 1291 1292(eval-when-compile 1293 (autoload 'mail-check-payment "hashcash")) 1294 1295(condition-case nil 1296 (progn 1297 (require 'hashcash) 1298 1299 (defun spam-check-hashcash () 1300 "Check the headers for hashcash payments." 1301 (mail-check-payment))) ;mail-check-payment returns a boolean 1302 1303 (file-error)) 1304 1305;;;; BBDB 1306 1307;;; original idea for spam-check-BBDB from Alexander Kotelnikov 1308;;; <sacha@giotto.sj.ru> 1309 1310;; all this is done inside a condition-case to trap errors 1311 1312(eval-when-compile 1313 (autoload 'bbdb-buffer "bbdb") 1314 (autoload 'bbdb-create-internal "bbdb") 1315 (autoload 'bbdb-search-simple "bbdb")) 1316 1317(eval-and-compile 1318 (when (condition-case nil 1319 (progn 1320 (require 'bbdb) 1321 (require 'bbdb-com)) 1322 (file-error 1323 (defalias 'spam-BBDB-register-routine 'ignore) 1324 (defalias 'spam-enter-ham-BBDB 'ignore) 1325 nil)) 1326 1327 (defun spam-enter-ham-BBDB (addresses &optional remove) 1328 "Enter an address into the BBDB; implies ham (non-spam) sender" 1329 (dolist (from addresses) 1330 (when (stringp from) 1331 (let* ((parsed-address (gnus-extract-address-components from)) 1332 (name (or (nth 0 parsed-address) "Ham Sender")) 1333 (remove-function (if remove 1334 'bbdb-delete-record-internal 1335 'ignore)) 1336 (net-address (nth 1 parsed-address)) 1337 (record (and net-address 1338 (bbdb-search-simple nil net-address)))) 1339 (when net-address 1340 (gnus-message 5 "%s address %s %s BBDB" 1341 (if remove "Deleting" "Adding") 1342 from 1343 (if remove "from" "to")) 1344 (if record 1345 (funcall remove-function record) 1346 (bbdb-create-internal name nil net-address nil nil 1347 "ham sender added by spam.el"))))))) 1348 1349 (defun spam-BBDB-register-routine (articles &optional unregister) 1350 (let (addresses) 1351 (dolist (article articles) 1352 (when (stringp (spam-fetch-field-from-fast article)) 1353 (push (spam-fetch-field-from-fast article) addresses))) 1354 ;; now do the register/unregister action 1355 (spam-enter-ham-BBDB addresses unregister))) 1356 1357 (defun spam-BBDB-unregister-routine (articles) 1358 (spam-BBDB-register-routine articles t)) 1359 1360 (defun spam-check-BBDB () 1361 "Mail from people in the BBDB is classified as ham or non-spam" 1362 (let ((who (nnmail-fetch-field "from")) 1363 (spam-split-group (if spam-split-symbolic-return 1364 'spam 1365 spam-split-group))) 1366 (when who 1367 (setq who (nth 1 (gnus-extract-address-components who))) 1368 (if (bbdb-search-simple nil who) 1369 t 1370 (if spam-use-BBDB-exclusive 1371 spam-split-group 1372 nil))))))) 1373 1374 1375;;;; ifile 1376 1377;;; check the ifile backend; return nil if the mail was NOT classified 1378;;; as spam 1379 1380 1381(defun spam-get-ifile-database-parameter () 1382 "Return the command-line parameter for ifile's database. 1383See `spam-ifile-database'." 1384 (if spam-ifile-database 1385 (format "--db-file=%s" spam-ifile-database) 1386 nil)) 1387 1388(defun spam-check-ifile () 1389 "Check the ifile backend for the classification of this message." 1390 (let ((article-buffer-name (buffer-name)) 1391 (spam-split-group (if spam-split-symbolic-return 1392 'spam 1393 spam-split-group)) 1394 category return) 1395 (with-temp-buffer 1396 (let ((temp-buffer-name (buffer-name)) 1397 (db-param (spam-get-ifile-database-parameter))) 1398 (save-excursion 1399 (set-buffer article-buffer-name) 1400 (apply 'call-process-region 1401 (point-min) (point-max) spam-ifile-program 1402 nil temp-buffer-name nil "-c" 1403 (if db-param `(,db-param "-q") `("-q")))) 1404 ;; check the return now (we're back in the temp buffer) 1405 (goto-char (point-min)) 1406 (if (not (eobp)) 1407 (setq category (buffer-substring (point) (spam-point-at-eol)))) 1408 (when (not (zerop (length category))) ; we need a category here 1409 (if spam-ifile-all-categories 1410 (setq return category) 1411 ;; else, if spam-ifile-all-categories is not set... 1412 (when (string-equal spam-ifile-spam-category category) 1413 (setq return spam-split-group)))))) ; note return is nil otherwise 1414 return)) 1415 1416(defun spam-ifile-register-with-ifile (articles category &optional unregister) 1417 "Register an article, given as a string, with a category. 1418Uses `gnus-newsgroup-name' if category is nil (for ham registration)." 1419 (let ((category (or category gnus-newsgroup-name)) 1420 (add-or-delete-option (if unregister "-d" "-i")) 1421 (db (spam-get-ifile-database-parameter)) 1422 parameters) 1423 (with-temp-buffer 1424 (dolist (article articles) 1425 (let ((article-string (spam-get-article-as-string article))) 1426 (when (stringp article-string) 1427 (insert article-string)))) 1428 (apply 'call-process-region 1429 (point-min) (point-max) spam-ifile-program 1430 nil nil nil 1431 add-or-delete-option category 1432 (if db `(,db "-h") `("-h")))))) 1433 1434(defun spam-ifile-register-spam-routine (articles &optional unregister) 1435 (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister)) 1436 1437(defun spam-ifile-unregister-spam-routine (articles) 1438 (spam-ifile-register-spam-routine articles t)) 1439 1440(defun spam-ifile-register-ham-routine (articles &optional unregister) 1441 (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister)) 1442 1443(defun spam-ifile-unregister-ham-routine (articles) 1444 (spam-ifile-register-ham-routine articles t)) 1445 1446 1447;;;; spam-stat 1448 1449(eval-when-compile 1450 (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat") 1451 (autoload 'spam-stat-buffer-change-to-spam "spam-stat") 1452 (autoload 'spam-stat-buffer-is-non-spam "spam-stat") 1453 (autoload 'spam-stat-buffer-is-spam "spam-stat") 1454 (autoload 'spam-stat-load "spam-stat") 1455 (autoload 'spam-stat-save "spam-stat") 1456 (autoload 'spam-stat-split-fancy "spam-stat")) 1457 1458(eval-and-compile 1459 (when (condition-case nil 1460 (let ((spam-stat-install-hooks nil)) 1461 (require 'spam-stat)) 1462 (file-error 1463 (defalias 'spam-stat-register-ham-routine 'ignore) 1464 (defalias 'spam-stat-register-spam-routine 'ignore) 1465 nil)) 1466 1467 (defun spam-check-stat () 1468 "Check the spam-stat backend for the classification of this message" 1469 (let ((spam-split-group (if spam-split-symbolic-return 1470 'spam 1471 spam-split-group)) 1472 (spam-stat-split-fancy-spam-group spam-split-group) ; override 1473 (spam-stat-buffer (buffer-name)) ; stat the current buffer 1474 category return) 1475 (spam-stat-split-fancy))) 1476 1477 (defun spam-stat-register-spam-routine (articles &optional unregister) 1478 (dolist (article articles) 1479 (let ((article-string (spam-get-article-as-string article))) 1480 (with-temp-buffer 1481 (insert article-string) 1482 (if unregister 1483 (spam-stat-buffer-change-to-non-spam) 1484 (spam-stat-buffer-is-spam)))))) 1485 1486 (defun spam-stat-unregister-spam-routine (articles) 1487 (spam-stat-register-spam-routine articles t)) 1488 1489 (defun spam-stat-register-ham-routine (articles &optional unregister) 1490 (dolist (article articles) 1491 (let ((article-string (spam-get-article-as-string article))) 1492 (with-temp-buffer 1493 (insert article-string) 1494 (if unregister 1495 (spam-stat-buffer-change-to-spam) 1496 (spam-stat-buffer-is-non-spam)))))) 1497 1498 (defun spam-stat-unregister-ham-routine (articles) 1499 (spam-stat-register-ham-routine articles t)) 1500 1501 (defun spam-maybe-spam-stat-load () 1502 (when spam-use-stat (spam-stat-load))) 1503 1504 (defun spam-maybe-spam-stat-save () 1505 (when spam-use-stat (spam-stat-save))))) 1506 1507 1508 1509;;;; Blacklists and whitelists. 1510 1511(defvar spam-whitelist-cache nil) 1512(defvar spam-blacklist-cache nil) 1513 1514(defun spam-kill-whole-line () 1515 (beginning-of-line) 1516 (let ((kill-whole-line t)) 1517 (kill-line))) 1518 1519;;; address can be a list, too 1520(defun spam-enter-whitelist (address &optional remove) 1521 "Enter ADDRESS (list or single) into the whitelist. 1522With a non-nil REMOVE, remove them." 1523 (interactive "sAddress: ") 1524 (spam-enter-list address spam-whitelist remove) 1525 (setq spam-whitelist-cache nil)) 1526 1527;;; address can be a list, too 1528(defun spam-enter-blacklist (address &optional remove) 1529 "Enter ADDRESS (list or single) into the blacklist. 1530With a non-nil REMOVE, remove them." 1531 (interactive "sAddress: ") 1532 (spam-enter-list address spam-blacklist remove) 1533 (setq spam-blacklist-cache nil)) 1534 1535(defun spam-enter-list (addresses file &optional remove) 1536 "Enter ADDRESSES into the given FILE. 1537Either the whitelist or the blacklist files can be used. With 1538REMOVE not nil, remove the ADDRESSES." 1539 (if (stringp addresses) 1540 (spam-enter-list (list addresses) file remove) 1541 ;; else, we have a list of addresses here 1542 (unless (file-exists-p (file-name-directory file)) 1543 (make-directory (file-name-directory file) t)) 1544 (save-excursion 1545 (set-buffer 1546 (find-file-noselect file)) 1547 (dolist (a addresses) 1548 (when (stringp a) 1549 (goto-char (point-min)) 1550 (if (re-search-forward (regexp-quote a) nil t) 1551 ;; found the address 1552 (when remove 1553 (spam-kill-whole-line)) 1554 ;; else, the address was not found 1555 (unless remove 1556 (goto-char (point-max)) 1557 (unless (bobp) 1558 (insert "\n")) 1559 (insert a "\n"))))) 1560 (save-buffer)))) 1561 1562;;; returns t if the sender is in the whitelist, nil or 1563;;; spam-split-group otherwise 1564(defun spam-check-whitelist () 1565 ;; FIXME! Should it detect when file timestamps change? 1566 (let ((spam-split-group (if spam-split-symbolic-return 1567 'spam 1568 spam-split-group))) 1569 (unless spam-whitelist-cache 1570 (setq spam-whitelist-cache (spam-parse-list spam-whitelist))) 1571 (if (spam-from-listed-p spam-whitelist-cache) 1572 t 1573 (if spam-use-whitelist-exclusive 1574 spam-split-group 1575 nil)))) 1576 1577(defun spam-check-blacklist () 1578 ;; FIXME! Should it detect when file timestamps change? 1579 (let ((spam-split-group (if spam-split-symbolic-return 1580 'spam 1581 spam-split-group))) 1582 (unless spam-blacklist-cache 1583 (setq spam-blacklist-cache (spam-parse-list spam-blacklist))) 1584 (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))) 1585 1586(defun spam-parse-list (file) 1587 (when (file-readable-p file) 1588 (let (contents address) 1589 (with-temp-buffer 1590 (insert-file-contents file) 1591 (while (not (eobp)) 1592 (setq address (buffer-substring (point) (spam-point-at-eol))) 1593 (forward-line 1) 1594 ;; insert the e-mail address if detected, otherwise the raw data 1595 (unless (zerop (length address)) 1596 (let ((pure-address (nth 1 (gnus-extract-address-components address)))) 1597 (push (or pure-address address) contents))))) 1598 (nreverse contents)))) 1599 1600(defun spam-from-listed-p (cache) 1601 (let ((from (nnmail-fetch-field "from")) 1602 found) 1603 (while cache 1604 (let ((address (pop cache))) 1605 (unless (zerop (length address)) ; 0 for a nil address too 1606 (setq address (regexp-quote address)) 1607 ;; fix regexp-quote's treatment of user-intended regexes 1608 (while (string-match "\\\\\\*" address) 1609 (setq address (replace-match ".*" t t address)))) 1610 (when (and address (string-match address from)) 1611 (setq found t 1612 cache nil)))) 1613 found)) 1614 1615(defun spam-filelist-register-routine (articles blacklist &optional unregister) 1616 (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist)) 1617 (declassification (if blacklist 'ham 'spam)) 1618 (enter-function 1619 (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist)) 1620 (remove-function 1621 (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist)) 1622 from addresses unregister-list) 1623 (dolist (article articles) 1624 (let ((from (spam-fetch-field-from-fast article)) 1625 (id (spam-fetch-field-message-id-fast article)) 1626 sender-ignored) 1627 (when (stringp from) 1628 (dolist (ignore-regex spam-blacklist-ignored-regexes) 1629 (when (and (not sender-ignored) 1630 (stringp ignore-regex) 1631 (string-match ignore-regex from)) 1632 (setq sender-ignored t))) 1633 ;; remember the messages we need to unregister, unless remove is set 1634 (when (and 1635 (null unregister) 1636 (spam-log-unregistration-needed-p 1637 id 'process declassification de-symbol)) 1638 (push from unregister-list)) 1639 (unless sender-ignored 1640 (push from addresses))))) 1641 1642 (if unregister 1643 (funcall enter-function addresses t) ; unregister all these addresses 1644 ;; else, register normally and unregister what we need to 1645 (funcall remove-function unregister-list t) 1646 (dolist (article unregister-list) 1647 (spam-log-undo-registration 1648 (spam-fetch-field-message-id-fast article) 1649 'process 1650 declassification 1651 de-symbol)) 1652 (funcall enter-function addresses nil)))) 1653 1654(defun spam-blacklist-unregister-routine (articles) 1655 (spam-blacklist-register-routine articles t)) 1656 1657(defun spam-blacklist-register-routine (articles &optional unregister) 1658 (spam-filelist-register-routine articles t unregister)) 1659 1660(defun spam-whitelist-unregister-routine (articles) 1661 (spam-whitelist-register-routine articles t)) 1662 1663(defun spam-whitelist-register-routine (articles &optional unregister) 1664 (spam-filelist-register-routine articles nil unregister)) 1665 1666 1667;;;; Spam-report glue 1668(defun spam-report-gmane-register-routine (articles) 1669 (when articles 1670 (apply 'spam-report-gmane articles))) 1671 1672 1673;;;; Bogofilter 1674(defun spam-check-bogofilter-headers (&optional score) 1675 (let ((header (nnmail-fetch-field spam-bogofilter-header)) 1676 (spam-split-group (if spam-split-symbolic-return 1677 'spam 1678 spam-split-group))) 1679 (when header ; return nil when no header 1680 (if score ; scoring mode 1681 (if (string-match "spamicity=\\([0-9.]+\\)" header) 1682 (match-string 1 header) 1683 "0") 1684 ;; spam detection mode 1685 (when (string-match spam-bogofilter-bogosity-positive-spam-header 1686 header) 1687 spam-split-group))))) 1688 1689;; return something sensible if the score can't be determined 1690(defun spam-bogofilter-score () 1691 "Get the Bogofilter spamicity score" 1692 (interactive) 1693 (save-window-excursion 1694 (gnus-summary-show-article t) 1695 (set-buffer gnus-article-buffer) 1696 (let ((score (or (spam-check-bogofilter-headers t) 1697 (spam-check-bogofilter t)))) 1698 (message "Spamicity score %s" score) 1699 (or score "0")) 1700 (gnus-summary-show-article))) 1701 1702(defun spam-check-bogofilter (&optional score) 1703 "Check the Bogofilter backend for the classification of this message" 1704 (let ((article-buffer-name (buffer-name)) 1705 (db spam-bogofilter-database-directory) 1706 return) 1707 (with-temp-buffer 1708 (let ((temp-buffer-name (buffer-name))) 1709 (save-excursion 1710 (set-buffer article-buffer-name) 1711 (apply 'call-process-region 1712 (point-min) (point-max) 1713 spam-bogofilter-program 1714 nil temp-buffer-name nil 1715 (if db `("-d" ,db "-v") `("-v")))) 1716 (setq return (spam-check-bogofilter-headers score)))) 1717 return)) 1718 1719(defun spam-bogofilter-register-with-bogofilter (articles 1720 spam 1721 &optional unregister) 1722 "Register an article, given as a string, as spam or non-spam." 1723 (dolist (article articles) 1724 (let ((article-string (spam-get-article-as-string article)) 1725 (db spam-bogofilter-database-directory) 1726 (switch (if unregister 1727 (if spam 1728 spam-bogofilter-spam-strong-switch 1729 spam-bogofilter-ham-strong-switch) 1730 (if spam 1731 spam-bogofilter-spam-switch 1732 spam-bogofilter-ham-switch)))) 1733 (when (stringp article-string) 1734 (with-temp-buffer 1735 (insert article-string) 1736 1737 (apply 'call-process-region 1738 (point-min) (point-max) 1739 spam-bogofilter-program 1740 nil nil nil switch 1741 (if db `("-d" ,db "-v") `("-v")))))))) 1742 1743(defun spam-bogofilter-register-spam-routine (articles &optional unregister) 1744 (spam-bogofilter-register-with-bogofilter articles t unregister)) 1745 1746(defun spam-bogofilter-unregister-spam-routine (articles) 1747 (spam-bogofilter-register-spam-routine articles t)) 1748 1749(defun spam-bogofilter-register-ham-routine (articles &optional unregister) 1750 (spam-bogofilter-register-with-bogofilter articles nil unregister)) 1751 1752(defun spam-bogofilter-unregister-ham-routine (articles) 1753 (spam-bogofilter-register-ham-routine articles t)) 1754 1755 1756 1757;;;; spamoracle 1758(defun spam-check-spamoracle () 1759 "Run spamoracle on an article to determine whether it's spam." 1760 (let ((article-buffer-name (buffer-name)) 1761 (spam-split-group (if spam-split-symbolic-return 1762 'spam 1763 spam-split-group))) 1764 (with-temp-buffer 1765 (let ((temp-buffer-name (buffer-name))) 1766 (save-excursion 1767 (set-buffer article-buffer-name) 1768 (let ((status 1769 (apply 'call-process-region 1770 (point-min) (point-max) 1771 spam-spamoracle-binary 1772 nil temp-buffer-name nil 1773 (if spam-spamoracle-database 1774 `("-f" ,spam-spamoracle-database "mark") 1775 '("mark"))))) 1776 (if (eq 0 status) 1777 (progn 1778 (set-buffer temp-buffer-name) 1779 (goto-char (point-min)) 1780 (when (re-search-forward "^X-Spam: yes;" nil t) 1781 spam-split-group)) 1782 (error "Error running spamoracle: %s" status)))))))) 1783 1784(defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister) 1785 "Run spamoracle in training mode." 1786 (with-temp-buffer 1787 (let ((temp-buffer-name (buffer-name))) 1788 (save-excursion 1789 (goto-char (point-min)) 1790 (dolist (article articles) 1791 (insert (spam-get-article-as-string article))) 1792 (let* ((arg (if (spam-xor unregister article-is-spam-p) 1793 "-spam" 1794 "-good")) 1795 (status 1796 (apply 'call-process-region 1797 (point-min) (point-max) 1798 spam-spamoracle-binary 1799 nil temp-buffer-name nil 1800 (if spam-spamoracle-database 1801 `("-f" ,spam-spamoracle-database 1802 "add" ,arg) 1803 `("add" ,arg))))) 1804 (unless (eq 0 status) 1805 (error "Error running spamoracle: %s" status))))))) 1806 1807(defun spam-spamoracle-learn-ham (articles &optional unregister) 1808 (spam-spamoracle-learn articles nil unregister)) 1809 1810(defun spam-spamoracle-unlearn-ham (articles &optional unregister) 1811 (spam-spamoracle-learn-ham articles t)) 1812 1813(defun spam-spamoracle-learn-spam (articles &optional unregister) 1814 (spam-spamoracle-learn articles t unregister)) 1815 1816(defun spam-spamoracle-unlearn-spam (articles &optional unregister) 1817 (spam-spamoracle-learn-spam articles t)) 1818 1819 1820;;;; Hooks 1821 1822;;;###autoload 1823(defun spam-initialize () 1824 "Install the spam.el hooks and do other initialization" 1825 (interactive) 1826 (setq spam-install-hooks t) 1827 ;; TODO: How do we redo this every time the `spam' face is customized? 1828 (push '((eq mark gnus-spam-mark) . spam) 1829 gnus-summary-highlight) 1830 ;; Add hooks for loading and saving the spam stats 1831 (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) 1832 (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) 1833 (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load) 1834 (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) 1835 (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) 1836 (add-hook 'gnus-get-new-news-hook 'spam-setup-widening) 1837 (add-hook 'gnus-summary-prepare-hook 'spam-find-spam)) 1838 1839(defun spam-unload-hook () 1840 "Uninstall the spam.el hooks" 1841 (interactive) 1842 (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) 1843 (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) 1844 (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load) 1845 (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) 1846 (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) 1847 (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening) 1848 (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam)) 1849 1850(add-hook 'spam-unload-hook 'spam-unload-hook) 1851 1852(when spam-install-hooks 1853 (spam-initialize)) 1854 1855(provide 'spam) 1856 1857;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f 1858;;; spam.el ends here 1859