wingo pushed a commit to branch wip-potluck
in repository guix.
commit eb81966f4a6380446ea98f91e5cccb6746c5e242
Author: Andy Wingo <wi...@igalia.com>
Date: Thu Apr 27 10:48:28 2017 +0200
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(+)
diff --git a/doc/guix.texi b/doc/guix.texi
index bc2a4d0..8e53327 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 ac0c9d5..2e0468f 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 0000000..cbabaa5
--- /dev/null
+++ b/gnu/services/potluck.scm
@@ -0,0 +1,141 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Andy Wingo <wi...@igalia.com>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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> potluck-configuration
+ make-potluck-configuration
+ potluck-configuration?
+ (package potluck-configuration-package ;<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
+ (($ <potluck-configuration>
+ 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
+ (($ <potluck-configuration>
+ 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
+ (($ <potluck-configuration>
+ 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))))
