Don't let mime decoding errors crash imail.

diff --git a/src/imail/imail-mime.scm b/src/imail/imail-mime.scm
index 58369c9c9f4bef5045b5eaac3411301e9e492daf..2bf590ed541528e9d68d6eb94444ed0c7acfaff2 100644 (file)
--- a/src/imail/imail-mime.scm
+++ b/src/imail/imail-mime.scm
@@ -563,7 +563,9 @@ USA.
            (lambda (output-port)
              (call-with-mime-decoding-output-port encoding output-port #t
                (lambda (output-port)
-                 (write-substring string start end output-port)))))))))
+                 (with-mime-best-effort
+                  (lambda ()
+                    (write-substring string start end output-port)))))))))))
 
 (define (mime:get-boundary parameters)
   (let ((parameter (assq 'BOUNDARY parameters)))
@@ -783,7 +785,7 @@ USA.
                         decode:initialize decode:finalize decode:update
                         make-port call-with-port))
   name)
-
+\f
 (define (define-identity-mime-encoding name)
   (hash-table/put! mime-encodings
                    name
@@ -822,6 +824,15 @@ USA.
                                    'CALL-WITH-MIME-DECODING-OUTPUT-PORT)
           encoding)))
    port text? generator))
+
+(define (with-mime-best-effort thunk)
+  (call-with-current-continuation
+   (lambda (exit)
+     (bind-condition-handler (list condition-type:decode-mime)
+         (lambda (condition)
+           condition
+           (exit unspecific))
+       thunk))))
 \f
 (define-identity-mime-encoding '7BIT)
 (define-identity-mime-encoding '8BIT)

diff --git a/src/imail/imail-top.scm b/src/imail/imail-top.scm
index 5941c8ca51243b4eebfb0d826de722b96e4db8f5..b5f20d655ab437484ba4fdb6d59ce1e1ae6f14ab 100644 (file)
--- a/src/imail/imail-top.scm
+++ b/src/imail/imail-top.scm
@@ -1109,7 +1109,9 @@ With prefix argument, prompt even when point is on an attachment."
              port
              text?
              (lambda (port)
-               (write-mime-body body port)))))))))
+               (with-mime-best-effort
+                (lambda ()
+                  (write-mime-body body port)))))))))))
 
 (define (filter-mime-attachment-filename filename)
   (let ((filename
@@ -2563,7 +2565,9 @@ WARNING: With a prefix argument, this command may take a very long
       port
       #t
       (lambda (port)
-       (write-mime-body body port))))))
+       (with-mime-best-effort
+        (lambda ()
+          (write-mime-body body port))))))))
 
 (define-method insert-mime-body-inline*
     (entity (body <mime-body-message>) selector context mark)