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)))