X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-nocem.el;h=d678531dcc9233e3c7fd6a4ed30f41c8f4fe6518;hb=9954729d205c97242f0787c79dc23e7b051a6201;hp=15044a8371a3bfd9af11703b5db1f90509c0dee3;hpb=ee39f8f0b7ba9a8454cb8b9bc93e9bad001a1498;p=gnus diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el index 15044a837..d678531dc 100644 --- a/lisp/gnus-nocem.el +++ b/lisp/gnus-nocem.el @@ -1,7 +1,7 @@ ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment -;; Copyright (C) 1995,96 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -25,6 +25,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (require 'gnus) (require 'nnmail) (require 'gnus-art) @@ -35,26 +37,28 @@ "NoCeM pseudo-cancellation treatment" :group 'gnus-score) -(defcustom gnus-nocem-groups +(defcustom gnus-nocem-groups '("news.lists.filters" "news.admin.net-abuse.bulletins" "alt.nocem.misc" "news.admin.net-abuse.announce") - "List of groups that will be searched for NoCeM messages." + "*List of groups that will be searched for NoCeM messages." :group 'gnus-nocem :type '(repeat (string :tag "Group"))) -(defcustom gnus-nocem-issuers - '("AutoMoose-1" "Automoose-1" ; CancelMoose[tm] - "rbraver@ohww.norman.ok.us" ; Robert Braver - "clewis@ferret.ocunix.on.ca;" ; Chris Lewis - "jem@xpat.com;" ; Despammer from Korea - "snowhare@xmission.com" ; Benjamin "Snowhare" Franz - "red@redpoll.mrfs.oh.us (Richard E. Depew)" - ) - "List of NoCeM issuers to pay attention to." +(defcustom gnus-nocem-issuers + '("AutoMoose-1" "Automoose-1" ; CancelMoose[tm] + "rbraver@ohww.norman.ok.us" ; Robert Braver + "clewis@ferret.ocunix.on.ca" ; Chris Lewis + "jem@xpat.com" ; Despammer from Korea + "snowhare@xmission.com" ; Benjamin "Snowhare" Franz + "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; ARMM! ARMM! + ) + "*List of NoCeM issuers to pay attention to. + +This can also be a list of `(ISSUER CONDITIONS)' elements." :group 'gnus-nocem - :type '(repeat string)) + :type '(repeat (choice string sexp))) -(defcustom gnus-nocem-directory +(defcustom gnus-nocem-directory (nnheader-concat gnus-article-save-directory "NoCeM/") "*Directory where NoCeM files will be stored." :group 'gnus-nocem @@ -75,7 +79,7 @@ isn't bound, the message will be used unconditionally." (defcustom gnus-nocem-liberal-fetch nil "*If t try to fetch all messages which have @@NCM in the subject. -Otherwise don't fetch messages which have references or whose messsage-id +Otherwise don't fetch messages which have references or whose message-id matches an previously scanned and verified nocem message." :group 'gnus-nocem :type 'boolean) @@ -96,21 +100,40 @@ matches an previously scanned and verified nocem message." (defun gnus-nocem-cache-file () (concat (file-name-as-directory gnus-nocem-directory) "cache")) +;; +;; faster lookups for group names: +;; + +(defvar gnus-nocem-real-group-hashtb nil + "Real-name mappings of subscribed groups.") + +(defun gnus-fill-real-hashtb () + "Fill up a hash table with the real-name mappings from the user's active file." + (setq gnus-nocem-real-group-hashtb (gnus-make-hashtable + (length gnus-newsrc-alist))) + (mapcar (lambda (group) + (setq group (gnus-group-real-name (car group))) + (gnus-sethash group t gnus-nocem-real-group-hashtb)) + gnus-newsrc-alist)) + (defun gnus-nocem-scan-groups () "Scan all NoCeM groups for new NoCeM messages." (interactive) (let ((groups gnus-nocem-groups) + (gnus-inhibit-demon t) group active gactive articles) (gnus-make-directory gnus-nocem-directory) ;; Load any previous NoCeM headers. (gnus-nocem-load-cache) + ;; Get the group name mappings: + (gnus-fill-real-hashtb) ;; Read the active file if it hasn't been read yet. (and (file-exists-p (gnus-nocem-active-file)) (not gnus-nocem-active) (ignore-errors (load (gnus-nocem-active-file) t t t))) ;; Go through all groups and see whether new articles have - ;; arrived. + ;; arrived. (while (setq group (pop groups)) (if (not (setq gactive (gnus-activate-group group))) () ; This group doesn't exist. @@ -126,15 +149,15 @@ matches an previously scanned and verified nocem message." (nnheader-temp-write nil (setq headers (if (eq 'nov - (gnus-retrieve-headers + (gnus-retrieve-headers (setq articles (gnus-uncompress-range - (cons + (cons (if active (1+ (cdr active)) (car gactive)) (cdr gactive)))) group)) - (gnus-get-newsgroup-headers-xover + (gnus-get-newsgroup-headers-xover articles nil dependencies) (gnus-get-newsgroup-headers dependencies))) (while (setq header (pop headers)) @@ -145,7 +168,9 @@ matches an previously scanned and verified nocem message." ;; ignore scanning followups. (and (string-match "@@NCM" (mail-header-subject header)) (or gnus-nocem-liberal-fetch - (and (string= "" (mail-header-references header)) + (and (or (string= "" (mail-header-references + header)) + (null (mail-header-references header))) (not (member (mail-header-message-id header) gnus-nocem-seen-message-ids)))) (gnus-nocem-check-article group header))))))) @@ -163,9 +188,9 @@ matches an previously scanned and verified nocem message." (gnus-message 7 "Checking article %d in %s for NoCeM..." (mail-header-number header) group) (let ((date (mail-header-date header)) - issuer b e) + issuer b e type) (when (or (not date) - (nnmail-time-less + (nnmail-time-less (nnmail-time-since (nnmail-date-to-time date)) (nnmail-days-to-time gnus-nocem-expiry-wait))) (gnus-request-article-this-buffer (mail-header-number header) group) @@ -180,18 +205,42 @@ matches an previously scanned and verified nocem message." (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t))) ;; We get the name of the issuer. (narrow-to-region b e) - (setq issuer (mail-fetch-field "issuer")) + (setq issuer (mail-fetch-field "issuer") + type (mail-fetch-field "issuer")) (widen) - (and (member issuer gnus-nocem-issuers) ; We like her.... - (gnus-nocem-verify-issuer issuer) ; She is who she says she is... - (gnus-nocem-enter-article) ; We gobble the message.. - (push (mail-header-message-id header) ; But don't come back for - gnus-nocem-seen-message-ids)))))) ; second helpings. + (if (not (gnus-nocem-message-wanted-p issuer type)) + (message "invalid NoCeM issuer: %s" issuer) + (and (gnus-nocem-verify-issuer issuer) ; She is who she says she is. + (gnus-nocem-enter-article) ; We gobble the message. + (push (mail-header-message-id header) ; But don't come back for + gnus-nocem-seen-message-ids))))))) ; second helpings. + +(defun gnus-nocem-message-wanted-p (issuer type) + (let ((issuers gnus-nocem-issuers) + wanted conditions condition) + (cond + ;; Do the quick check first. + ((member issuer issuers) + t) + ((setq conditions (cdr (assoc issuer issuers))) + ;; Check whether we want this type. + (while (setq condition (pop conditions)) + (cond + ((stringp condition) + (setq wanted (string-match condition type))) + ((and (consp condition) + (eq (car condition) 'not) + (stringp (cadr condition))) + (setq wanted (not (string-match (cadr condition) type)))) + (t + (error "Invalid NoCeM condition: %S" condition)))) + wanted)))) (defun gnus-nocem-verify-issuer (person) "Verify using PGP that the canceler is who she says she is." (if (fboundp gnus-nocem-verifyer) - (funcall gnus-nocem-verifyer) + (ignore-errors + (funcall gnus-nocem-verifyer)) ;; If we don't have Mailcrypt, then we use the message anyway. t)) @@ -218,7 +267,8 @@ matches an previously scanned and verified nocem message." ;; Make sure all entries in the hashtb are bound. (set group nil)) (t - (when (gnus-gethash (symbol-name group) gnus-newsrc-hashtb) + (when (gnus-gethash (gnus-group-real-name (symbol-name group)) + gnus-nocem-real-group-hashtb) ;; Valid group. (beginning-of-line) (while (= (following-char) ?\t) @@ -240,13 +290,14 @@ matches an previously scanned and verified nocem message." (defun gnus-nocem-load-cache () "Load the NoCeM cache." + (interactive) (unless gnus-nocem-alist ;; The buffer doesn't exist, so we create it and load the NoCeM - ;; cache. + ;; cache. (when (file-exists-p (gnus-nocem-cache-file)) (load (gnus-nocem-cache-file) t t t) (gnus-nocem-alist-to-hashtb)))) - + (defun gnus-nocem-save-cache () "Save the NoCeM cache." (when (and gnus-nocem-alist @@ -288,11 +339,13 @@ matches an previously scanned and verified nocem message." gnus-nocem-hashtb nil gnus-nocem-active nil gnus-nocem-touched-alist nil - gnus-nocem-seen-message-ids nil)) + gnus-nocem-seen-message-ids nil + gnus-nocem-real-group-hashtb nil)) (defun gnus-nocem-unwanted-article-p (id) "Say whether article ID in the current group is wanted." - (gnus-gethash id gnus-nocem-hashtb)) + (and gnus-nocem-hashtb + (gnus-gethash id gnus-nocem-hashtb))) (provide 'gnus-nocem)