Commit b58fdbd2 b58fdbd2c02489a4a2ea45d0ee45fa2c4afca96a by Sergey Poznyakoff

Changed runtime error reporting.

1 parent 0351fffa
...@@ -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)
......