Mercurial > emacs

comparison lisp/gnus/gnus-nocem.el @ 88155:d7ddb3e565de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 54348dbd8b9c
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment 1 ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment
2 2
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
4 5
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Keywords: news 7 ;; Keywords: news
7 8
8 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details. 19 ;; GNU General Public License for more details.
19 20
20 ;; You should have received a copy of the GNU General Public License 21 ;; 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 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02110-1301, USA.
24 25
25 ;;; Commentary: 26 ;;; Commentary:
26 27
27 ;;; Code: 28 ;;; Code:
28 29
33 (require 'gnus-art) 34 (require 'gnus-art)
34 (require 'gnus-sum) 35 (require 'gnus-sum)
35 (require 'gnus-range) 36 (require 'gnus-range)
36 37
37 (defgroup gnus-nocem nil 38 (defgroup gnus-nocem nil
38 "NoCeM pseudo-cancellation treatment" 39 "NoCeM pseudo-cancellation treatment."
39 :group 'gnus-score) 40 :group 'gnus-score)
40 41
41 (defcustom gnus-nocem-groups 42 (defcustom gnus-nocem-groups
42 '("news.lists.filters" "news.admin.net-abuse.bulletins" 43 '("news.lists.filters" "news.admin.net-abuse.bulletins"
43 "alt.nocem.misc" "news.admin.net-abuse.announce") 44 "alt.nocem.misc" "news.admin.net-abuse.announce")
56 This can also be a list of `(ISSUER CONDITION ...)' elements. 57 This can also be a list of `(ISSUER CONDITION ...)' elements.
57 58
58 See <URL:http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html> for an 59 See <URL:http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html> for an
59 issuer registry." 60 issuer registry."
60 :group 'gnus-nocem 61 :group 'gnus-nocem
62 :link '(url-link "http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html")
61 :type '(repeat (choice string sexp))) 63 :type '(repeat (choice string sexp)))
62 64
63 (defcustom gnus-nocem-directory 65 (defcustom gnus-nocem-directory
64 (nnheader-concat gnus-article-save-directory "NoCeM/") 66 (nnheader-concat gnus-article-save-directory "NoCeM/")
65 "*Directory where NoCeM files will be stored." 67 "*Directory where NoCeM files will be stored."
69 (defcustom gnus-nocem-expiry-wait 15 71 (defcustom gnus-nocem-expiry-wait 15
70 "*Number of days to keep NoCeM headers in the cache." 72 "*Number of days to keep NoCeM headers in the cache."
71 :group 'gnus-nocem 73 :group 'gnus-nocem
72 :type 'integer) 74 :type 'integer)
73 75
74 (defcustom gnus-nocem-verifyer 'mc-verify 76 (defcustom gnus-nocem-verifyer 'pgg-verify
75 "*Function called to verify that the NoCeM message is valid. 77 "*Function called to verify that the NoCeM message is valid.
76 One likely value is `mc-verify'. If the function in this variable 78 One likely value is `pgg-verify'. If the function in this variable
77 isn't bound, the message will be used unconditionally." 79 isn't bound, the message will be used unconditionally."
78 :group 'gnus-nocem 80 :group 'gnus-nocem
79 :type '(radio (function-item mc-verify) 81 :type '(radio (function-item pgg-verify)
82 (function-item mc-verify)
80 (function :tag "other"))) 83 (function :tag "other")))
81 84
82 (defcustom gnus-nocem-liberal-fetch nil 85 (defcustom gnus-nocem-liberal-fetch nil
83 "*If t try to fetch all messages which have @@NCM in the subject. 86 "*If t try to fetch all messages which have @@NCM in the subject.
84 Otherwise don't fetch messages which have references or whose message-id 87 Otherwise don't fetch messages which have references or whose message-id
241 (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t)) 244 (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t))
242 (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t))) 245 (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t)))
243 ;; We get the name of the issuer. 246 ;; We get the name of the issuer.
244 (narrow-to-region b e) 247 (narrow-to-region b e)
245 (setq issuer (mail-fetch-field "issuer") 248 (setq issuer (mail-fetch-field "issuer")
246 type (mail-fetch-field "issuer")) 249 type (mail-fetch-field "type"))
247 (widen) 250 (widen)
248 (if (not (gnus-nocem-message-wanted-p issuer type)) 251 (if (not (gnus-nocem-message-wanted-p issuer type))
249 (message "invalid NoCeM issuer: %s" issuer) 252 (message "invalid NoCeM issuer: %s" issuer)
250 (and (gnus-nocem-verify-issuer issuer) ; She is who she says she is. 253 (and (gnus-nocem-verify-issuer issuer) ; She is who she says she is.
251 (gnus-nocem-enter-article) ; We gobble the message. 254 (gnus-nocem-enter-article) ; We gobble the message.
262 ((setq conditions (cdr (assoc issuer issuers))) 265 ((setq conditions (cdr (assoc issuer issuers)))
263 ;; Check whether we want this type. 266 ;; Check whether we want this type.
264 (while (setq condition (pop conditions)) 267 (while (setq condition (pop conditions))
265 (cond 268 (cond
266 ((stringp condition) 269 ((stringp condition)
267 (setq wanted (string-match condition type))) 270 (when (string-match condition type)
271 (setq wanted t)))
268 ((and (consp condition) 272 ((and (consp condition)
269 (eq (car condition) 'not) 273 (eq (car condition) 'not)
270 (stringp (cadr condition))) 274 (stringp (cadr condition)))
271 (setq wanted (not (string-match (cadr condition) type)))) 275 (when (string-match (cadr condition) type)
276 (setq wanted nil)))
272 (t 277 (t
273 (error "Invalid NoCeM condition: %S" condition)))) 278 (error "Invalid NoCeM condition: %S" condition))))
274 wanted)))) 279 wanted))))
275 280
276 (defun gnus-nocem-verify-issuer (person) 281 (defun gnus-nocem-verify-issuer (person)
277 "Verify using PGP that the canceler is who she says she is." 282 "Verify using PGP that the canceler is who she says she is."
278 (if (fboundp gnus-nocem-verifyer) 283 (if (functionp gnus-nocem-verifyer)
279 (ignore-errors 284 (ignore-errors
280 (funcall gnus-nocem-verifyer)) 285 (funcall gnus-nocem-verifyer))
281 ;; If we don't have Mailcrypt, then we use the message anyway. 286 ;; If we don't have Mailcrypt, then we use the message anyway.
282 t)) 287 t))
283 288
292 (narrow-to-region b (1+ (match-beginning 0))) 297 (narrow-to-region b (1+ (match-beginning 0)))
293 (goto-char (point-min)) 298 (goto-char (point-min))
294 (while (search-forward "\t" nil t) 299 (while (search-forward "\t" nil t)
295 (cond 300 (cond
296 ((not (ignore-errors 301 ((not (ignore-errors
297 (setq group (let ((obarray gnus-active-hashtb)) (read buf))))) 302 (setq group (let ((obarray gnus-nocem-real-group-hashtb))
303 (read buf)))))
298 ;; An error. 304 ;; An error.
299 ) 305 )
300 ((not (symbolp group)) 306 ((not (symbolp group))
301 ;; Ignore invalid entries. 307 ;; Ignore invalid entries.
302 ) 308 )
309 ;; Valid group. 315 ;; Valid group.
310 (beginning-of-line) 316 (beginning-of-line)
311 (while (eq (char-after) ?\t) 317 (while (eq (char-after) ?\t)
312 (forward-line -1)) 318 (forward-line -1))
313 (setq id (buffer-substring (point) (1- (search-forward "\t")))) 319 (setq id (buffer-substring (point) (1- (search-forward "\t"))))
314 (unless (gnus-gethash id gnus-nocem-hashtb) 320 (unless (if gnus-nocem-hashtb
321 (gnus-gethash id gnus-nocem-hashtb)
322 (setq gnus-nocem-hashtb (gnus-make-hashtable))
323 nil)
315 ;; only store if not already present 324 ;; only store if not already present
316 (gnus-sethash id t gnus-nocem-hashtb) 325 (gnus-sethash id t gnus-nocem-hashtb)
317 (push id ncm)) 326 (push id ncm))
318 (forward-line 1) 327 (forward-line 1)
319 (while (eq (char-after) ?\t) 328 (while (eq (char-after) ?\t)
384 (and gnus-nocem-hashtb 393 (and gnus-nocem-hashtb
385 (gnus-gethash id gnus-nocem-hashtb))) 394 (gnus-gethash id gnus-nocem-hashtb)))
386 395
387 (provide 'gnus-nocem) 396 (provide 'gnus-nocem)
388 397
398 ;;; arch-tag: 0e0c74ea-2f8e-4f3e-8fff-09f767c1adef
389 ;;; gnus-nocem.el ends here 399 ;;; gnus-nocem.el ends here