#!@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 threads) (mumi config) (mumi bugs) (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 _ (mu-index) (update-bug-database!) (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 '("fetch") #f #f (lambda (opt name arg result) (alist-cons 'fetch #t result))) (option '("worker") #f #f (lambda (opt name arg result) (alist-cons 'worker #t result))))) (define %default-options ;; Alist of default option values `((listen-repl . #f) (fetch . #f) (worker . #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)) (let ((opts (parse-options (cdr (program-arguments))))) (cond ((assoc-ref opts 'worker) (update-state!)) ((assoc-ref opts 'fetch) (let ((bug-nums (sort (append-map (lambda (package) (soap-invoke (%config 'debbugs) get-bugs `((package . ,package)))) (%config 'packages)) <))) (for-each (lambda (bug-num i) (let ((msg-nums (match (soap-invoke (%config 'debbugs) get-bug-message-numbers bug-num) ((nums . ids) nums)))) (format (current-error-port) "[~a/~a] Downloading ~a messages of bug ~a...~%" i (length bug-nums) (length msg-nums) bug-num) (parameterize ((current-error-port (%make-void-port OPEN_WRITE))) (par-for-each (cut download-message bug-num <>) msg-nums)))) bug-nums (iota (length bug-nums) 1)))) (else (let ((repl-port (assoc-ref opts 'listen-repl))) (when repl-port (spawn-server (make-tcp-server-socket #:port repl-port)))) (use-modules (mumimu)) (mu-index) (mu:initialize (%config 'mail-dir)) (start-mumi-web-server 1234))))