]> git.elephly.net Git - software/mumi.git/commitdiff
mumi: handle-download: Operate on mime-entity.
authorRicardo Wurmus <rekado@elephly.net>
Fri, 9 Nov 2018 21:14:54 +0000 (22:14 +0100)
committerRicardo Wurmus <rekado@elephly.net>
Fri, 9 Nov 2018 21:14:54 +0000 (22:14 +0100)
* mumi/web/download.scm (handle-download): Match on mime-entity
as returned by guile-email instead of custom data structure.

mumi/web/download.scm

index 9331b509aab33229a3b0270504daba5181a1622d..5aa6828064b35d8e1ddef9a50881f4c88ae7e2ec 100644 (file)
@@ -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))))