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-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 bugs)
  33               #:select (db-create! update-bug-database!))
  34              ((mumi jobs)
  35               #:select (worker-loop))
  36              ((mumi web server)
  37               #:select (start-mumi-web-server))
  38              ((mumi xapian)
  39               #:select (index!)))
  40
  41 (db-create!)
  42
  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
  46   37146)
  47
  48 ;; Keep indexing the mail directory
  49 (define %update-interval 30)
  50
  51 (define update-state!
  52   (let ((count -1))
  53     (lambda* (#:key loop?)
  54       (set! count (remainder (1+ count) 10))
  55       (catch #t
  56         (lambda ()
  57           (when (zero? count)
  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))
  65           (and loop?
  66                (begin
  67                  (format (current-error-port)
  68                          "Sleeping for ~a seconds." %update-interval)
  69                  (sleep %update-interval)
  70                  (update-state!))))
  71         (lambda args
  72           (format (current-error-port) "worker error: ~a~%" args)
  73           (sleep %update-interval)
  74           (update-state!))))))
  75
  76 (define %options
  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))))
  82                     (if 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)))))
  95
  96 (define %default-options
  97   ;; Alist of default option values
  98   `((listen-repl . #f)
  99     (smtp . #f)
 100     (sender . #f)
 101     (disable-mailer . #f)))
 102
 103 (define (parse-options args)
 104   (args-fold
 105    args %options
 106    (lambda (opt name arg result)
 107      (error "unrecognized option" name))
 108    (lambda (arg result)
 109      (error "extraneous argument" arg))
 110    %default-options))
 111
 112 (define (show-mumi-usage)
 113   (format (current-error-port)
 114           "
 115     `mumi web [--listen-repl[=port]] [--disable-mailer]':
 116          start the application web server.
 117
 118     `mumi mailer --sender=SENDER --smtp=SMTP:
 119          start a mailer process (requires Redis).
 120
 121     `mumi worker':
 122          run an update loop to refresh issue information from Debbugs.
 123
 124     `mumi fetch':
 125          index all Debbugs bug logs and update bug statuses once.
 126
 127 ~%")
 128   (exit 1))
 129
 130 (match (cdr (program-arguments))
 131   (("mailer" . rest)
 132    (let* ((opts (parse-options rest))
 133           (sender (assoc-ref opts 'sender))
 134           (smtp (assoc-ref opts 'smtp)))
 135      (if (and sender smtp)
 136          (worker-loop opts)
 137          (error "Both sender and smtp options must be provided!"))))
 138   (("fetch")
 139    (update-state! #:loop? #f))
 140   (("worker")
 141    (update-state! #:loop? #t))
 142   (("web" . rest)
 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)))
 146          (when repl-port
 147            (spawn-server (make-tcp-server-socket #:port repl-port))))
 148        (start-mumi-web-server 1234))))
 149   (_ (show-mumi-usage)))