#!@GUILE@ --no-auto-compile -*- scheme -*- -*- geiser-scheme-implementation: guile -*- !# ;;; mumi -- Mediocre, uh, mail interface ;;; Copyright © 2016, 2017, 2019, 2020 Ricardo Wurmus ;;; Copyright © 2018, 2021, 2023 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 client) #:prefix client:) (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 '("address") #t #f (lambda (opt name arg result) (catch #t (lambda () (inet-pton AF_INET arg)) (lambda _ (error "invalid web server address" arg))) (alist-cons 'address arg (alist-delete 'address result)))) (option '("port") #t #f (lambda (opt name arg result) (let ((port (string->number arg))) (if port (alist-cons 'port port (alist-delete 'port result)) (error "invalid web server port" arg))))) (option '("listen-repl") #f #t (lambda (opt name arg result) (alist-cons 'listen-repl (or (string->number arg) arg) (alist-delete 'listen-repl result)))) (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 search QUERY': search mumi for issues. `mumi current [ISSUE-NUMBER]': print or set current issue. `mumi new': clear current issue presumably to open a new one. `mumi send-email': send patches to debbugs. `mumi web [--address=address] [--port=port] [--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)) (("search" . query-strings) (client:search (string-join query-strings))) (("current") (client:print-current-issue)) (("current" issue-number-string) (let ((issue-number (string->number issue-number-string))) (if issue-number (client:set-current-issue! issue-number) (begin (format (current-error-port) "Invalid issue number `~a'~%" issue-number-string) (exit #f)))) (client:print-current-issue)) (("new") (client:clear-current-issue!)) (("send-email" . patches) (client:send-email patches)) (("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 ((listen-repl (assoc-ref opts 'listen-repl))) (when listen-repl (cond ((number? listen-repl) (format (current-error-port) "REPL server listening on port ~a~%" listen-repl) (spawn-server (make-tcp-server-socket #:port listen-repl))) (else (format (current-error-port) "REPL server listening on ~a~%" listen-repl) (spawn-server (make-unix-domain-server-socket #:path listen-repl)))))) (start-mumi-web-server (or (assoc-ref opts 'address) "0.0.0.0") (or (assoc-ref opts 'port) 1234))))) (_ (show-mumi-usage)))