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                   (let ((port (cond (arg => string->number)
  89                                     (else %default-repl-server-port))))
  90                     (if port
  91                         (alist-cons 'listen-repl port
  92                                     (alist-delete 'listen-repl result))
  93                         (error "invalid REPL server port" arg)))))
  94         (option '("disable-mailer") #f #f
  95                 (lambda (opt name arg result)
  96                   (alist-cons 'disable-mailer #t result)))
  97         (option '("sender") #t #f
  98                 (lambda (opt name arg result)
  99                   (alist-cons 'sender arg result)))
 100         (option '("smtp") #t #f
 101                 (lambda (opt name arg result)
 102                   (alist-cons 'smtp arg result)))))
 103
 104 (define %default-options
 105   ;; Alist of default option values
 106   `((listen-repl . #f)
 107     (smtp . #f)
 108     (sender . #f)
 109     (disable-mailer . #f)))
 110
 111 (define (parse-options args)
 112   (args-fold
 113    args %options
 114    (lambda (opt name arg result)
 115      (error "unrecognized option" name))
 116    (lambda (arg result)
 117      (error "extraneous argument" arg))
 118    %default-options))
 119
 120 (define (show-mumi-usage)
 121   (format (current-error-port)
 122           "
 123     `mumi web [--address=address] [--port=port] [--listen-repl[=port]] [--disable-mailer]':
 124          start the application web server.
 125
 126     `mumi mailer --sender=SENDER --smtp=SMTP:
 127          start a mailer process (requires Redis).
 128
 129     `mumi worker':
 130          run an update loop to refresh issue information from Debbugs.
 131
 132     `mumi fetch':
 133          index all Debbugs bug logs and update bug statuses once.
 134
 135 ~%")
 136   (exit 1))
 137
 138 (match (cdr (program-arguments))
 139   (("mailer" . rest)
 140    (let* ((opts (parse-options rest))
 141           (sender (assoc-ref opts 'sender))
 142           (smtp (assoc-ref opts 'smtp)))
 143      (if (and sender smtp)
 144          (worker-loop opts)
 145          (error "Both sender and smtp options must be provided!"))))
 146   (("fetch")
 147    (update-state! #:loop? #f))
 148   (("worker")
 149    (update-state! #:loop? #t))
 150   (("web" . rest)
 151    (let ((opts (parse-options rest)))
 152      (parameterize ((mailer-enabled? (not (assoc-ref opts 'disable-mailer))))
 153        (let ((repl-port (assoc-ref opts 'listen-repl)))
 154          (when repl-port
 155            (format (current-error-port)
 156                    "REPL server listening on port ~a~%"
 157                    repl-port)
 158            (spawn-server (make-tcp-server-socket #:port repl-port))))
 159        (start-mumi-web-server (or (assoc-ref opts 'address)
 160                                   "0.0.0.0")
 161                               (or (assoc-ref opts 'port)
 162                                   1234)))))
 163   (_ (show-mumi-usage)))