diff options
| author | Ricardo Wurmus <rekado@elephly.net> | 2019-07-21 12:12:11 +0200 |
|---|---|---|
| committer | Ricardo Wurmus <rekado@elephly.net> | 2019-07-21 13:11:39 +0200 |
| commit | 404e8e072c131e51c1ac4cec0889668d1d187d23 (patch) | |
| tree | b5ca4c620b50f878bf8eba0d9f29c89fd1fbd186 | |
| parent | f06f49c55a17e76a6e09e2bb9d2492bb2213aab4 (diff) | |
messages: Add download-message.
* mumi/config.scm.in (%config): Add mail-dir.
* mumi/messages.scm (download-message): New procedure.
| -rw-r--r-- | mumi/config.scm.in | 10 | ||||
| -rw-r--r-- | mumi/messages.scm | 28 |
2 files changed, 38 insertions, 0 deletions
diff --git a/mumi/config.scm.in b/mumi/config.scm.in index b122f39..4a0b69d 100644 --- a/mumi/config.scm.in +++ b/mumi/config.scm.in @@ -30,6 +30,16 @@ maybe-dir ;; TODO: use @assetsdir@ variable here "@prefix@/share/mumi/assets"))) + (mail-dir . ,(let ((maybe-dir + (string-append (getcwd) "/mails"))) + (if (and (getenv "MUMI_UNINSTALLED") + (file-exists? maybe-dir)) + maybe-dir + (let ((dir "@localstatedir@/mumi/mails")) + (if (string-prefix? "${prefix}" dir) + (string-replace dir "@prefix@" + 0 (string-length "${prefix}")) + dir))))) (host . "localhost") (port . 1234) (submission-email-address . "guix-patches@gnu.org") diff --git a/mumi/messages.scm b/mumi/messages.scm index 6a70114..34ab02f 100644 --- a/mumi/messages.scm +++ b/mumi/messages.scm @@ -24,6 +24,7 @@ #:use-module (ice-9 regex) #:use-module (ice-9 match) #:use-module (ice-9 textual-ports) + #:use-module (ice-9 binary-ports) #:use-module (debbugs cache) #:use-module (debbugs soap) #:use-module (debbugs operations) @@ -35,6 +36,8 @@ recent-bugs bugs-by-severity + download-message + multipart-message? extract-attachment)) @@ -145,6 +148,31 @@ we have to do this in a very convoluted way." (_ #f))))))))) +(define (download-message bug-id msg-num) + "Download message number MSG-NUM of bug BUG-ID and store it in the +mail directory if it's not already there. Return the name of the +target file." + (let ((key (list 'download-message bug-id msg-num))) + (or (cached? key) + (cache! key + (let ((file-name (format #f "~a/cur/~a-~a" + (%config 'mail-dir) + bug-id msg-num))) + (if (file-exists? file-name) file-name + (begin + (format (current-error-port) + "downloading ~a~%" file-name) + (call-with-values + (lambda () + (fetch-mbox (%config 'debbugs) + bug-id msg-num #:streaming? #t)) + (lambda (response port) + (with-output-to-file file-name + (lambda () + (put-bytevector (current-output-port) + (get-bytevector-all port)))))) + file-name))))))) + (define-public (patch-messages id) "Return list of messages relating to the bug ID." ;; TODO: sort by date necessary? |