Commit b58fdbd2 b58fdbd2c02489a4a2ea45d0ee45fa2c4afca96a by Sergey Poznyakoff

Changed runtime error reporting.

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