aboutsummaryrefslogtreecommitdiff
path: root/email/email.scm
diff options
context:
space:
mode:
Diffstat (limited to 'email/email.scm')
-rw-r--r--email/email.scm51
1 files changed, 34 insertions, 17 deletions
diff --git a/email/email.scm b/email/email.scm
index a791a0e..666bd3e 100644
--- a/email/email.scm
+++ b/email/email.scm
@@ -643,28 +643,45 @@ values. The returned headers is a string and body is a bytevector."
(define (post-process-content-transfer-encoding _ value)
(list 'content-transfer-encoding (string->lcase-symbol value)))
-(define post-process-content-type
- (match-lambda*
+(define (post-process-content-type . args)
+ (define (valid-charset? charset)
+ (catch #t
+ (lambda ()
+ (bytevector->string (make-bytevector 0 0) charset)
+ #t)
+ (const #f)))
+
+ (match args
(`(content (type ,type)
(subtype ,subtype)
. ,parameters)
(let ((type (string->lcase-symbol type))
- (subtype (string->lcase-symbol subtype)))
+ (subtype (string->lcase-symbol subtype))
+ (parameters
+ (map (match-lambda
+ (`(parameter (attribute ,attribute)
+ (value ,value))
+ (cons (string->lcase-symbol attribute) value)))
+ (flatten-and-filter '(parameter) parameters))))
`(content-type
- ,(acons* 'type type
- 'subtype subtype
- (let ((parameters
- (map (match-lambda
- (`(parameter (attribute ,attribute)
- (value ,value))
- (cons (string->lcase-symbol attribute) value)))
- (flatten-and-filter '(parameter) parameters))))
- ;; RFC6657 specifies UTF-8 as the default charset
- ;; for text/* media types.
- (if (and (eq? type 'text)
- (not (assoc-ref parameters 'charset)))
- (acons 'charset "utf-8" parameters)
- parameters))))))))
+ ,(acons*
+ 'type type
+ 'subtype subtype
+ (cond
+ ((and (eq? type 'text)
+ (or
+ ;; RFC6657 specifies UTF-8 as the default charset for
+ ;; text/* media types.
+ (not (assoc-ref parameters 'charset))
+ ;; RFC2045 recommends that the default be assumed
+ ;; when a syntactically invalid Content-Type header
+ ;; is encountered. In this implementation, we are
+ ;; only checking for the validity of the
+ ;; charset. Should we check for the validity of the
+ ;; entire Content-Type header? If so, how?
+ (not (valid-charset? (assoc-ref parameters 'charset)))))
+ (acons 'charset "utf-8" parameters))
+ (else parameters))))))))
(define post-process-content-disposition
(match-lambda*