scripts: Remove "fetch" command.
[software/mumi.git] / scripts / mumi.in
1 #!@GUILE@ --no-auto-compile
2 -*- scheme -*-
3 -*- geiser-scheme-implementation: guile -*-
4 !#
5 ;;; mumi -- Mediocre, uh, mail interface
6 ;;; Copyright © 2016, 2017, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
7 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
8 ;;;
9 ;;; This file is part of mumi.
10 ;;;
11 ;;; mumi is free software; you can redistribute it and/or modify it
12 ;;; under the terms of the GNU General Public License as published by
13 ;;; the Free Software Foundation; either version 3 of the License, or
14 ;;; (at your option) any later version.
15 ;;;
16 ;;; mumi is distributed in the hope that it will be useful, but
17 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;;; General Public License for more details.
20 ;;;
21 ;;; You should have received a copy of the GNU General Public License
22 ;;; along with mumi. If not, see <http://www.gnu.org/licenses/>.
23
24 (use-modules (srfi srfi-1)
25 (srfi srfi-26)
26 (srfi srfi-37)
27 (system repl server)
28 (ice-9 match)
29 (ice-9 threads)
30 (ice-9 format)
31 (mumi config)
32 (mumi bugs)
33 (mumi jobs)
34 (mumi messages)
35 (mumi web server)
36 (debbugs))
37
38 (db-create!)
39
40 (define %default-repl-server-port
41 ;; Default port to run REPL server on, if --listen-repl is provided
42 ;; but no port is mentioned
43 37146)
44
45 ;; Keep indexing the mail directory
46 (define %update-interval 60)
47 (define mu-index
48 (let ((mu (%config 'mu-executable)))
49 (lambda _
50 (let* ((maildir (%config 'mail-dir))
51 (args (list "index"
52 "--quiet"
53 (format #f "--muhome=~a" maildir)
54 (format #f "--maildir=~a" maildir))))
55 (unless (zero? (apply system* mu args))
56 (format (current-error-port)
57 "Failed to index `~a'~%" (%config 'mail-dir)))))))
58
59 (define (fetch-messages!)
60 (let ((bug-nums
61 (sort (append-map (lambda (package)
62 (soap-invoke* (%config 'debbugs)
63 get-bugs
64 `((package . ,package))))
65 (%config 'packages)) <)))
66 (for-each (lambda (bug-num i)
67 (let ((msg-nums
68 (match (soap-invoke* (%config 'debbugs)
69 get-bug-message-numbers
70 bug-num)
71 ((nums . ids) nums))))
72 (format (current-error-port)
73 "[~a/~a] Refreshing ~a messages of bug ~a...~%"
74 i (length bug-nums)
75 (length msg-nums) bug-num)
76 (parameterize ((current-error-port (%make-void-port OPEN_WRITE)))
77 (par-for-each (cut download-message bug-num <>)
78 msg-nums))))
79 (reverse bug-nums)
80 (iota (length bug-nums) 1))))
81
82 (define update-state!
83 (lambda _
84 (catch #t
85 (lambda ()
86 (fetch-messages!)
87 (mu-index)
88 (update-bug-database!)
89 (sleep %update-interval)
90 (update-state!))
91 (lambda args
92 (format (current-error-port) "worker error: ~a~%" args)
93 (sleep %update-interval)
94 (update-state!)))))
95
96 (define %options
97 ;; Specifications of the command-line options
98 (list (option '("listen-repl") #f #t
99 (lambda (opt name arg result)
100 (let ((port (cond (arg => string->number)
101 (else %default-repl-server-port))))
102 (if port
103 (alist-cons 'listen-repl port
104 (alist-delete 'listen-repl result))
105 (error "invalid REPL server port" arg)))))
106 (option '("disable-mailer") #f #f
107 (lambda (opt name arg result)
108 (alist-cons 'disable-mailer #t result)))
109 (option '("sender") #t #f
110 (lambda (opt name arg result)
111 (alist-cons 'sender arg result)))
112 (option '("smtp") #t #f
113 (lambda (opt name arg result)
114 (alist-cons 'smtp arg result)))))
115
116 (define %default-options
117 ;; Alist of default option values
118 `((listen-repl . #f)
119 (smtp . #f)
120 (sender . #f)
121 (disable-mailer . #f)))
122
123 (define (parse-options args)
124 (args-fold
125 args %options
126 (lambda (opt name arg result)
127 (error "unrecognized option" name))
128 (lambda (arg result)
129 (error "extraneous argument" arg))
130 %default-options))
131
132 (match (cdr (program-arguments))
133 (("mailer" . rest)
134 (let* ((opts (parse-options rest))
135 (sender (assoc-ref opts 'sender))
136 (smtp (assoc-ref opts 'smtp)))
137 (if (and sender smtp)
138 (worker-loop opts)
139 (error "Both sender and smtp options must be provided!"))))
140 (("worker")
141 (update-state!))
142 (("web" . rest)
143 (let ((opts (parse-options rest)))
144 (parameterize ((mailer-enabled? (not (assoc-ref opts 'disable-mailer))))
145 (let ((repl-port (assoc-ref opts 'listen-repl)))
146 (when repl-port
147 (spawn-server (make-tcp-server-socket #:port repl-port))))
148 (use-modules (mumimu))
149 (mu-index)
150 (mu:initialize (%config 'mail-dir))
151 (start-mumi-web-server 1234)))))