GNU bug report logs - #53140
[PATCH] services: guix: Add nar-herder-service-type.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 53140 in the body.
You can then email your comments to 53140 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: guix-patches <at> gnu.org
Subject: [PATCH] services: guix: Add nar-herder-service-type.
Date: Sun,  9 Jan 2022 12:00:12 +0000

* 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.
---
 doc/guix.texi         |  72 +++++++++++++++++++++
 gnu/services/guix.scm | 147 +++++++++++++++++++++++++++++++++++++++++-
 gnu/tests/guix.scm    |  79 ++++++++++++++++++++++-
 3 files changed, 296 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 08e5bfa111..8884052956 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -33287,6 +33287,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..930a78bf3c 100644
--- a/gnu/services/guix.scm
+++ b/gnu/services/guix.scm
@@ -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.")))
diff --git a/gnu/tests/guix.scm b/gnu/tests/guix.scm
index 69cac7c1aa..0209767cd2 100644
--- a/gnu/tests/guix.scm
+++ b/gnu/tests/guix.scm
@@ -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))))
-- 
2.34.0

Message #10 received at 53140-done <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: 53140-done <at> debbugs.gnu.org
Subject: Re: [bug#53140] [PATCH] services: guix: Add nar-herder-service-type.
Date: Mon, 31 Jan 2022 18:30:31 +0000

[Message part 1 (text/plain, inline)]

Christopher Baines <mail <at> cbaines.net> writes:

> * 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.
> ---
>  doc/guix.texi         |  72 +++++++++++++++++++++
>  gnu/services/guix.scm | 147 +++++++++++++++++++++++++++++++++++++++++-
>  gnu/tests/guix.scm    |  79 ++++++++++++++++++++++-
>  3 files changed, 296 insertions(+), 2 deletions(-)

Merged to master as 087cdafc9f8ef1d73780ab3e0b4dd340b9e0bce0.

[signature.asc (application/pgp-signature, inline)]

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.