Use sieve-mailbox-open instead of mu-mailbox-open. The former searches
the list of open mailboxes and returns one if found. All the mailboxes get closed at once when the sieve program finishes execution. This saves memory and speeds up the execution (fewer calls to gc, if any). sieve-regexp-to-posix: escape special characters. action-reject: Use ports instead of mu-body- interface.
Showing
1 changed file
with
48 additions
and
12 deletions
... | @@ -17,6 +17,37 @@ | ... | @@ -17,6 +17,37 @@ |
17 | 17 | ||
18 | ;;;; This module provides core functionality for the sieve scripts. | 18 | ;;;; This module provides core functionality for the sieve scripts. |
19 | 19 | ||
20 | ;;; List of open mailboxes. | ||
21 | ;;; Each entry is: (list MAILBOX-NAME OPEN-FLAGS MBOX) | ||
22 | (define sieve-mailbox-list '()) | ||
23 | |||
24 | ;;; Cached mailbox open: Lookup in the list first, if not found, | ||
25 | ;;; call mu-mailbox-open and append to the list. | ||
26 | ;;; NOTE: second element of each slot (OPEN-FLAGS) is not currently | ||
27 | ;;; used, sinse all the mailboxes are open with "cw". | ||
28 | (define (sieve-mailbox-open name flags) | ||
29 | (let ((slot (assoc name sieve-mailbox-list))) | ||
30 | (if slot | ||
31 | (list-ref slot 2) | ||
32 | (let ((mbox (mu-mailbox-open name flags))) | ||
33 | (if mbox | ||
34 | (set! sieve-mailbox-list (append | ||
35 | sieve-mailbox-list | ||
36 | (list | ||
37 | (list name flags mbox))))) | ||
38 | mbox)))) | ||
39 | |||
40 | ;;; Close all open mailboxes. | ||
41 | (define (sieve-close-mailboxes) | ||
42 | (for-each | ||
43 | (lambda (slot) | ||
44 | (cond | ||
45 | ((list-ref slot 2) | ||
46 | => (lambda (mbox) | ||
47 | (mu-mailbox-close mbox))))) | ||
48 | sieve-mailbox-list) | ||
49 | (set! sieve-mailbox-list '())) | ||
50 | |||
20 | ;;; Comparators | 51 | ;;; Comparators |
21 | (cond | 52 | (cond |
22 | (sieve-parser | 53 | (sieve-parser |
... | @@ -37,8 +68,8 @@ | ... | @@ -37,8 +68,8 @@ |
37 | 68 | ||
38 | (define (action-reject reason) | 69 | (define (action-reject reason) |
39 | (let* ((out-msg (mu-message-create)) | 70 | (let* ((out-msg (mu-message-create)) |
40 | (outbody (mu-message-get-body out-msg)) | 71 | (out-port (mu-message-get-port out-msg "w")) |
41 | (inbody (mu-message-get-body sieve-current-message))) | 72 | (in-port (mu-message-get-port sieve-current-message "r"))) |
42 | (mu-message-set-header out-msg "To" | 73 | (mu-message-set-header out-msg "To" |
43 | (mu-message-get-header sieve-current-message | 74 | (mu-message-get-header sieve-current-message |
44 | "From")) | 75 | "From")) |
... | @@ -49,22 +80,25 @@ | ... | @@ -49,22 +80,25 @@ |
49 | "Re: " | 80 | "Re: " |
50 | (mu-message-get-header sieve-current-message | 81 | (mu-message-get-header sieve-current-message |
51 | "Subject"))) | 82 | "Subject"))) |
52 | (mu-body-write outbody reason) | 83 | (display reason out-port) |
53 | 84 | ||
54 | (cond | 85 | (cond |
55 | (sieve-option-quote | 86 | (sieve-option-quote |
56 | (mu-body-write outbody "\n\nThe rejected message follows:\n") | 87 | (display "\n\nThe rejected message follows:\n" out-port) |
57 | (do ((hdr (mu-message-get-header-fields sieve-current-message) | 88 | (do ((hdr (mu-message-get-header-fields sieve-current-message) |
58 | (cdr hdr))) | 89 | (cdr hdr))) |
59 | ((null? hdr) #f) | 90 | ((null? hdr) #f) |
60 | (let ((s (car hdr))) | 91 | (let ((s (car hdr))) |
61 | (mu-body-write outbody (string-append | 92 | (display (string-append |
62 | sieve-indent-prefix | 93 | sieve-indent-prefix |
63 | (car s) ": " (cdr s) "\n")))) | 94 | (car s) ": " (cdr s) "\n") out-port))) |
64 | (mu-body-write outbody (string-append sieve-indent-prefix "\n")) | 95 | (display sieve-indent-prefix out-port) |
65 | (do ((line (mu-body-read-line inbody) (mu-body-read-line inbody))) | 96 | (newline out-port) |
97 | (do ((line (read-line in-port) (read-line in-port))) | ||
66 | ((eof-object? line) #f) | 98 | ((eof-object? line) #f) |
67 | (mu-body-write outbody (string-append sieve-indent-prefix line))))) | 99 | (display (string-append sieve-indent-prefix line "\n") out-port)))) |
100 | (close-input-port in-port) | ||
101 | (close-output-port out-port) | ||
68 | 102 | ||
69 | (mu-message-send out-msg)) | 103 | (mu-message-send out-msg)) |
70 | (mu-message-delete sieve-current-message)) | 104 | (mu-message-delete sieve-current-message)) |
... | @@ -72,11 +106,10 @@ | ... | @@ -72,11 +106,10 @@ |
72 | ;;; fileinto | 106 | ;;; fileinto |
73 | 107 | ||
74 | (define (action-fileinto filename) | 108 | (define (action-fileinto filename) |
75 | (let ((outbox (mu-mailbox-open filename "cw"))) | 109 | (let ((outbox (sieve-mailbox-open filename "cw"))) |
76 | (cond | 110 | (cond |
77 | (outbox | 111 | (outbox |
78 | (mu-mailbox-append-message outbox sieve-current-message) | 112 | (mu-mailbox-append-message outbox sieve-current-message) |
79 | (mu-mailbox-close outbox) | ||
80 | (mu-message-delete sieve-current-message))))) | 113 | (mu-message-delete sieve-current-message))))) |
81 | 114 | ||
82 | ;;; redirect is defined in redirect.scm | 115 | ;;; redirect is defined in redirect.scm |
... | @@ -170,6 +203,8 @@ | ... | @@ -170,6 +203,8 @@ |
170 | (set! cl (append (list #\.) cl))) | 203 | (set! cl (append (list #\.) cl))) |
171 | ((char=? ch #\*) | 204 | ((char=? ch #\*) |
172 | (set! cl (append (list #\* #\.) cl))) | 205 | (set! cl (append (list #\* #\.) cl))) |
206 | ((member ch (list #\. #\$ #\^ #\[ #\])) | ||
207 | (set! cl (append (list ch #\\) cl))) | ||
173 | (else | 208 | (else |
174 | (set! cl (append (list ch) cl)))))))) | 209 | (set! cl (append (list ch) cl)))))))) |
175 | 210 | ||
... | @@ -366,4 +401,5 @@ | ... | @@ -366,4 +401,5 @@ |
366 | (catch 'sieve-stop | 401 | (catch 'sieve-stop |
367 | sieve-process-message | 402 | sieve-process-message |
368 | (lambda args | 403 | (lambda args |
369 | #f))))) | 404 | #f))) |
405 | (sieve-close-mailboxes))) | ... | ... |
-
Please register or sign in to post a comment