diff options
-rw-r--r-- | guimb/scm/numaddr.scm | 3 | ||||
-rw-r--r-- | guimb/scm/redirect.scm | 13 | ||||
-rw-r--r-- | guimb/scm/sieve-core.scm | 35 |
3 files changed, 31 insertions, 20 deletions
diff --git a/guimb/scm/numaddr.scm b/guimb/scm/numaddr.scm index 841e198ad..352bb55cd 100644 --- a/guimb/scm/numaddr.scm +++ b/guimb/scm/numaddr.scm @@ -49,7 +49,8 @@ (lambda (val lim) (< val lim))) (else - (runtime-error LOG_CRIT "test-numaddr: unknown comparator " + (runtime-message SIEVE-ERROR + "test-numaddr: unknown comparator " comp))))) (call-with-current-continuation (lambda (exit) diff --git a/guimb/scm/redirect.scm b/guimb/scm/redirect.scm index 719a514c8..e0a63a8e2 100644 --- a/guimb/scm/redirect.scm +++ b/guimb/scm/redirect.scm @@ -25,13 +25,13 @@ (define (sent-from-me? msg) (call-with-current-continuation - (lambda (x) + (lambda (exit) (for-each (lambda (hdr) - (if (and (string=? (car hdr) "X-Sender") - (string=? (mu-address-get-email (cdr hdr)) + (if (and (string-ci=? (car hdr) "X-Sender") + (string-ci=? (mu-address-get-email (cdr hdr)) sieve-my-email)) - (x #t))) + (exit #t))) (mu-message-get-header-fields sieve-current-message)) #f))) @@ -40,9 +40,10 @@ (if sieve-my-email (cond ((sent-from-me? sieve-current-message) - (runtime-error LOG_ERR "redirect: Loop detected")) + (runtime-message SIEVE-WARNING "Redirection loop detected")) (else - (let ((out-msg (mu-message-copy sieve-current-message))) + (let ((out-msg (mu-message-copy sieve-current-message)) + (sender (mu-message-get-sender sieve-current-message))) (mu-message-set-header out-msg "X-Sender" sieve-my-email) (mu-message-send out-msg #f sender address) (mu-message-destroy out-msg)) diff --git a/guimb/scm/sieve-core.scm b/guimb/scm/sieve-core.scm index e54cbf730..67c849fb2 100644 --- a/guimb/scm/sieve-core.scm +++ b/guimb/scm/sieve-core.scm @@ -27,6 +27,10 @@ ;;; If #f, it will be set by sieve-main (define sieve-my-email #f) +(define SIEVE-WARNING "Warning") +(define SIEVE-ERROR "Error") +(define SIEVE-NOTICE "Notice") + ;;; List of open mailboxes. ;;; Each entry is: (list MAILBOX-NAME OPEN-FLAGS MBOX) (define sieve-mailbox-list '()) @@ -227,7 +231,7 @@ ((#:matches) (if (regexp-exec rx addr) (exit #t)))) - (runtime-error LOG_NOTICE + (runtime-message SIEVE-NOTICE "Can't get address parts for message " sieve-current-message)))))))) header-fields))) @@ -244,7 +248,7 @@ ((eq? (car comp) #:under) (< size key-size)) (else - (runtime-error LOG_CRIT "test-size: unknown comparator " comp))))) + (runtime-message SIEVE-ERROR "test-size: unknown comparator " comp))))) (define (test-envelope part-list key-list . opt-args) (let ((comp (find-comp opt-args)) @@ -262,8 +266,8 @@ (exit #t))) key-list))) (else - ;; Should we issue a warning? - ;;(runtime-error LOG_ERR "Envelope part " part " not supported") + (runtime-message SIEVE-ERROR + "Envelope part " part " not supported") #f))) part-list) #f)))) @@ -348,15 +352,20 @@ (sieve-register-test "false" #f '() '()) (sieve-register-test "true" #t '() '()))) -;;; runtime-error - -(define (runtime-error level . text) - (display (string-append "RUNTIME ERROR in " sieve-source ": ")) - (for-each - (lambda (s) - (display s)) - text) - (newline)) +;;; runtime-message + +(define (runtime-message level . text) + (let ((msg (apply string-append + (map (lambda (x) + (format #f "~A" x)) + (append + (list "(in " sieve-source ") ") + text))))) + (mu-message-set-header sieve-current-message + (string-append "X-Sieve-" level) + msg) + (if (isatty? (current-output-port)) + (display (string-append level ": " msg "\n"))))) ;;; Sieve-main (define sieve-current-message #f) |