diff options
-rw-r--r-- | mumi/web/download.scm | 50 |
1 files changed, 25 insertions, 25 deletions
diff --git a/mumi/web/download.scm b/mumi/web/download.scm index 9331b50..5aa6828 100644 --- a/mumi/web/download.scm +++ b/mumi/web/download.scm @@ -18,6 +18,7 @@ (define-module (mumi web download) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) + #:use-module (email email) #:use-module (debbugs base64) #:use-module (ice-9 iconv) #:use-module (ice-9 match) @@ -33,31 +34,30 @@ MSG-NUM, in the possibly nested message part identified by the list PATH." (or (and=> (extract-attachment id msg-num path) (match-lambda - ((#:headers headers #:body body) - (list (filter-map (match-lambda - (("content-type" vals) - (list 'content-type - (string->symbol vals))) - (("content-disposition" vals) - (let ((name (or (and=> (string-match "filename=([^ ;]+)" vals) - (lambda (m) - (match:substring m 1))) - "attachment"))) + ((? mime-entity? entry) + (let ((headers (mime-entity-headers entry)) + (body (mime-entity-body entry))) + (list (filter-map (match-lambda + (('content-type . vals) + (list 'content-type + (or (assoc-ref vals 'type) 'text))) + (('content-disposition . vals) (list 'content-disposition - 'attachment - `(filename . ,name)))) - (_ #f)) - headers) - ;; Try to decode the attachment - (or (and=> (assoc-ref headers "content-transfer-encoding") - (match-lambda - (("base64") - (string-join (map (compose (cut bytevector->string <> "UTF-8") base64-decode) - (string-split body #\newline)) "\n")) - (("quoted-printable") - (with-input-from-string body - (lambda () (qp-decoder (current-input-port))))) - (_ #f))) - body))) + (assoc-ref vals 'type) + `(filename . ,(or (assoc-ref vals 'filename) + "attachment")))) + (_ #f)) + headers) + ;; Try to decode the attachment + (or (and=> (assoc-ref headers 'content-transfer-encoding) + (match-lambda + (('base64) + (string-join (map (compose (cut bytevector->string <> "UTF-8") base64-decode) + (string-split body #\newline)) "\n")) + (('quoted-printable) + (with-input-from-string body + (lambda () (qp-decoder (current-input-port))))) + (_ #f))) + body)))) (_ #f))) (apply render-html (unknown id)))) |