aboutsummaryrefslogtreecommitdiff
path: root/email
diff options
context:
space:
mode:
authorArun Isaac2021-10-24 02:46:01 +0530
committerArun Isaac2021-10-24 02:52:06 +0530
commit86f0af337b3d4c8afc075c09a1aae4b1694d9ebd (patch)
tree1053281f2930d857c63ec4f24e18bb8f5dca8cdb /email
parent4ff159505d35202861d09859859c98997bf55bcd (diff)
downloadguile-email-86f0af337b3d4c8afc075c09a1aae4b1694d9ebd.tar.gz
guile-email-86f0af337b3d4c8afc075c09a1aae4b1694d9ebd.tar.lz
guile-email-86f0af337b3d4c8afc075c09a1aae4b1694d9ebd.zip
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.
Diffstat (limited to 'email')
-rw-r--r--email/email.scm16
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)))))