~ruther/guix-local

82abf6ddadc6139148660440a064e60ae68f238e — Christopher Baines 2 years ago dca96f2
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 (<bffe-configuration>): 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.
3 files changed, 265 insertions(+), 2 deletions(-)

M doc/guix.texi
M gnu/services/guix.scm
M gnu/tests/guix.scm
M doc/guix.texi => doc/guix.texi +59 -0
@@ 38088,6 38088,65 @@ File name of the file system key for the target volume.
@node Guix Services
@subsection Guix Services

@subsubheading Build Farm Front-End (BFFE)
The @uref{https://git.cbaines.net/guix/bffe/,Build Farm Front-End}
assists with building Guix packages in bulk.  It's responsible for
submitting builds and displaying the status of the build farm.

@defvar bffe-service-type
Service type for the Build Farm Front-End.  Its value must be a
@code{bffe-configuration} object.
@end defvar

@deftp {Data Type} bffe-configuration
Data type representing the configuration of the Build Farm Front-End.

@table @asis
@item @code{package} (default: @code{bffe})
The Build Farm Front-End package to use.

@item @code{user} (default: @code{"bffe"})
The system user to run the service as.

@item @code{group} (default: @code{"bffe"})
The system group to run the service as.

@item @code{arguments}
A list of arguments to the Build Farm Front-End.  These are passed to
the @code{run-bffe-service} procedure when starting the service.

For example, the following value directs the Build Farm Front-End to
submit builds for derivations available from @code{data.guix.gnu.org} to
the Build Coordinator instance assumed to be running on the same
machine.

@example
(list
 #:build
 (list
  (build-from-guix-data-service
   (data-service-url "https://data.guix.gnu.org")
   (build-coordinator-url "http://127.0.0.1:8746")
   (branches '("master"))
   (systems '("x86_64-linux" "i686-linux"))
   (systems-and-targets
    (map (lambda (target)
           (cons "x86_64-linux" target))
         '("aarch64-linux-gnu"
           "i586-pc-gnu")))
   (build-priority (const 0))))
 #:web-server-args
 '(#:event-source "https://example.com"
   #:controller-args
   (#:title "example.com build farm")))
@end example

@item @code{extra-environment-variables} (default: @var{'()})
Extra environment variables to set via the shepherd service.

@end table
@end deftp

@subsubheading Guix Build Coordinator
The @uref{https://git.cbaines.net/guix/build-coordinator/,Guix Build
Coordinator} aids in distributing derivation builds among machines

M gnu/services/guix.scm => gnu/services/guix.scm +126 -1
@@ 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>
  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 <bffe-configuration>
    (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 <bffe-configuration>
    (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.")))

M gnu/tests/guix.scm => gnu/tests/guix.scm +80 -1
@@ 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))))