diff options
| -rw-r--r-- | doc/guix.texi | 72 | ||||
| -rw-r--r-- | gnu/services/guix.scm | 149 | ||||
| -rw-r--r-- | gnu/tests/guix.scm | 81 |
3 files changed, 298 insertions, 4 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 94f8e5e481..c3f36d37ff 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -33637,6 +33637,78 @@ Extra command line options for @code{guix-data-service-process-jobs}. @end table @end deftp +@subsubheading Nar Herder +The @uref{https://git.cbaines.net/guix/nar-herder/about/,Nar Herder} is +a utility for managing a collection of nars. + +@defvar {Scheme Variable} nar-herder-type +Service type for the Guix Data Service. Its value must be a +@code{nar-herder-configuration} object. The service optionally +extends the getmail service, as the guix-commits mailing list is used to +find out about changes in the Guix git repository. +@end defvar + +@deftp {Data Type} nar-herder-configuration +Data type representing the configuration of the Guix Data Service. + +@table @asis +@item @code{package} (default: @code{nar-herder}) +The Nar Herder package to use. + +@item @code{user} (default: @code{"nar-herder"}) +The system user to run the service as. + +@item @code{group} (default: @code{"nar-herder"}) +The system group to run the service as. + +@item @code{port} (default: @code{8734}) +The port to bind the server to. + +@item @code{host} (default: @code{"127.0.0.1"}) +The host to bind the server to. + +@item @code{mirror} (default: @code{#f}) +Optional URL of the other Nar Herder instance which should be mirrored. +This means that this Nar Herder instance will download it's database, +and keep it up to date. + +@item @code{database} (default: @code{"/var/lib/nar-herder/nar_herder.db"}) +Location for the database. If this Nar Herder instance is mirroring +another, the database will be downloaded if it doesn't exist. If this +Nar Herder instance isn't mirroring another, an empty database will be +created. + +@item @code{database-dump} (default: @code{"/var/lib/nar-herder/nar_herder_dump.db"}) +Location of the database dump. This is created and regularly updated by +taking a copy of the database. This is the version of the database that +is available to download. + +@item @code{storage} (default: @code{#f}) +Optional location in which to store nars. + +@item @code{storage-limit} (default: @code{"none"}) +Limit in bytes for the nars stored in the storage location. This can +also be set to ``none'' so that there is no limit. + +When the storage location exceeds this size, nars are removed according +to the nar removal criteria. + +@item @code{storage-nar-removal-criteria} (default: @code{'()}) +Criteria used to remove nars from the storage location. These are used +in conjunction with the storage limit. + +When the storage location exceeds the storage limit size, nars will be +checked against the nar removal criteria and if any of the criteria +match, they will be removed. This will continue until the storage +location is below the storage limit size. + +Each criteria is specified by a string, then an equals sign, then +another string. Currently, only one criteria is supported, checking if a +nar is stored on another Nar Herder instance. + +@end table +@end deftp + @node Linux Services @subsection Linux Services diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm index df5fa13bea..6a5b276b33 100644 --- a/gnu/services/guix.scm +++ b/gnu/services/guix.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019 Christopher Baines <mail@cbaines.net> +;;; Copyright © 2019, 2020, 2021, 2022 Christopher Baines <mail@cbaines.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -107,7 +107,22 @@ guix-data-service-getmail-idle-mailboxes guix-data-service-commits-getmail-retriever-configuration - guix-data-service-type)) + guix-data-service-type + + nar-herder-service-type + nar-herder-configuration + nar-herder-configuration? + nar-herder-configuration-package + nar-herder-configuration-user + nar-herder-configuration-group + nar-herder-configuration-mirror + nar-herder-configuration-database + nar-herder-configuration-database-dump + nar-herder-configuration-host + nar-herder-configuration-port + nar-herder-configuration-storage + nar-herder-configuration-storage-limit + nar-herder-configuration-storage-nar-removal-criteria)) ;;;; Commentary: ;;; @@ -728,3 +743,133 @@ ca-certificates.crt file in the system profile." (guix-data-service-configuration)) (description "Run an instance of the Guix Data Service."))) + + +;;; +;;; Nar Herder +;;; + +(define-record-type* <nar-herder-configuration> + nar-herder-configuration make-nar-herder-configuration + nar-herder-configuration? + (package nar-herder-configuration-package + (default nar-herder)) + (user nar-herder-configuration-user + (default "nar-herder")) + (group nar-herder-configuration-group + (default "nar-herder")) + (mirror nar-herder-configuration-mirror + (default #f)) + (database nar-herder-configuration-database + (default "/var/lib/nar-herder/nar_herder.db")) + (database-dump nar-herder-configuration-database-dump + (default "/var/lib/nar-herder/nar_herder_dump.db")) + (host nar-herder-configuration-host + (default "127.0.0.1")) + (port nar-herder-configuration-port + (default 8734)) + (storage nar-herder-configuration-storage + (default #f)) + (storage-limit nar-herder-configuration-storage-limit + (default "none")) + (storage-nar-removal-criteria + nar-herder-configuration-storage-nar-removal-criteria + (default '()))) + +(define (nar-herder-shepherd-services config) + (match-record config <nar-herder-configuration> + (package user group + mirror + database database-dump + host port + storage storage-limit storage-nar-removal-criteria) + + (unless (or mirror storage) + (error "nar-herder: mirror or storage must be set")) + + (list + (shepherd-service + (documentation "Nar Herder") + (provision '(nar-herder)) + (requirement '(networking)) + (start #~(make-forkexec-constructor + (list #$(file-append package + "/bin/nar-herder") + "run-server" + "--pid-file=/var/run/nar-herder/pid" + #$(string-append "--port=" (number->string port)) + #$(string-append "--host=" host) + #$@(if mirror + (list (string-append "--mirror=" mirror)) + '()) + #$(string-append "--database=" database) + #$(string-append "--database-dump=" database-dump) + #$@(if storage + (list (string-append "--storage=" storage)) + '()) + #$(string-append "--storage-limit=" + (if (number? storage-limit) + (number->string storage-limit) + storage-limit)) + #$@(map (lambda (criteria) + (string-append + "--storage-nar-removal-criteria=" + (match criteria + ((k . v) (simple-format #f "~A=~A" k v)) + (str str)))) + storage-nar-removal-criteria)) + #:user #$user + #:group #$group + #:pid-file "/var/run/nar-herder/pid" + #:environment-variables + `(,(string-append + "GUIX_LOCPATH=" #$glibc-utf8-locales "/lib/locale") + "LC_ALL=en_US.utf8") + #:log-file "/var/log/nar-herder/server.log")) + (stop #~(make-kill-destructor)))))) + +(define (nar-herder-activation config) + #~(begin + (use-modules (guix build utils)) + + (define %user + (getpw #$(nar-herder-configuration-user + config))) + + (chmod "/var/lib/nar-herder" #o755) + + (mkdir-p "/var/log/nar-herder") + + ;; Allow writing the PID file + (mkdir-p "/var/run/nar-herder") + (chown "/var/run/nar-herder" + (passwd:uid %user) + (passwd:gid %user)))) + +(define (nar-herder-account config) + (match-record config <nar-herder-configuration> + (user group) + (list (user-group + (name group) + (system? #t)) + (user-account + (name user) + (group group) + (system? #t) + (comment "Nar Herder user") + (home-directory "/var/lib/nar-herder") + (shell (file-append shadow "/sbin/nologin")))))) + +(define nar-herder-service-type + (service-type + (name 'nar-herder) + (extensions + (list + (service-extension shepherd-root-service-type + nar-herder-shepherd-services) + (service-extension activation-service-type + nar-herder-activation) + (service-extension account-service-type + nar-herder-account))) + (description + "Run a Nar Herder server."))) diff --git a/gnu/tests/guix.scm b/gnu/tests/guix.scm index 69cac7c1aa..a4c3e35e5d 100644 --- a/gnu/tests/guix.scm +++ b/gnu/tests/guix.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019 Christopher Baines <mail@cbaines.net> +;;; Copyright © 2019, 2020, 2021, 2022 Christopher Baines <mail@cbaines.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,7 +36,8 @@ #:use-module (guix utils) #:use-module (ice-9 match) #:export (%test-guix-build-coordinator - %test-guix-data-service)) + %test-guix-data-service + %test-nar-herder)) ;;; ;;; Guix Build Coordinator @@ -239,3 +240,79 @@ host all all ::1/128 trust")))))) (name "guix-data-service") (description "Connect to a running Guix Data Service.") (value (run-guix-data-service-test)))) + + +;;; +;;; Nar Herder +;;; + +(define %nar-herder-os + (simple-operating-system + (service dhcp-client-service-type) + (service nar-herder-service-type + (nar-herder-configuration + (host "0.0.0.0") + ;; Not a realistic value, but works for the test + (storage "/tmp"))))) + +(define (run-nar-herder-test) + (define os + (marionette-operating-system + %nar-herder-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define forwarded-port + (nar-herder-configuration-port + (nar-herder-configuration))) + + (define vm + (virtual-machine + (operating-system os) + (memory-size 1024) + (port-forwardings `((,forwarded-port . ,forwarded-port))))) + + (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 "nar-herder") + + (test-assert "service running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (match (start-service 'nar-herder) + (#f #f) + (('service response-parts ...) + (match (assq-ref response-parts 'running) + ((pid) (number? pid)))))) + marionette)) + + (test-equal "http-get" + 404 + (let-values + (((response text) + (http-get #$(simple-format + #f "http://localhost:~A/" forwarded-port) + #:decode-body? #t))) + (response-code response))) + + (test-end)))) + + (gexp->derivation "nar-herder-test" test)) + +(define %test-nar-herder + (system-test + (name "nar-herder") + (description "Connect to a running Nar Herder server.") + (value (run-nar-herder-test)))) |