messages: Add download-mbox.

1 files changed, 35 insertions, 0 deletions

diff --git a/mumi/messages.scm b/mumi/messages.scm
index a1b8805..a93bd2b 100644
--- a/mumi/messages.scm
+++ b/mumi/messages.scm
@@ -184,6 +184,41 @@ symbol 'email)."
                           '()))))
     (http-get uri #:streaming? #t #:headers headers)))
 
+(define* (download-mbox bug-id)
+  "Download the mbox of bug BUG-ID and store it in the mail directory
+if it's not already there.  If the file already exists only download
+the difference by providing the current file size as an offset."
+  (let* ((file-name (bug-id->mbox-file bug-id))
+         (offset (and (file-exists? file-name)
+                      (stat:size (stat file-name))))
+         (mtime  (and (file-exists? file-name)
+                      (stat:mtime (stat file-name)))))
+    (format (current-error-port)
+            "downloading ~a~%" file-name)
+    (call-with-values
+        (lambda ()
+          (fetch-mbox* (%config 'debbugs)
+                       bug-id
+                       ;; TODO: This doesn't work when
+                       ;; using Guile's web client, but
+                       ;; it works with wget.  #:offset
+                       ;; offset
+                       #:mdate
+                       (and mtime
+                            (time-monotonic->date
+                             (make-time time-monotonic 0 mtime)))))
+      (lambda (response port)
+        (if port
+            (begin
+              ;; TODO: append when using offset
+              (with-output-to-file file-name
+                (lambda ()
+                  (put-bytevector (current-output-port)
+                                  (get-bytevector-all port))))
+              (close-port port)
+              file-name)
+            #f)))))
+
 
 ;; We would like to use get-bug-log here, but it often returns
 ;; truncated messages.  This is a known bug upstream.