1 #!@GUILE@ --no-auto-compile
3 -*- geiser-scheme-implementation: guile -*-
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>
9 ;;; This file is part of mumi.
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.
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.
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/>.
24 (use-modules (srfi srfi-1)
31 #:select (extract-bug-numbers))
33 #:select (db-create! update-bug-database!))
35 #:select (worker-loop))
37 #:select (start-mumi-web-server))
43 (define %default-repl-server-port
44 ;; Default port to run REPL server on, if --listen-repl is provided
45 ;; but no port is mentioned
48 ;; Keep indexing the mail directory
49 (define %update-interval 30)
53 (lambda* (#:key loop?)
54 (set! count (remainder (1+ count) 10))
58 (display "Starting full indexing." (current-error-port))
59 (newline (current-error-port)))
60 (index! #:full? (zero? count))
61 (let* ((packages (%config 'packages))
62 (nums (append (extract-bug-numbers packages)
63 (extract-bug-numbers packages #:archived? #t))))
64 (update-bug-database! nums))
67 (format (current-error-port)
68 "Sleeping for ~a seconds." %update-interval)
69 (sleep %update-interval)
72 (format (current-error-port) "worker error: ~a~%" args)
73 (sleep %update-interval)
77 ;; Specifications of the command-line options
78 (list (option '("listen-repl") #f #t
79 (lambda (opt name arg result)
80 (let ((port (cond (arg => string->number)
81 (else %default-repl-server-port))))
83 (alist-cons 'listen-repl port
84 (alist-delete 'listen-repl result))
85 (error "invalid REPL server port" arg)))))
86 (option '("disable-mailer") #f #f
87 (lambda (opt name arg result)
88 (alist-cons 'disable-mailer #t result)))
89 (option '("sender") #t #f
90 (lambda (opt name arg result)
91 (alist-cons 'sender arg result)))
92 (option '("smtp") #t #f
93 (lambda (opt name arg result)
94 (alist-cons 'smtp arg result)))))
96 (define %default-options
97 ;; Alist of default option values
101 (disable-mailer . #f)))
103 (define (parse-options args)
106 (lambda (opt name arg result)
107 (error "unrecognized option" name))
109 (error "extraneous argument" arg))
112 (define (show-mumi-usage)
113 (format (current-error-port)
115 `mumi web [--listen-repl[=port]] [--disable-mailer]':
116 start the application web server.
118 `mumi mailer --sender=SENDER --smtp=SMTP:
119 start a mailer process (requires Redis).
122 run an update loop to refresh issue information from Debbugs.
125 index all Debbugs bug logs and update bug statuses once.
130 (match (cdr (program-arguments))
132 (let* ((opts (parse-options rest))
133 (sender (assoc-ref opts 'sender))
134 (smtp (assoc-ref opts 'smtp)))
135 (if (and sender smtp)
137 (error "Both sender and smtp options must be provided!"))))
139 (update-state! #:loop? #f))
141 (update-state! #:loop? #t))
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)))
147 (spawn-server (make-tcp-server-socket #:port repl-port))))
148 (start-mumi-web-server 1234))))
149 (_ (show-mumi-usage)))