numaddr.scm
2.5 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
;;;; GNU Mailutils -- a suite of utilities for electronic mail
;;;; Copyright (C) 1999-2001, 2007, 2010-2012, 2014 Free Software
;;;; Foundation, Inc.
;;;;
;;;; GNU Mailutils is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 3, or (at your option)
;;;; any later version.
;;;;
;;;; GNU Mailutils is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License along
;;;; with GNU Mailutils. If not, see <http://www.gnu.org/licenses/>.
;;;; This module provides GNU extension test "numaddr".
;;;; Syntax: numaddr [":over" / ":under"] <header-names: string-list>
;;;; <limit: number>
;;;; The "numaddr" test counts Internet addresses in structured headers
;;;; that contain addresses. It returns true if the total number of
;;;; addresses satisfies the requested relation:
;;;;
;;;; If the argument is ":over" and the number of addresses is greater than
;;;; the number provided, the test is true; otherwise, it is false.
;;;;
;;;; If the argument is ":under" and the number of addresses is less than
;;;; the number provided, the test is true; otherwise, it is false.
;;;;
;;;; If the argument is empty, ":over" is assumed.
;;;; Example:
;;;;
;;;; require [ "numaddr" ];
;;;; if numaddr :over [ "To", "Cc" ] 50 { discard; }
(define (test-numaddr header-list count . comp)
(let ((total-count 0)
(header-fields (mu-message-get-header-fields
sieve-current-message
header-list))
(compfun (cond
((or (null? (car comp)) (eq? (car comp) #:over))
(lambda (val lim)
(> val lim)))
((eq? (car comp) #:under)
(lambda (val lim)
(< val lim)))
(else
(runtime-message SIEVE-ERROR
"test-numaddr: unknown comparator "
comp)))))
(call-with-current-continuation
(lambda (exit)
(for-each
(lambda (h)
(let ((hdr (cdr h)))
(if hdr
(let ((naddr (mu-address-get-count hdr)))
(set! total-count (+ total-count naddr))
(if (compfun total-count count)
(exit #t))))))
header-fields)
#f))))
;;; Register the test at compile time
(if sieve-parser
(sieve-register-test "numaddr"
test-numaddr
(list 'string-list 'number)
size-comp))