diff options
Diffstat (limited to 'scripts/bffe.in')
| -rw-r--r-- | scripts/bffe.in | 124 |
1 files changed, 124 insertions, 0 deletions
diff --git a/scripts/bffe.in b/scripts/bffe.in new file mode 100644 index 0000000..d0ca978 --- /dev/null +++ b/scripts/bffe.in @@ -0,0 +1,124 @@ +#!@GUILE@ --no-auto-compile +-*- scheme -*- +-*- geiser-scheme-implementation: guile -*- +!# +;;; bffe - Build farm front-end +;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2019 Christopher Baines <mail@cbaines.net> +;;; +;;; This file is part of bffe. +;;; +;;; bffe 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. +;;; +;;; bffe 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 the bffe. If not, see <http://www.gnu.org/licenses/>. + +(use-modules (srfi srfi-1) + (srfi srfi-37) + (ice-9 match) + (ice-9 textual-ports) + (system repl server) + (system repl repl) + (gcrypt pk-crypto) + (guix pki) + (prometheus) + (bffe server)) + +(define %options + ;; Specifications of the command-line options + (list (option '("repl") #f #t + (lambda (opt name arg result) + (alist-cons 'repl #t (alist-delete 'repl result)))) + (option '("pid-file") #t #f + (lambda (opt name arg result) + (alist-cons 'pid-file + arg + result))) + (option '("port") #t #f + (lambda (opt name arg result) + (alist-cons 'port + (string->number arg) + (alist-delete 'port result)))) + (option '("host") #t #f + (lambda (opt name arg result) + (alist-cons 'host + arg + (alist-delete 'host result)))) + (option '("title") #t #f + (lambda (opt name arg result) + (alist-cons 'title + arg + result))) + (option '("template-directory") #t #f + (lambda (opt name arg result) + (alist-cons 'template-directory + arg + result))))) + +(define %default-options + ;; Alist of default option values + `((port . 8767) + (host . "0.0.0.0") + + (assets-directory . ,(let ((install-dir + "@prefix@/share/bffe/assets") + (dev-dir + (string-append (getcwd) "/assets"))) + (if (file-exists? install-dir) + install-dir + dev-dir))) + (title . "Build farm") + (template-directory . ,(let ((install-dir + "@prefix@/share/bffe/templates") + (dev-dir + (string-append (getcwd) "/templates"))) + (if (file-exists? install-dir) + install-dir + dev-dir))))) + +(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)) + +(setvbuf (current-output-port) 'line) +(setvbuf (current-error-port) 'line) + +(let ((opts (parse-options (cdr (program-arguments))))) + (let ((pid-file (assq-ref opts 'pid-file))) + (when pid-file + (call-with-output-file pid-file + (lambda (port) + (simple-format port "~A\n" (getpid)))))) + + ;; Provide some visual space between the startup output and the + ;; server starting + (simple-format #t "\n\nStarting the server on http://~A:~A/\n\n" + (assq-ref opts 'host) + (assq-ref opts 'port)) + + (let* ((metrics-registry (make-metrics-registry + #:namespace + "bffe"))) + + (start-bffe-web-server + (assq-ref opts 'port) + (assq-ref opts 'host) + (assq-ref opts 'assets-directory) + metrics-registry + #:controller-args + (list (assq-ref opts 'title) + (assq-ref opts 'template-directory))))) |