fix(3p/lisp/mime4cl): don't store redundant headers in MIME-MESSAGE
MIME-MESSAGE has a HEADERS slot which is an alist of all headers. Some of those headers will be parsed again and stored in MIME-PART (or a subclass of it). Having the header content stored in the HEADERS alist and in MIME-PART causes problems: - Requires extra knowledge about how messages are parsed when rendering messages. - Makes MIME= depend on the specific whitespace and quoting in those headers which isn't preserved by how mime4cl parses e.g. Content-Type. - Gives users two ways that slightly diverge to access the same thing. To avoid this, we remove these headers after the MIME-PARTs contained in MIME-MESSAGE have been initialized (since they reuse the HEADERS slot). Change-Id: I5b221f88bbac47dd81db369e3c1d5881a5a50e5e Reviewed-on: https://cl.tvl.fyi/c/depot/+/12858 Tested-by: BuildkiteCI Reviewed-by: sterni <sternenseemann@systemli.org> Autosubmit: sterni <sternenseemann@systemli.org>
This commit is contained in:
parent
db2fa5b3c8
commit
3398c2ab7f
2 changed files with 230 additions and 7 deletions
31
third_party/lisp/mime4cl/mime.lisp
vendored
31
third_party/lisp/mime4cl/mime.lisp
vendored
|
|
@ -67,6 +67,15 @@
|
|||
(:documentation
|
||||
"Abstract base class for all types of MIME parts."))
|
||||
|
||||
(defparameter +redundant-headers+ '(:mime-version
|
||||
:content-type
|
||||
:content-id
|
||||
:content-description
|
||||
:content-disposition
|
||||
:content-transfer-encoding)
|
||||
"Headers that don't need to be preserved in the HEADERS slot of MIME-MESSAGE
|
||||
because they are stored in dedicated slots in MIME-PART.")
|
||||
|
||||
(defclass mime-bodily-part (mime-part)
|
||||
((body
|
||||
:initarg :body
|
||||
|
|
@ -131,11 +140,20 @@
|
|||
;; Allow a list of mime parts to be specified as body of a
|
||||
;; mime-message. In that case we implicitly create a mime-multipart
|
||||
;; and assign to the body slot.
|
||||
(with-slots (real-message) part
|
||||
(with-slots (real-message headers) part
|
||||
(when (and (slot-boundp part 'real-message)
|
||||
(consp real-message))
|
||||
(setf real-message
|
||||
(make-instance 'mime-multipart :parts real-message)))))
|
||||
(make-instance 'mime-multipart :parts real-message)))
|
||||
;; Remove headers that are parsed and stored in MIME-PART (i.e.
|
||||
;; REAL-MESSAGE). This prevents redundant storage and rendering of these
|
||||
;; headers as well as MIME= depending on the specific rendering of these
|
||||
;; headers which may diverge between mime4cl and other software. We do this
|
||||
;; here since construction of REAL-MESSAGE may access the HEADERS slot.
|
||||
(setf headers
|
||||
(delete-if (lambda (h)
|
||||
(member (car h) +redundant-headers+ :test #'string-equal))
|
||||
headers))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
@ -471,15 +489,14 @@ separated by PART-BOUNDARY."
|
|||
(encode-mime-body part stream))
|
||||
|
||||
(defmethod encode-mime-part ((part mime-message) stream)
|
||||
;; tricky: we have to mix the MIME headers with the message headers
|
||||
;; tricky: we have to mix the MIME headers with the message headers, i.e.
|
||||
;; ENCODE-MIME-PART will output additional headers
|
||||
(dolist (h (mime-message-headers part))
|
||||
(unless (stringp (car h))
|
||||
(setf (car h)
|
||||
(string-capitalize (car h))))
|
||||
(unless (or (string-starts-with "content-" (car h) #'string-equal)
|
||||
(string-equal "mime-version" (car h)))
|
||||
(format stream "~A: ~A~%"
|
||||
(car h) (cdr h))))
|
||||
(format stream "~A: ~A~%"
|
||||
(car h) (cdr h)))
|
||||
(encode-mime-part (mime-body part) stream))
|
||||
|
||||
(defmethod encode-mime-part ((part mime-multipart) stream)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue