diff options
Diffstat (limited to 'third_party/lisp/mime4cl')
| -rw-r--r-- | third_party/lisp/mime4cl/default.nix | 1 | ||||
| -rw-r--r-- | third_party/lisp/mime4cl/endec.lisp | 18 | ||||
| -rw-r--r-- | third_party/lisp/mime4cl/mime.lisp | 14 | ||||
| -rw-r--r-- | third_party/lisp/mime4cl/package.lisp | 3 |
4 files changed, 34 insertions, 2 deletions
diff --git a/third_party/lisp/mime4cl/default.nix b/third_party/lisp/mime4cl/default.nix index a14d695c298e..9d3d6253f480 100644 --- a/third_party/lisp/mime4cl/default.nix +++ b/third_party/lisp/mime4cl/default.nix @@ -6,6 +6,7 @@ depot.nix.buildLisp.library { name = "mime4cl"; deps = [ + depot.third_party.lisp.babel depot.third_party.lisp.sclf depot.third_party.lisp.npg depot.third_party.lisp.trivial-gray-streams diff --git a/third_party/lisp/mime4cl/endec.lisp b/third_party/lisp/mime4cl/endec.lisp index 9f2f9c51c260..020c212e5ec4 100644 --- a/third_party/lisp/mime4cl/endec.lisp +++ b/third_party/lisp/mime4cl/endec.lisp @@ -644,7 +644,7 @@ method of RFC2047 and return a sequence of bytes." (vector-push-extend (char-code c) output-sequence))) finally (return output-sequence))) -(defun decode-RFC2047-string (encoding string &key (start 0) (end (length string))) +(defun decode-RFC2047-part (encoding string &key (start 0) (end (length string))) "Decode STRING according to RFC2047 and return a sequence of bytes." (gcase (encoding string-equal) @@ -674,10 +674,24 @@ sequence, a charset string indicating the original coding." (push (subseq text previous-end start) result)) (setf previous-end (+ end 2)) - (push (cons (decode-RFC2047-string encoding text :start (1+ second-?) :end end) + (push (cons (decode-RFC2047-part encoding text :start (1+ second-?) :end end) charset) result)) finally (unless (= previous-end (length text)) (push (subseq text previous-end (length text)) result)) (return (nreverse result)))) + +(defun decode-RFC2047 (text) + "Decode TEXT into a fully decoded string. Whenever a non ASCII part is + encountered, try to decode it using babel, otherwise signal an error." + (flet ((decode-part (part) + (etypecase part + (cons (babel:octets-to-string + (car part) + :encoding (babel-encodings:get-character-encoding + (intern (string-upcase (cdr part)) 'keyword)))) + (string part)))) + (apply #'concatenate + (cons 'string + (mapcar #'decode-part (mime:parse-RFC2047-text text)))))) diff --git a/third_party/lisp/mime4cl/mime.lisp b/third_party/lisp/mime4cl/mime.lisp index 1b1d98bfaf99..5639aab23641 100644 --- a/third_party/lisp/mime4cl/mime.lisp +++ b/third_party/lisp/mime4cl/mime.lisp @@ -622,6 +622,20 @@ found in STREAM." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun mime-message-header-values (name message &key decode) + "Return all values of the header with NAME in MESSAGE, optionally decoding + it according to RFC2047 if :DECODE is T." + (loop ;; A header may occur multiple times + for header in (mime-message-headers message) + ;; MIME Headers should be case insensitive + ;; https://stackoverflow.com/a/6143644 + when (string-equal (car header) name) + collect (if decode + (decode-RFC2047 (cdr header)) + (cdr header)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defvar *lazy-mime-decode* t "If true don't decode mime bodies in memory.") diff --git a/third_party/lisp/mime4cl/package.lisp b/third_party/lisp/mime4cl/package.lisp index b1217a0b6818..5586bdc390e5 100644 --- a/third_party/lisp/mime4cl/package.lisp +++ b/third_party/lisp/mime4cl/package.lisp @@ -30,6 +30,8 @@ #:process-wait #:process-alive-p #:run-program) + (:import-from :babel :octets-to-string) + (:import-from :babel-encodings :get-character-encoding) (:export #:*lazy-mime-decode* #:print-mime-part #:read-mime-message @@ -61,6 +63,7 @@ #:mime-type-string #:mime-type-parameters #:mime-message-headers + #:mime-message-header-values #:mime= #:find-mime-part-by-path #:find-mime-part-by-id |