#!@GUILE@ --no-auto-compile -*- scheme -*- -*- geiser-scheme-implementation: guile -*- !# ;;; mumi -- Mediocre, uh, mail interface ;;; Copyright © 2016, 2017, 2019, 2020 Ricardo Wurmus ;;; Copyright © 2018 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-26) (srfi srfi-37) (system repl server) (ice-9 match) (ice-9 format) (mumi config) (mumi bugs) (mumi jobs) (mumi messages) (mumi web server) (debbugs)) (db-create!) (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 60) (define mu-index (let ((mu (%config 'mu-executable))) (lambda _ (let* ((maildir (%config 'mail-dir)) (args (list "index" "--quiet" (format #f "--muhome=~a" maildir) (format #f "--maildir=~a" maildir)))) (unless (zero? (apply system* mu args)) (format (current-error-port) "Failed to index `~a'~%" (%config 'mail-dir))))))) (define update-state! (lambda _ (catch #t (lambda () (let ((nums (sort (append-map (lambda (package) (soap-invoke* (%config 'debbugs) get-bugs `((package . ,package)))) (%config 'packages)) >))) (update-bug-database! nums)) (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") (let ((nums (sort (append-map (lambda (package) (soap-invoke* (%config 'debbugs) get-bugs `((package . ,package) (archive . both)))) (%config 'packages)) >))) (update-bug-database! nums))) (("worker") (update-state!)) (("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 (spawn-server (make-tcp-server-socket #:port repl-port)))) (start-mumi-web-server 1234)))) (_ (show-mumi-usage)))