diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/services/guix.scm | 200 | ||||
| -rw-r--r-- | gnu/tests/guix.scm | 75 |
2 files changed, 271 insertions, 4 deletions
diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm index 10a8581a62..1bacd61190 100644 --- a/gnu/services/guix.scm +++ b/gnu/services/guix.scm @@ -17,20 +17,40 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu services guix) + #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:use-module (guix gexp) #:use-module (guix records) + #:use-module (guix packages) #:use-module ((gnu packages base) #:select (glibc-utf8-locales)) #:use-module (gnu packages admin) + #:use-module (gnu packages databases) #:use-module (gnu packages web) + #:use-module (gnu packages guile) + #:use-module (gnu packages guile-xyz) + #:use-module (gnu packages package-management) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu services admin) #:use-module (gnu services shepherd) #:use-module (gnu services getmail) #:use-module (gnu system shadow) - #:export (<guix-data-service-configuration> + #:export (guix-build-coordinator-configuration + guix-build-coordinator-configuration? + guix-build-coordinator-configuration-package + guix-build-coordinator-configuration-user + guix-build-coordinator-configuration-group + guix-build-coordinator-configuration-datastore-uri-string + guix-build-coordinator-configuration-agent-communication-uri-string + guix-build-coordinator-configuration-client-communication-uri-string + guix-build-coordinator-configuration-allocation-strategy + guix-build-coordinator-configuration-hooks + guix-build-coordinator-configuration-guile + + guix-build-coordinator-service-type + + <guix-data-service-configuration> guix-data-service-configuration guix-data-service-configuration? guix-data-service-package @@ -45,11 +65,185 @@ ;;;; Commentary: ;;; -;;; This module implements a service that to run instances of the Guix Data -;;; Service, which provides data about Guix over time. +;;; Services specifically related to GNU Guix. ;;; ;;;; Code: +(define-record-type* <guix-build-coordinator-configuration> + guix-build-coordinator-configuration make-guix-build-coordinator-configuration + guix-build-coordinator-configuration? + (package guix-build-coordinator-configuration-package + (default guix-build-coordinator)) + (user guix-build-coordinator-configuration-user + (default "guix-build-coordinator")) + (group guix-build-coordinator-configuration-group + (default "guix-build-coordinator")) + (database-uri-string + guix-build-coordinator-configuration-datastore-uri-string + (default "sqlite:///var/lib/guix-build-coordinator/guix_build_coordinator.db")) + (agent-communication-uri-string + guix-build-coordinator-configuration-agent-communication-uri-string + (default "http://0.0.0.0:8745")) + (client-communication-uri-string + guix-build-coordinator-configuration-client-communication-uri-string + (default "http://127.0.0.1:8746")) + (allocation-strategy + guix-build-coordinator-configuration-allocation-strategy + (default #~basic-build-allocation-strategy)) + (hooks guix-build-coordinator-configuration-hooks + (default '())) + (guile guix-build-coordinator-configuration-guile + (default guile-3.0-latest))) + +(define* (make-guix-build-coordinator-start-script database-uri-string + allocation-strategy + pid-file + guix-build-coordinator-package + #:key + agent-communication-uri-string + client-communication-uri-string + (hooks '()) + (guile guile-3.0)) + (program-file + "start-guix-build-coordinator" + (with-extensions (cons guix-build-coordinator-package + ;; This is a poorly constructed Guile load path, + ;; since it contains things that aren't Guile + ;; libraries, but it means that the Guile libraries + ;; needed for the Guix Build Coordinator don't need + ;; to be individually specified here. + (map second (package-inputs + guix-build-coordinator-package))) + #~(begin + (use-modules (srfi srfi-1) + (ice-9 match) + (web uri) + (prometheus) + (guix-build-coordinator hooks) + (guix-build-coordinator datastore) + (guix-build-coordinator build-allocator) + (guix-build-coordinator coordinator)) + + (let* ((metrics-registry (make-metrics-registry + #:namespace + "guixbuildcoordinator_")) + (datastore (database-uri->datastore + #$database-uri-string + #:metrics-registry metrics-registry)) + (hooks + (list #$@(map (match-lambda + ((name . hook-gexp) + #~(cons name #$hook-gexp))) + hooks))) + (hooks-with-defaults + `(,@hooks + ,@(remove (match-lambda + ((name . _) (assq-ref hooks name))) + %default-hooks))) + (build-coordinator (make-build-coordinator + #:datastore datastore + #:hooks hooks-with-defaults + #:metrics-registry metrics-registry + #:allocation-strategy #$allocation-strategy))) + + (run-coordinator-service + build-coordinator + #:update-datastore? #t + #:pid-file #$pid-file + #:agent-communication-uri (string->uri + #$agent-communication-uri-string) + #:client-communication-uri (string->uri + #$client-communication-uri-string))))) + #:guile guile)) + +(define (guix-build-coordinator-shepherd-services config) + (match-record config <guix-build-coordinator-configuration> + (package user group database-uri-string + agent-communication-uri-string + client-communication-uri-string + allocation-strategy + hooks + guile) + (list + (shepherd-service + (documentation "Guix Build Coordinator") + (provision '(guix-build-coordinator)) + (requirement '(networking)) + (start #~(make-forkexec-constructor + (list #$(make-guix-build-coordinator-start-script + database-uri-string + allocation-strategy + "/var/run/guix-build-coordinator/pid" + package + #:agent-communication-uri-string + agent-communication-uri-string + #:client-communication-uri-string + client-communication-uri-string + #:hooks hooks + #:guile guile)) + #:user #$user + #:group #$group + #:pid-file "/var/run/guix-build-coordinator/pid" + ;; Allow time for migrations to run + #:pid-file-timeout 60 + #:environment-variables + `(,(string-append + "GUIX_LOCPATH=" #$glibc-utf8-locales "/lib/locale") + "LC_ALL=en_US.utf8") + #:log-file "/var/log/guix-build-coordinator/coordinator.log")) + (stop #~(make-kill-destructor)))))) + +(define (guix-build-coordinator-activation config) + #~(begin + (use-modules (guix build utils)) + + (define %user (getpw "guix-build-coordinator")) + + (chmod "/var/lib/guix-build-coordinator" #o755) + + (mkdir-p "/var/log/guix-build-coordinator") + + ;; Allow writing the PID file + (mkdir-p "/var/run/guix-build-coordinator") + (chown "/var/run/guix-build-coordinator" + (passwd:uid %user) + (passwd:gid %user)))) + +(define (guix-build-coordinator-account config) + (match-record config <guix-build-coordinator-configuration> + (user group) + (list (user-group + (name group) + (system? #t)) + (user-account + (name user) + (group group) + (system? #t) + (comment "Guix Build Coordinator user") + (home-directory "/var/lib/guix-build-coordinator") + (shell (file-append shadow "/sbin/nologin")))))) + +(define guix-build-coordinator-service-type + (service-type + (name 'guix-build-coordinator) + (extensions + (list + (service-extension shepherd-root-service-type + guix-build-coordinator-shepherd-services) + (service-extension activation-service-type + guix-build-coordinator-activation) + (service-extension account-service-type + guix-build-coordinator-account))) + (default-value + (guix-build-coordinator-configuration)) + (description + "Run an instance of the Guix Build Coordinator."))) + + +;;; +;;; Guix Data Service +;;; + (define-record-type* <guix-data-service-configuration> guix-data-service-configuration make-guix-data-service-configuration guix-data-service-configuration? diff --git a/gnu/tests/guix.scm b/gnu/tests/guix.scm index 6139e31cf0..20b67d55d3 100644 --- a/gnu/tests/guix.scm +++ b/gnu/tests/guix.scm @@ -35,7 +35,80 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (ice-9 match) - #:export (%test-guix-data-service)) + #:export (%test-guix-build-coordinator + %test-guix-data-service)) + +;;; +;;; Guix Build Coordinator +;;; + +(define %guix-build-coordinator-os + (simple-operating-system + (service dhcp-client-service-type) + (service guix-build-coordinator-service-type))) + +(define (run-guix-build-coordinator-test) + (define os + (marionette-operating-system + %guix-build-coordinator-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define forwarded-port 8745) + + (define vm + (virtual-machine + (operating-system os) + (memory-size 1024) + (port-forwardings `((,forwarded-port . 8745))))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette) + (web uri) + (web client) + (web response)) + + (define marionette + (make-marionette (list #$vm))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "guix-build-coordinator") + + (test-assert "service running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (match (start-service 'guix-build-coordinator) + (#f #f) + (('service response-parts ...) + (match (assq-ref response-parts 'running) + ((pid) (number? pid)))))) + marionette)) + + (test-equal "http-get" + 200 + (let-values + (((response text) + (http-get #$(simple-format + #f "http://localhost:~A/metrics" forwarded-port) + #:decode-body? #t))) + (response-code response))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "guix-build-coordinator-test" test)) + +(define %test-guix-build-coordinator + (system-test + (name "guix-build-coordinator") + (description "Connect to a running Guix Build Coordinator.") + (value (run-guix-build-coordinator-test)))) ;;; |