#!@GUILE@ --no-auto-compile -*- scheme -*- -*- geiser-scheme-implementation: guile -*- !# ;;; mumi -- Mediocre, uh, mail interface ;;; Copyright © 2016, 2017, 2019, 2020 Ricardo Wurmus ;;; Copyright © 2018, 2021 Arun Isaac ;;; ;;; This file is part of mumi. ;;; ;;; mumi is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or ;;; (at your option) any later version. ;;; ;;; mumi is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with mumi. If not, see . (use-modules (srfi srfi-1) (srfi srfi-37) (system repl server) (ice-9 match) (ice-9 format) (mumi config) ((mumi debbugs) #:select (extract-bug-numbers)) ((mumi jobs) #:select (worker-loop)) ((mumi web server) #:select (start-mumi-web-server)) ((mumi xapian) #:select (index!))) (define %default-repl-server-port ;; Default port to run REPL server on, if --listen-repl is provided ;; but no port is mentioned 37146) ;; Keep indexing the mail directory (define %update-interval 30) (define update-state! (let ((count -1)) (lambda* (#:key loop?) (set! count (remainder (1+ count) 10)) (catch #t (lambda () (when (zero? count) (display "Starting full indexing." (current-error-port)) (newline (current-error-port))) (index! #:full? (zero? count)) (and loop? (begin (format (current-error-port) "Sleeping for ~a seconds." %update-interval) (sleep %update-interval) (update-state!)))) (lambda args (format (current-error-port) "worker error: ~a~%" args) (sleep %update-interval) (update-state!)))))) (define %options ;; Specifications of the command-line options (list (option '("listen-repl") #f #t (lambda (opt name arg result) (let ((port (cond (arg => string->number) (else %default-repl-server-port)))) (if port (alist-cons 'listen-repl port (alist-delete 'listen-repl result)) (error "invalid REPL server port" arg))))) (option '("disable-mailer") #f #f (lambda (opt name arg result) (alist-cons 'disable-mailer #t result))) (option '("sender") #t #f (lambda (opt name arg result) (alist-cons 'sender arg result))) (option '("smtp") #t #f (lambda (opt name arg result) (alist-cons 'smtp arg result))))) (define %default-options ;; Alist of default option values `((listen-repl . #f) (smtp . #f) (sender . #f) (disable-mailer . #f))) (define (parse-options args) (args-fold args %options (lambda (opt name arg result) (error "unrecognized option" name)) (lambda (arg result) (error "extraneous argument" arg)) %default-options)) (define (show-mumi-usage) (format (current-error-port) " `mumi web [--listen-repl[=port]] [--disable-mailer]': start the application web server. `mumi mailer --sender=SENDER --smtp=SMTP: start a mailer process (requires Redis). `mumi worker': run an update loop to refresh issue information from Debbugs. `mumi fetch': index all Debbugs bug logs and update bug statuses once. ~%") (exit 1)) (match (cdr (program-arguments)) (("mailer" . rest) (let* ((opts (parse-options rest)) (sender (assoc-ref opts 'sender)) (smtp (assoc-ref opts 'smtp))) (if (and sender smtp) (worker-loop opts) (error "Both sender and smtp options must be provided!")))) (("fetch") (update-state! #:loop? #f)) (("worker") (update-state! #:loop? #t)) (("web" . rest) (let ((opts (parse-options rest))) (parameterize ((mailer-enabled? (not (assoc-ref opts 'disable-mailer)))) (let ((repl-port (assoc-ref opts 'listen-repl))) (when repl-port (format (current-error-port) "REPL server listening on port ~a~%" repl-port) (spawn-server (make-tcp-server-socket #:port repl-port)))) (start-mumi-web-server 1234)))) (_ (show-mumi-usage)))