From af3acdecf5b17ad4c90926761dcb3a7a5a53c25e Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Tue, 4 Sep 2018 02:00:56 +0200
Subject: Add extract-attachment procedure.

* mumi/messages.scm (extract-attachment): New procedure.
---
 mumi/messages.scm | 35 ++++++++++++++++++++++++++++++++++-
 1 file changed, 34 insertions(+), 1 deletion(-)

diff --git a/mumi/messages.scm b/mumi/messages.scm
index 7a29739..b5a98a3 100644
--- a/mumi/messages.scm
+++ b/mumi/messages.scm
@@ -35,7 +35,9 @@
             recent-bugs
 
             split-multipart-message
-            multipart-message?))
+            multipart-message?
+            extract-attachment
+            qp-decoder))
 
 ;; TODO: mu-address-get-personal skips non ASCII characters
 ;; ex: (mu-address-get-personal "ludo@gnu.org (Ludovic Courtès)")
@@ -276,6 +278,37 @@ of message parts."
               ;; Invalid multipart message
               '()))))))
 
+(define* (extract-attachment id msg-num path)
+  "Extract attachment from message number MSG-NUM in the thread for
+the bug with the given ID.  Follow PATH to get to the correct
+multipart chunk containing the attachment.  This is absolutely
+horrible because Debbugs does not let us access messages directly, so
+we have to do this in a very convoluted way."
+  (define (nth n lst)
+    (and (< n (length lst))
+         (first (drop lst n))))
+  (define (traverse path parts)
+    (let loop ((path path)
+               (parts parts))
+      (match path
+        ((pos) (nth pos parts))
+        ((pos . rest)
+         (loop rest
+               (and=> (nth pos parts)
+                      (lambda (chunk)
+                        (cadr (find-tail (cut eq? #:body <>) chunk)))))))))
+  (and=> (fetch-bug id)
+         (lambda (bug)
+           (and=> (find (lambda (msg)
+                          (eq? (email-msg-num msg) msg-num))
+                        (patch-messages id))
+                  (lambda (msg)
+                    (and=> (multipart-message? msg)
+                           (lambda (attributes)
+                             (match (split-multipart-message attributes msg)
+                               (() #f)
+                               (parts (traverse path parts))))))))))
+
 
 (define-public (patch-messages id)
   "Return list of messages relating to the bug ID."
-- 
cgit v1.2.3