ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-11 05:39:41 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: guix: Add nar-herder-service-type.

Browse source 
* gnu/services/guix.scm (<nar-herder-configuration>): New record 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
nar-herder-shepherd-services, nar-herder-activation,
nar-herder-account): New procedures.
(nar-herder-service-type): New variable.
* gnu/tests/guix.scm (%test-nar-herder): New variable.
* doc/guix.texi (Guix Services): Document the new service.
This commit is contained in:
Christopher Baines 2021-12-21 10:15:14 +00:00
parent 20d68aedbe
commit 087cdafc9f
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577
3 changed files with 298 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

72
doc/guix.texi
View file

@ -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

149
gnu/services/guix.scm
View file

@ -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 @@ (define-module (gnu services guix)
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 @@ (define guix-data-service-type
(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.")))

81
gnu/tests/guix.scm
View file

@ -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 @@ (define-module (gnu tests guix)
#: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 @@ (define %test-guix-data-service
(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))))