From eb81966f4a6380446ea98f91e5cccb6746c5e242 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 27 Apr 2017 10:48:28 +0200 Subject: gnu: Add potluck host-channel service. * gnu/services/potluck.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add new service. * doc/guix.texi (Potluck Services): New subsubsection. potluck fixie --- doc/guix.texi | 54 ++++++++++++++++++ gnu/local.mk | 1 + gnu/services/potluck.scm | 141 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 196 insertions(+) create mode 100644 gnu/services/potluck.scm diff --git a/doc/guix.texi b/doc/guix.texi index bc2a4d0d84..8e53327ee8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -222,6 +222,7 @@ Services * VPN Services:: VPN daemons. * Network File System:: NFS related services. * Continuous Integration:: The Cuirass service. +* Potluck Services:: Guix's decoupled package registry. * Power management Services:: The TLP tool. * Version Control Services:: Providing remote access to Git repositories. * Miscellaneous Services:: Other services. @@ -8859,6 +8860,7 @@ declaration. * VPN Services:: VPN daemons. * Network File System:: NFS related services. * Continuous Integration:: The Cuirass service. +* Potluck Services:: Guix's decoupled package registry. * Power management Services:: The TLP tool. * Version Control Services:: Providing remote access to Git repositories. * Miscellaneous Services:: Other services. @@ -14385,6 +14387,58 @@ The Cuirass package to use. @end table @end deftp +@node Potluck Services +@subsubsection Potluck Services + +@cindex potluck service +Guix includes a potluck.... + +@defvr {Scheme Variable} potluck-service-type +A service type for the @code{guix-potluck} FastCGI proxy. +@end defvr + +@deftp {Data Type} potluck-configuration +Data type representing the configuration of the @code{guix-potluck} serice. +This type has the following parameters: +@table @asis +@item @code{package} (default: @code{guix-potluck}) +The guix-potluck package to use. + +@item @code{scratch} (default: @code{/var/cache/guix-potluck/scratch}) +The scratch directory that @code{guix potluck host-channel} will use. +The potluck service will ensure that this directory exists and is owned +by the potluck service user. + +@item @code{source} (default: @code{/srv/git/source.git}) +A local path to a git repository in which to save Guix potluck packages. +The potluck service will create this repository if needed. + +@item @code{source-repo} (default: @code{/var/cache/guix-potluck/source}) +A directory that @code{guix potluck host-channel} will use to check out +the potluck source git repository. The potluck service will create this +checkout if needed. + +@item @code{target} (default: @code{/srv/git/target.git}) +@itemx @code{target-repo} (default: @code{/var/cache/guix-potluck/target}) +Like @code{source} and @code{source-repo}, but for compiled Guix +packages corresponding to the incoming potluck packages. The idea is +that the source repository contains the incoming potluck packages +verbatim, as the users provided them and after the potluck host has +validated them. The target repository contains corresponding Guix +packages, in a form that can just be added to the +@code{GUIX_PACKAGE_PATH}. + +@item @code{user} (default: @code{guix-potluck}) +@itemx @code{group} (default: @code{guix-potluck}) +The user and group names, as strings, under which to run the @code{guix} +process, and which should own the corresponding checkouts and scratch +directories. The potluck service will ensure that if the user asks for +the specific user or group names @code{guix-potluck} that the +corresponding user and/or group is present on the system. +@end table +@end deftp + + @node Power management Services @subsubsection Power management Services diff --git a/gnu/local.mk b/gnu/local.mk index ac0c9d510d..2e0468f24b 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -429,6 +429,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/messaging.scm \ %D%/services/networking.scm \ %D%/services/nfs.scm \ + %D%/services/potluck.scm \ %D%/services/shepherd.scm \ %D%/services/herd.scm \ %D%/services/pm.scm \ diff --git a/gnu/services/potluck.scm b/gnu/services/potluck.scm new file mode 100644 index 0000000000..cbabaa5acd --- /dev/null +++ b/gnu/services/potluck.scm @@ -0,0 +1,141 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Andy Wingo +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu services potluck) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (gnu system shadow) + #:use-module (gnu packages admin) + #:use-module (gnu packages package-management) + #:use-module (gnu packages version-control) + #:use-module (guix records) + #:use-module (guix gexp) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:export (potluck-configuration + potluck-configuration? + potluck-service-type)) + +;;; Commentary: +;;; +;;; Guix potluck services. +;;; +;;; Code: + +;; FIXME: Replace with guix version that has potluck. +(define guix/potluck guix) + +(define-record-type* potluck-configuration + make-potluck-configuration + potluck-configuration? + (package potluck-configuration-package ; + (default guix/potluck)) + (scratch potluck-configuration-scratch + (default "/var/cache/potluck/scratch")) + (source potluck-configuration-source + (default "/var/cache/potluck/source")) + (source-repo potluck-configuration-source-repo + (default "/srv/git/source.git")) + (target potluck-configuration-target + (default "/var/cache/potluck/target")) + (target-repo potluck-configuration-target-repo + (default "/srv/git/target.git")) + (user potluck-configuration-user + (default "potluck")) + (group potluck-configuration-group + (default "potluck"))) + +(define potluck-accounts + (match-lambda + (($ + package scratch source source-repo target target-repo user group) + (filter identity + (list + (and (equal? group "potluck") + (user-group + (name "potluck") + (system? #t))) + (and (equal? user "potluck") + (user-account + (name "potluck") + (group group) + (system? #t) + (comment "Potluck Service") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))))))) + +(define potluck-activation-service + (match-lambda + (($ + package scratch source source-repo target target-repo user group) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) (ice-9 ftw)) + (define (chown-r dir user group) + (let ((uid (passwd:uid (getpwnam user))) + (gid (group:gid (getgrnam group)))) + (for-each (lambda (f) (chown f uid gid)) + (find-files dir #:directories? #t)))) + (define (ensure-git-repo dir) + (unless (file-exists? dir) + (mkdir-p dir) + (unless (zero? (system* (string-append #$git "/bin/git") + "init" "--bare" dir)) + (error "failed to create repository" dir)) + (chown-r dir #$user #$group))) + (define (ensure-checkout repo dir) + (unless (file-exists? dir) + (mkdir-p (dirname dir)) + (unless (zero? (system* (string-append #$git "/bin/git") + "clone" repo dir)) + (error "failed to check out repository" repo dir)) + (chown-r dir #$user #$group))) + (mkdir-p #$scratch) + (chown-r #$scratch #$user #$group) + (ensure-git-repo #$source-repo) + (ensure-git-repo #$target-repo) + (ensure-checkout #$source-repo #$source) + (ensure-checkout #$target-repo #$target)))))) + +(define potluck-shepherd-service + (match-lambda + (($ + package scratch source source-repo target target-repo user group) + (list (shepherd-service + (provision '(potluck)) + (documentation "Run the potluck daemon.") + (requirement '(networking)) + + (start #~(make-forkexec-constructor + '(#$(file-append package "/bin/guix") "host-channel" + #$(format #f "--scratch=~a" scratch) + #$(format #f "--source=~a" source) + #$(format #f "--target=~a" target)) + #:user #$user #:group #$group)) + (stop #~(make-kill-destructor))))))) + +(define potluck-service-type + (service-type (name 'potluck) + (extensions + (list (service-extension activation-service-type + potluck-activation-service) + (service-extension shepherd-root-service-type + potluck-shepherd-service) + (service-extension account-service-type + potluck-accounts))) + (default-value (potluck-configuration)))) -- cgit 1.4.1