Revert "scripts: update-state!: Do a full refresh every 100 times."
[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 format)
30 (mumi config)
31 (mumi bugs)
32 (mumi jobs)
33 (mumi messages)
34 (mumi web server)
35 (debbugs))
36
37 (db-create!)
38
39 (define %default-repl-server-port
40 ;; Default port to run REPL server on, if --listen-repl is provided
41 ;; but no port is mentioned
42 37146)
43
44 ;; Keep indexing the mail directory
45 (define %update-interval 60)
46 (define mu-index
47 (let ((mu (%config 'mu-executable)))
48 (lambda _
49 (let* ((maildir (%config 'mail-dir))
50 (args (list "index"
51 "--quiet"
52 (format #f "--muhome=~a" maildir)
53 (format #f "--maildir=~a" maildir))))
54 (unless (zero? (apply system* mu args))
55 (format (current-error-port)
56 "Failed to index `~a'~%" (%config 'mail-dir)))))))
57
58 (define update-state!
59 (lambda _
60 (catch #t
61 (lambda ()
62 (let ((nums (sort (append-map (lambda (package)
63 (soap-invoke* (%config 'debbugs)
64 get-bugs
65 `((package . ,package))))
66 (%config 'packages)) >)))
67 (update-mboxes! nums)
68 (mu-index)
69 (update-bug-database! nums))
70 (format (current-error-port)
71 "Sleeping for ~a seconds." %update-interval)
72 (sleep %update-interval)
73 (update-state!))
74 (lambda args
75 (format (current-error-port) "worker error: ~a~%" args)
76 (sleep %update-interval)
77 (update-state!)))))
78
79 (define %options
80 ;; Specifications of the command-line options
81 (list (option '("listen-repl") #f #t
82 (lambda (opt name arg result)
83 (let ((port (cond (arg => string->number)
84 (else %default-repl-server-port))))
85 (if port
86 (alist-cons 'listen-repl port
87 (alist-delete 'listen-repl result))
88 (error "invalid REPL server port" arg)))))
89 (option '("disable-mailer") #f #f
90 (lambda (opt name arg result)
91 (alist-cons 'disable-mailer #t result)))
92 (option '("sender") #t #f
93 (lambda (opt name arg result)
94 (alist-cons 'sender arg result)))
95 (option '("smtp") #t #f
96 (lambda (opt name arg result)
97 (alist-cons 'smtp arg result)))))
98
99 (define %default-options
100 ;; Alist of default option values
101 `((listen-repl . #f)
102 (smtp . #f)
103 (sender . #f)
104 (disable-mailer . #f)))
105
106 (define (parse-options args)
107 (args-fold
108 args %options
109 (lambda (opt name arg result)
110 (error "unrecognized option" name))
111 (lambda (arg result)
112 (error "extraneous argument" arg))
113 %default-options))
114
115 (match (cdr (program-arguments))
116 (("mailer" . rest)
117 (let* ((opts (parse-options rest))
118 (sender (assoc-ref opts 'sender))
119 (smtp (assoc-ref opts 'smtp)))
120 (if (and sender smtp)
121 (worker-loop opts)
122 (error "Both sender and smtp options must be provided!"))))
123 (("fetch")
124 (let ((nums (sort
125 (append-map (lambda (package)
126 (soap-invoke*
127 (%config 'debbugs)
128 get-bugs
129 `((package . ,package)
130 (archive . both))))
131 (%config 'packages)) >)))
132 (update-mboxes! nums)
133 (mu-index)
134 (update-bug-database! nums)))
135 (("worker")
136 (update-state!))
137 (("web" . rest)
138 (let ((opts (parse-options rest)))
139 (parameterize ((mailer-enabled? (not (assoc-ref opts 'disable-mailer))))
140 (let ((repl-port (assoc-ref opts 'listen-repl)))
141 (when repl-port
142 (spawn-server (make-tcp-server-socket #:port repl-port))))
143 (use-modules (mumimu))
144 (mu-index)
145 (mu:initialize (%config 'mail-dir))
146 (start-mumi-web-server 1234)))))