From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id IC4XBJ/O2mHGrQAAgWs5BA (envelope-from ) for ; Sun, 09 Jan 2022 13:01:35 +0100 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id 4P2ZAJ/O2mFfNgAAauVa8A (envelope-from ) for ; Sun, 09 Jan 2022 13:01:35 +0100 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 86DDA27881 for ; Sun, 9 Jan 2022 13:01:34 +0100 (CET) Received: from localhost ([::1]:58444 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n6WtB-0005FP-Jj for larch@yhetil.org; Sun, 09 Jan 2022 07:01:33 -0500 Received: from eggs.gnu.org ([209.51.188.92]:45614) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n6Wsh-0005FG-Hs for guix-patches@gnu.org; Sun, 09 Jan 2022 07:01:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:56428) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n6Wsg-0002CD-Ej for guix-patches@gnu.org; Sun, 09 Jan 2022 07:01:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n6Wsg-0007Qn-BR for guix-patches@gnu.org; Sun, 09 Jan 2022 07:01:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53140] [PATCH] services: guix: Add nar-herder-service-type. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Jan 2022 12:01:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 53140 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 53140@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.164172962328512 (code B ref -1); Sun, 09 Jan 2022 12:01:02 +0000 Received: (at submit) by debbugs.gnu.org; 9 Jan 2022 12:00:23 +0000 Received: from localhost ([127.0.0.1]:49331 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n6Ws2-0007Pn-EB for submit@debbugs.gnu.org; Sun, 09 Jan 2022 07:00:23 -0500 Received: from lists.gnu.org ([209.51.188.17]:60092) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n6Wry-0007Pe-PB for submit@debbugs.gnu.org; Sun, 09 Jan 2022 07:00:21 -0500 Received: from eggs.gnu.org ([209.51.188.92]:45544) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n6Wry-0005Bv-Gz for guix-patches@gnu.org; Sun, 09 Jan 2022 07:00:18 -0500 Received: from mira.cbaines.net ([212.71.252.8]:36244) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n6Wrv-0001vw-Rl for guix-patches@gnu.org; Sun, 09 Jan 2022 07:00:18 -0500 Received: from localhost (unknown [IPv6:2a02:8010:68c1:0:8ac0:b4c7:f5c8:7caa]) by mira.cbaines.net (Postfix) with ESMTPSA id C792F27BBE9 for ; Sun, 9 Jan 2022 12:00:12 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id f5e1342c for ; Sun, 9 Jan 2022 12:00:12 +0000 (UTC) From: Christopher Baines Date: Sun, 9 Jan 2022 12:00:12 +0000 Message-Id: <20220109120012.18655-1-mail@cbaines.net> X-Mailer: git-send-email 2.34.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=212.71.252.8; envelope-from=mail@cbaines.net; helo=mira.cbaines.net X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, UNPARSEABLE_RELAY=0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1641729694; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:list-id:list-help: list-unsubscribe:list-subscribe:list-post; bh=vWMZUTv8UvNGGEy3jeAvfvT8G7Ebos4pMUFy9mPFCGk=; b=GqGIX0yKVKu80nPXgfNAbKLDQy3JvoJrK80suES1H6SFZM0WGSor4c04yYE+a7tKsYcn+n hIHV9Wj6u5K/qaJz/KPfZSyOQydz/Y35aVvL1XAd8iVHk8Tle9EaKtwcdMUJL1jDfZDvSP MATW3kzpHhPM67UVjmS34xf0HLWU2TTl3x/EOxQWmiICP8HWowyFZ74EEJO0hEj8hi9RDe xMTz5r+9tcjrGV4IlrxUzFRzr1Q+db/gTe0Ra4pxj4Xz3jZ/5X9WNx89HDrUj0EutctdyB 1QGiUHEd+cpu9HwCxizuRphSjCNMaholh4MzEQ8lTGvxMA4VylHLTHnlE+6mRg== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1641729694; a=rsa-sha256; cv=none; b=jpAfWZu649T5EiLT6jzDPYBFsaB6nbnQn3ZrOND2lsVDI6Ee33Nx7HBHmyIZPj8Mb2ZF4/ K1PDmy+xKVKdsycJQCvEYbb5nW4zDTTeYC00rpt1gCZLhlmV9bjsi//2v3Dw4CnJn9XGw2 +iQbHriMZG5q2Mey3aVsayhL3Lp7TJD8DhjqoBNKiYsUZOJBRWTne66N4bATAcx9c0ClLB /rJV648l8Ny/zVLdQKt9fZvJr2juWZHqffubGHDpzNFrQ87xSFpO9ReLLSVhWlgNXzgX/I ZW5cmxvKA+MzdHNDBt4034R1BNbiUbmlZFnrCJql2nAy7EJ6tJ0u/F6sWMgzvg== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -1.81 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: 86DDA27881 X-Spam-Score: -1.81 X-Migadu-Scanner: scn1.migadu.com X-TUID: rxW2OU9djt2A * gnu/services/guix.scm (): 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 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 + (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 + (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