]> git.elephly.net Git - software/mumi.git/blob - scripts/mumi.in
controller: Do not hash msgid term twice.
[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, 2021 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-37)
26 (system repl server)
27 (ice-9 match)
28 (ice-9 format)
29 (mumi config)
30 ((mumi debbugs)
31 #:select (extract-bug-numbers))
32 ((mumi jobs)
33 #:select (worker-loop))
34 ((mumi web server)
35 #:select (start-mumi-web-server))
36 ((mumi xapian)
37 #:select (index!)))
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 30)
46
47 (define update-state!
48 (let ((count -1))
49 (lambda* (#:key loop?)
50 (set! count (remainder (1+ count) 10))
51 (catch #t
52 (lambda ()
53 (when (zero? count)
54 (display "Starting full indexing." (current-error-port))
55 (newline (current-error-port)))
56 (index! #:full? (zero? count))
57 (and loop?
58 (begin
59 (format (current-error-port)
60 "Sleeping for ~a seconds." %update-interval)
61 (sleep %update-interval)
62 (update-state!))))
63 (lambda args
64 (format (current-error-port) "worker error: ~a~%" args)
65 (sleep %update-interval)
66 (update-state!))))))
67
68 (define %options
69 ;; Specifications of the command-line options
70 (list (option '("address") #t #f
71 (lambda (opt name arg result)
72 (catch #t
73 (lambda ()
74 (inet-pton AF_INET arg))
75 (lambda _
76 (error "invalid web server address" arg)))
77 (alist-cons 'address arg
78 (alist-delete 'address result))))
79 (option '("port") #t #f
80 (lambda (opt name arg result)
81 (let ((port (string->number arg)))
82 (if port
83 (alist-cons 'port port
84 (alist-delete 'port result))
85 (error "invalid web server port" arg)))))
86 (option '("listen-repl") #f #t
87 (lambda (opt name arg result)
88 (alist-cons 'listen-repl (or (string->number arg) arg)
89 (alist-delete 'listen-repl result))))
90 (option '("disable-mailer") #f #f
91 (lambda (opt name arg result)
92 (alist-cons 'disable-mailer #t result)))
93 (option '("sender") #t #f
94 (lambda (opt name arg result)
95 (alist-cons 'sender arg result)))
96 (option '("smtp") #t #f
97 (lambda (opt name arg result)
98 (alist-cons 'smtp arg result)))))
99
100 (define %default-options
101 ;; Alist of default option values
102 `((listen-repl . #f)
103 (smtp . #f)
104 (sender . #f)
105 (disable-mailer . #f)))
106
107 (define (parse-options args)
108 (args-fold
109 args %options
110 (lambda (opt name arg result)
111 (error "unrecognized option" name))
112 (lambda (arg result)
113 (error "extraneous argument" arg))
114 %default-options))
115
116 (define (show-mumi-usage)
117 (format (current-error-port)
118 "
119 `mumi web [--address=address] [--port=port] [--listen-repl[=port]] [--disable-mailer]':
120 start the application web server.
121
122 `mumi mailer --sender=SENDER --smtp=SMTP:
123 start a mailer process (requires Redis).
124
125 `mumi worker':
126 run an update loop to refresh issue information from Debbugs.
127
128 `mumi fetch':
129 index all Debbugs bug logs and update bug statuses once.
130
131 ~%")
132 (exit 1))
133
134 (match (cdr (program-arguments))
135 (("mailer" . rest)
136 (let* ((opts (parse-options rest))
137 (sender (assoc-ref opts 'sender))
138 (smtp (assoc-ref opts 'smtp)))
139 (if (and sender smtp)
140 (worker-loop opts)
141 (error "Both sender and smtp options must be provided!"))))
142 (("fetch")
143 (update-state! #:loop? #f))
144 (("worker")
145 (update-state! #:loop? #t))
146 (("web" . rest)
147 (let ((opts (parse-options rest)))
148 (parameterize ((mailer-enabled? (not (assoc-ref opts 'disable-mailer))))
149 (let ((listen-repl (assoc-ref opts 'listen-repl)))
150 (when listen-repl
151 (cond
152 ((number? listen-repl)
153 (format (current-error-port)
154 "REPL server listening on port ~a~%"
155 listen-repl)
156 (spawn-server (make-tcp-server-socket #:port listen-repl)))
157 (else
158 (format (current-error-port)
159 "REPL server listening on ~a~%"
160 listen-repl)
161 (spawn-server (make-unix-domain-server-socket #:path listen-repl))))))
162 (start-mumi-web-server (or (assoc-ref opts 'address)
163 "0.0.0.0")
164 (or (assoc-ref opts 'port)
165 1234)))))
166 (_ (show-mumi-usage)))