Commit e22d65b6 e22d65b67c0beedf9b1b778211a9a19d4154355f by Sergey Poznyakoff

Implements "numaddr" extension test. The test counts Internet addresses

in structured headers that contain addresses.  It returns true if the
total number of addresses satisfies the requested relation, e.g.:

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