From 82abf6ddadc6139148660440a064e60ae68f238e Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 26 Aug 2023 10:08:56 +0100 Subject: services: guix: Add bffe-service-type. This is intended to replace the functionality of the Guix Build Coordinator queue builds script, and also provide a web interface for build farms. * gnu/services/guix.scm (): New record type. (bffe-configuration, bffe-configuration?, bffe-configuration-package, bffe-configuration-user, bffe-configuration-group, bffe-configuration-arguments bffe-configuration-extra-environment-variables): New procedures. (bffe-service-type): New variable. * gnu/tests/guix.scm (%test-bffe): New variable. * doc/guix.texi (Guix Services): Document the new service. --- gnu/services/guix.scm | 127 +++++++++++++++++++++++++++++++++++++++++++++++++- gnu/tests/guix.scm | 81 +++++++++++++++++++++++++++++++- 2 files changed, 206 insertions(+), 2 deletions(-) (limited to 'gnu') diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm index 99b21f52d8..9b19a48cfd 100644 --- a/gnu/services/guix.scm +++ b/gnu/services/guix.scm @@ -140,7 +140,17 @@ nar-herder-cached-compression-configuration-type nar-herder-cached-compression-configuration-level nar-herder-cached-compression-configuration-directory - nar-herder-cached-compression-configuration-directory-max-size)) + nar-herder-cached-compression-configuration-directory-max-size + + bffe-configuration + bffe-configuration? + bffe-configuration-package + bffe-configuration-user + bffe-configuration-group + bffe-configuration-arguments + bffe-configuration-extra-environment-variables + + bffe-service-type)) ;;;; Commentary: ;;; @@ -1030,3 +1040,118 @@ ca-certificates.crt file in the system profile." nar-herder-account))) (description "Run a Nar Herder server."))) + + +;;; +;;; Build Farm Front-end (BFFE) +;;; + +(define-record-type* + bffe-configuration make-bffe-configuration + bffe-configuration? + (package bffe-configuration-package + (default bffe)) + (user bffe-configuration-user + (default "bffe")) + (group bffe-configuration-group + (default "bffe")) + (arguments bffe-configuration-arguments) + (extra-environment-variables + bffe-configuration-extra-environment-variables + (default '()))) + +(define (bffe-shepherd-services config) + (define bffe-package + (bffe-configuration-package config)) + + (define start-script + (program-file + "run-bffe" + (with-extensions (cons + bffe-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 BFFE don't need to be + ;; individually specified here. + (map second (package-transitive-propagated-inputs + bffe-package))) + #~(begin + (use-modules (bffe) + (bffe manage-builds)) + + (setvbuf (current-output-port) 'line) + (setvbuf (current-error-port) 'line) + + (simple-format #t "starting the bffe:\n ~A\n" + (current-filename)) + + (apply run-bffe-service + (append + (list #:pid-file "/var/run/bffe/pid") + #$(bffe-configuration-arguments config))))) + #:guile guile-3.0)) + + (match-record config + (package user group arguments extra-environment-variables) + + (list + (shepherd-service + (documentation "Build Farm Front-end") + (provision '(bffe)) + (requirement '(networking)) + (start #~(make-forkexec-constructor + (list #$start-script) + #:user #$user + #:group #$group + #:pid-file "/var/run/bffe/pid" + #:directory "/var/lib/bffe" + #:environment-variables + `(,(string-append + "GUIX_LOCPATH=" #$glibc-utf8-locales "/lib/locale") + "LC_ALL=en_US.utf8" + #$@extra-environment-variables) + #:log-file "/var/log/bffe/server.log")) + (stop #~(make-kill-destructor)))))) + +(define (bffe-activation config) + #~(begin + (use-modules (guix build utils)) + + (define %user + (getpw #$(bffe-configuration-user config))) + + (chmod "/var/lib/bffe" #o755) + + (mkdir-p "/var/log/bffe") + + ;; Allow writing the PID file + (mkdir-p "/var/run/bffe") + (chown "/var/run/bffe" (passwd:uid %user) (passwd:gid %user)))) + +(define (bffe-account config) + (match-record config + (user group) + (list (user-group + (name group) + (system? #t)) + (user-account + (name user) + (group group) + (system? #t) + (comment "BFFE user") + (home-directory "/var/lib/bffe") + (shell (file-append shadow "/sbin/nologin")))))) + +(define bffe-service-type + (service-type + (name 'bffe) + (extensions + (list (service-extension shepherd-root-service-type + bffe-shepherd-services) + (service-extension activation-service-type + bffe-activation) + (service-extension account-service-type + bffe-account))) + (description + "Run the Build Farm Front-end."))) diff --git a/gnu/tests/guix.scm b/gnu/tests/guix.scm index ad0980a10c..240ded4825 100644 --- a/gnu/tests/guix.scm +++ b/gnu/tests/guix.scm @@ -37,7 +37,8 @@ #:use-module (ice-9 match) #:export (%test-guix-build-coordinator %test-guix-data-service - %test-nar-herder)) + %test-nar-herder + %test-bffe)) ;;; ;;; Guix Build Coordinator @@ -325,3 +326,81 @@ host all all ::1/128 trust")))))) (name "nar-herder") (description "Connect to a running Nar Herder server.") (value (run-nar-herder-test)))) + + +;;; +;;; Build Farm Front-end +;;; + +(define %bffe-os + (simple-operating-system + (service dhcp-client-service-type) + (service guix-build-coordinator-service-type) + (service bffe-service-type + (bffe-configuration + (arguments + #~(list + #:web-server-args + '(#:port 8767 + #:controller-args + (#:title "Test title")))))))) + +(define (run-bffe-test) + (define os + (marionette-operating-system + %bffe-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define forwarded-port 8767) + + (define vm + (virtual-machine + (operating-system os) + (memory-size 1024) + (port-forwardings `((,forwarded-port . 8767))))) + + (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))) + + (test-runner-current (system-test-runner #$output)) + (test-begin "bffe") + + (test-assert "service running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (match (start-service 'bffe) + (#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/" forwarded-port) + #:decode-body? #t))) + (response-code response))) + + (test-end)))) + + (gexp->derivation "bffe-test" test)) + +(define %test-bffe + (system-test + (name "bffe") + (description "Connect to a running Build Farm Front-end.") + (value (run-bffe-test)))) -- cgit v1.2.3