Changed runtime error reporting.
Showing
3 changed files
with
31 additions
and
20 deletions
... | @@ -49,7 +49,8 @@ | ... | @@ -49,7 +49,8 @@ |
49 | (lambda (val lim) | 49 | (lambda (val lim) |
50 | (< val lim))) | 50 | (< val lim))) |
51 | (else | 51 | (else |
52 | (runtime-error LOG_CRIT "test-numaddr: unknown comparator " | 52 | (runtime-message SIEVE-ERROR |
53 | "test-numaddr: unknown comparator " | ||
53 | comp))))) | 54 | comp))))) |
54 | (call-with-current-continuation | 55 | (call-with-current-continuation |
55 | (lambda (exit) | 56 | (lambda (exit) | ... | ... |
... | @@ -25,13 +25,13 @@ | ... | @@ -25,13 +25,13 @@ |
25 | 25 | ||
26 | (define (sent-from-me? msg) | 26 | (define (sent-from-me? msg) |
27 | (call-with-current-continuation | 27 | (call-with-current-continuation |
28 | (lambda (x) | 28 | (lambda (exit) |
29 | (for-each | 29 | (for-each |
30 | (lambda (hdr) | 30 | (lambda (hdr) |
31 | (if (and (string=? (car hdr) "X-Sender") | 31 | (if (and (string-ci=? (car hdr) "X-Sender") |
32 | (string=? (mu-address-get-email (cdr hdr)) | 32 | (string-ci=? (mu-address-get-email (cdr hdr)) |
33 | sieve-my-email)) | 33 | sieve-my-email)) |
34 | (x #t))) | 34 | (exit #t))) |
35 | (mu-message-get-header-fields sieve-current-message)) | 35 | (mu-message-get-header-fields sieve-current-message)) |
36 | #f))) | 36 | #f))) |
37 | 37 | ||
... | @@ -40,9 +40,10 @@ | ... | @@ -40,9 +40,10 @@ |
40 | (if sieve-my-email | 40 | (if sieve-my-email |
41 | (cond | 41 | (cond |
42 | ((sent-from-me? sieve-current-message) | 42 | ((sent-from-me? sieve-current-message) |
43 | (runtime-error LOG_ERR "redirect: Loop detected")) | 43 | (runtime-message SIEVE-WARNING "Redirection loop detected")) |
44 | (else | 44 | (else |
45 | (let ((out-msg (mu-message-copy sieve-current-message))) | 45 | (let ((out-msg (mu-message-copy sieve-current-message)) |
46 | (sender (mu-message-get-sender sieve-current-message))) | ||
46 | (mu-message-set-header out-msg "X-Sender" sieve-my-email) | 47 | (mu-message-set-header out-msg "X-Sender" sieve-my-email) |
47 | (mu-message-send out-msg #f sender address) | 48 | (mu-message-send out-msg #f sender address) |
48 | (mu-message-destroy out-msg)) | 49 | (mu-message-destroy out-msg)) | ... | ... |
... | @@ -27,6 +27,10 @@ | ... | @@ -27,6 +27,10 @@ |
27 | ;;; If #f, it will be set by sieve-main | 27 | ;;; If #f, it will be set by sieve-main |
28 | (define sieve-my-email #f) | 28 | (define sieve-my-email #f) |
29 | 29 | ||
30 | (define SIEVE-WARNING "Warning") | ||
31 | (define SIEVE-ERROR "Error") | ||
32 | (define SIEVE-NOTICE "Notice") | ||
33 | |||
30 | ;;; List of open mailboxes. | 34 | ;;; List of open mailboxes. |
31 | ;;; Each entry is: (list MAILBOX-NAME OPEN-FLAGS MBOX) | 35 | ;;; Each entry is: (list MAILBOX-NAME OPEN-FLAGS MBOX) |
32 | (define sieve-mailbox-list '()) | 36 | (define sieve-mailbox-list '()) |
... | @@ -227,7 +231,7 @@ | ... | @@ -227,7 +231,7 @@ |
227 | ((#:matches) | 231 | ((#:matches) |
228 | (if (regexp-exec rx addr) | 232 | (if (regexp-exec rx addr) |
229 | (exit #t)))) | 233 | (exit #t)))) |
230 | (runtime-error LOG_NOTICE | 234 | (runtime-message SIEVE-NOTICE |
231 | "Can't get address parts for message " | 235 | "Can't get address parts for message " |
232 | sieve-current-message)))))))) | 236 | sieve-current-message)))))))) |
233 | header-fields))) | 237 | header-fields))) |
... | @@ -244,7 +248,7 @@ | ... | @@ -244,7 +248,7 @@ |
244 | ((eq? (car comp) #:under) | 248 | ((eq? (car comp) #:under) |
245 | (< size key-size)) | 249 | (< size key-size)) |
246 | (else | 250 | (else |
247 | (runtime-error LOG_CRIT "test-size: unknown comparator " comp))))) | 251 | (runtime-message SIEVE-ERROR "test-size: unknown comparator " comp))))) |
248 | 252 | ||
249 | (define (test-envelope part-list key-list . opt-args) | 253 | (define (test-envelope part-list key-list . opt-args) |
250 | (let ((comp (find-comp opt-args)) | 254 | (let ((comp (find-comp opt-args)) |
... | @@ -262,8 +266,8 @@ | ... | @@ -262,8 +266,8 @@ |
262 | (exit #t))) | 266 | (exit #t))) |
263 | key-list))) | 267 | key-list))) |
264 | (else | 268 | (else |
265 | ;; Should we issue a warning? | 269 | (runtime-message SIEVE-ERROR |
266 | ;;(runtime-error LOG_ERR "Envelope part " part " not supported") | 270 | "Envelope part " part " not supported") |
267 | #f))) | 271 | #f))) |
268 | part-list) | 272 | part-list) |
269 | #f)))) | 273 | #f)))) |
... | @@ -348,15 +352,20 @@ | ... | @@ -348,15 +352,20 @@ |
348 | (sieve-register-test "false" #f '() '()) | 352 | (sieve-register-test "false" #f '() '()) |
349 | (sieve-register-test "true" #t '() '()))) | 353 | (sieve-register-test "true" #t '() '()))) |
350 | 354 | ||
351 | ;;; runtime-error | 355 | ;;; runtime-message |
352 | 356 | ||
353 | (define (runtime-error level . text) | 357 | (define (runtime-message level . text) |
354 | (display (string-append "RUNTIME ERROR in " sieve-source ": ")) | 358 | (let ((msg (apply string-append |
355 | (for-each | 359 | (map (lambda (x) |
356 | (lambda (s) | 360 | (format #f "~A" x)) |
357 | (display s)) | 361 | (append |
358 | text) | 362 | (list "(in " sieve-source ") ") |
359 | (newline)) | 363 | text))))) |
364 | (mu-message-set-header sieve-current-message | ||
365 | (string-append "X-Sieve-" level) | ||
366 | msg) | ||
367 | (if (isatty? (current-output-port)) | ||
368 | (display (string-append level ": " msg "\n"))))) | ||
360 | 369 | ||
361 | ;;; Sieve-main | 370 | ;;; Sieve-main |
362 | (define sieve-current-message #f) | 371 | (define sieve-current-message #f) | ... | ... |
-
Please register or sign in to post a comment