diff options
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 100 | ||||
| -rw-r--r-- | scripts/guix-build-coordinator.in | 21 |
2 files changed, 119 insertions, 2 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm new file mode 100644 index 0000000..d070ac1 --- /dev/null +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -0,0 +1,100 @@ +;;; Guix Build Coordinator +;;; +;;; Copyright © 2020 Christopher Baines <mail@cbaines.net> +;;; +;;; This file is part of the guix-build-coordinator. +;;; +;;; The Guix Build Coordinator 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. +;;; +;;; The Guix Build Coordinator 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 guix-data-service. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (guix-build-coordinator agent-messaging http) + #:use-module (ice-9 match) + #:use-module (system repl error-handling) + #:use-module (fibers web server) + #:use-module (json) + #:use-module (web http) + #:use-module (web request) + #:use-module (web response) + #:use-module (web uri) + #:export (http-agent-messaging-start-server)) + +(define (http-agent-messaging-start-server port host secret-key-base + datastore) + (call-with-error-handling + (lambda () + (run-server + (lambda (request body) + (format #f "~a ~a\n" + (request-method request) + (uri-path (request-uri request))) + (apply values + (controller request + (cons (request-method request) + (split-and-decode-uri-path + (uri-path (request-uri request)))) + body + secret-key-base))) + #:host host + #:port port)) + #:on-error 'backtrace + #:post-error (lambda (key . args) + (when (eq? key 'system-error) + (match args + (("bind" "~A" ("Address already in use") _) + (simple-format + (current-error-port) + "\n +error: guix-build-coordinator could not start, as it could not bind to port ~A + +Check if it's already running, or whether another process is using that +port. Also, the port used can be changed by passing the --port option.\n" + port))))))) + +(define* (render-json json #:key (extra-headers '()) + (code 200)) + (list (build-response + #:code code + #:headers (append extra-headers + '((content-type . (application/json)) + (vary . (accept))))) + (lambda (port) + (scm->json json port)))) + +(define (no-content) + (list (build-response #:code 204) + "")) + +(define (controller request + method-and-path-components + body + secret-key-base) + (define (controller-thunk) + (match method-and-path-components + (('GET "agent" uuid) + (render-json + `((agent . ,uuid)))) + (('PATCH "agent" uuid) + (no-content)) + (_ + (render-json + "not-found" + #:code 404)))) + + (call-with-error-handling + controller-thunk + #:on-error 'backtrace + #:post-error (lambda args + (render-json + `((error . ,(simple-format #f "~A" args))) + #:code 500)))) diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index 9a2d282..5bf3d31 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -27,7 +27,8 @@ (ice-9 match) (guix-build-coordinator config) (guix-build-coordinator datastore) - (guix-build-coordinator coordinator)) + (guix-build-coordinator coordinator) + (guix-build-coordinator agent-messaging http)) (define %options ;; Specifications of the command-line options @@ -50,6 +51,16 @@ (option '("update-database") #f #f (lambda (opt name _ result) (alist-cons 'update-database #t 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 '("show-error-details") #f #f (lambda (opt name _ result) (alist-cons 'show-error-details #t result))))) @@ -58,6 +69,8 @@ ;; Alist of default option values `((update-database . #f) (database . "sqlite://guix_build_coordinator.db") + (port . 8745) + (host . "0.0.0.0") (show-error-details . ,(match (getenv "GUIX_BUILD_COORDINATOR_SHOW_ERROR_DETAILS") (#f #f) @@ -110,4 +123,8 @@ (parameterize ((%show-error-details (assoc-ref opts 'show-error-details))) - (peek "OPTS" opts))))) + (http-agent-messaging-start-server + (assq-ref opts 'port) + (assq-ref opts 'host) + (assq-ref opts 'secret-key-base) + datastore))))) |