diff options
| author | Ricardo Wurmus <rekado@elephly.net> | 2019-07-21 12:14:00 +0200 |
|---|---|---|
| committer | Ricardo Wurmus <rekado@elephly.net> | 2019-07-21 13:11:39 +0200 |
| commit | caa127d37e9e682a461b0d628b58eb80e074c792 (patch) | |
| tree | 1825f8cf41169135c6b9b5966226d88c4750480b | |
| parent | 404e8e072c131e51c1ac4cec0889668d1d187d23 (diff) | |
scripts: Add support for "--fetch" option.
* scripts/mumi.in (%options): Recognize "fetch" option.
(%default-options): Set default for "fetch".
* mumi/config.scm.in (%config): Remove extraneous quotes from "lists"
and "packages".
| -rw-r--r-- | mumi/config.scm.in | 4 | ||||
| -rw-r--r-- | scripts/mumi.in | 48 |
2 files changed, 43 insertions, 9 deletions
diff --git a/mumi/config.scm.in b/mumi/config.scm.in index 4a0b69d..098e2e8 100644 --- a/mumi/config.scm.in +++ b/mumi/config.scm.in @@ -44,8 +44,8 @@ (port . 1234) (submission-email-address . "guix-patches@gnu.org") (submission-bug-email-address . "bug-guix@gnu.org") - (lists . '("guix-patches@gnu.org" "bug-guix@gnu.org")) - (packages . '("guix-patches" "guix")) + (lists . ("guix-patches@gnu.org" "bug-guix@gnu.org")) + (packages . ("guix-patches" "guix")) (debbugs . ,%gnu) (debbugs-domain . "debbugs.gnu.org")))) (lambda (key) diff --git a/scripts/mumi.in b/scripts/mumi.in index 1b1c5e5..2abfd51 100644 --- a/scripts/mumi.in +++ b/scripts/mumi.in @@ -3,7 +3,7 @@ -*- geiser-scheme-implementation: guile -*- !# ;;; mumi -- Mediocre, uh, mail interface -;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2016, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of mumi. @@ -22,9 +22,15 @@ ;;; along with mumi. If not, see <http://www.gnu.org/licenses/>. (use-modules (srfi srfi-1) + (srfi srfi-26) (srfi srfi-37) (system repl server) - (mumi web server)) + (ice-9 match) + (ice-9 threads) + (mumi config) + (mumi messages) + (mumi web server) + (debbugs)) (define %default-repl-server-port ;; Default port to run REPL server on, if --listen-repl is provided @@ -40,11 +46,15 @@ (if port (alist-cons 'listen-repl port (alist-delete 'listen-repl result)) - (error "invalid REPL server port" arg))))))) + (error "invalid REPL server port" arg))))) + (option '("fetch") #f #f + (lambda (opt name arg result) + (alist-cons 'fetch #t result))))) (define %default-options ;; Alist of default option values - `((listen-repl . #f))) + `((listen-repl . #f) + (fetch . #f))) (define (parse-options args) (args-fold @@ -56,8 +66,32 @@ %default-options)) (let ((opts (parse-options (cdr (program-arguments))))) - (let ((repl-port (assoc-ref opts 'listen-repl))) - (when repl-port - (spawn-server (make-tcp-server-socket #:port repl-port))))) + (cond + ((assoc-ref opts 'fetch) + (let ((bug-nums + (sort (append-map (lambda (package) + (soap-invoke (%config 'debbugs) + get-bugs + `((package . ,package)))) + (%config 'packages)) <))) + (for-each (lambda (bug-num i) + (let ((msg-nums + (match (soap-invoke (%config 'debbugs) + get-bug-message-numbers + bug-num) + ((nums . ids) nums)))) + (format (current-error-port) + "[~a/~a] Downloading ~a messages of bug ~a...~%" + i (length bug-nums) + (length msg-nums) bug-num) + (parameterize ((current-error-port (%make-void-port OPEN_WRITE))) + (par-for-each (cut download-message bug-num <>) + msg-nums)))) + bug-nums + (iota (length bug-nums) 1)))) + (else + (let ((repl-port (assoc-ref opts 'listen-repl))) + (when repl-port + (spawn-server (make-tcp-server-socket #:port repl-port))))))) (start-mumi-web-server 1234) |