email: Handle unrecognized Content-Transfer-Encoding headers.

* email/email.scm (handle-invalid-headers): New function.
(parse-email-headers): Handle invalid headers.
* tests/email.scm ("Assume application/octet-stream Content-Type if
Content-Transfer-Encoding is unrecognized"): New test.

1 files changed, 15 insertions, 1 deletions

diff --git a/email/email.scm b/email/email.scm
index 277be88..7aea2d3 100644
--- a/email/email.scm
+++ b/email/email.scm
@@ -972,6 +972,19 @@ message. Else, return a single <mime-entity> record."
                          'content-transfer-encoding '#{7bit}#)
                  headers))
 
+(define (handle-invalid-headers headers)
+  ;; §6.4 of RFC2045 specifies that any entity with an unrecognized
+  ;; Content-Transfer-Encoding must be treated as if it has a
+  ;; Content-Type of "application/octet-stream", regardless of what
+  ;; the Content-Type header field actually says.
+  (if (memq (assq-ref headers 'content-transfer-encoding)
+            (list '7bit '8bit 'binary 'quoted-printable 'base64))
+      headers
+      (alist-combine headers
+                     '((content-type (type . application)
+                                     (subtype . octet-stream))
+                       (content-transfer-encoding . binary)))))
+
 (define (add-default-mime-entity-headers parent-headers headers)
   ;; Default Content-Type and Content-Transfer-Encoding headers as
   ;; specified in RFC2045 and RFC2046
@@ -1088,7 +1101,8 @@ list of header keys and values."
      (keywords . ,(lambda (_ value)
                     (cons 'keywords (string-split value #\,))))
      (fields . ,(lambda (_ . fields)
-                  (add-default-headers (post-process-fields fields))))
+                  (handle-invalid-headers
+                   (add-default-headers (post-process-fields fields)))))
      (*text* . ,(lambda (_ value) value))
      (*default* . ,(lambda tree tree)))))