From 86f0af337b3d4c8afc075c09a1aae4b1694d9ebd Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Sun, 24 Oct 2021 02:46:01 +0530
Subject: 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.
---
 email/email.scm | 16 +++++++++++++++-
 tests/email.scm | 10 ++++++++++
 2 files changed, 25 insertions(+), 1 deletion(-)

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)))))
 
diff --git a/tests/email.scm b/tests/email.scm
index 52f38b6..50625f1 100644
--- a/tests/email.scm
+++ b/tests/email.scm
@@ -523,6 +523,16 @@ Received: from zzz ([1.2.3.5]) by ooo.ooo.com  with Maccrosoft SMTPSVC(5.5.1877.
                   (charset . "utf-8"))
     (content-transfer-encoding . 7bit)))
 
+;; See §6.4 in RFC2045.
+(test-alist= "Assume application/octet-stream Content-Type if Content-Transfer-Encoding is unrecognized"
+  (parse-email-headers
+   "Content-Transfer-Encoding: some-unrecognized-encoding
+Content-Type: text/plain; charset=utf-8
+")
+  `((content-type (type . application)
+                  (subtype . octet-stream))
+    (content-transfer-encoding . binary)))
+
 
 ;;;
 ;;; Email addresses
-- 
cgit v1.2.3