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; }
Showing
1 changed file
with
72 additions
and
0 deletions
guimb/scm/numaddr.scm
0 → 100644
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))) |
-
Please register or sign in to post a comment