[bug#50133] [PATCH 6/6] services: Add lxd-service-type.

[Andrew Whatson <whatson@gmail.com>]

* gnu/services/virtualization.scm (lxd-configuration): New type.
(%lxd-accounts, lxd-service-type): New variables.
(%lxd-activation, lxd-shepherd-service): New procedures.
* gnu/system/file-systems.scm (%elogind-file-systems): Add
"/sys/fs/cgroup/systemd" file-system.
---
 gnu/services/virtualization.scm | 66 +++++++++++++++++++++++++++++++++
 gnu/system/file-systems.scm     | 11 ++++++
 2 files changed, 77 insertions(+)

diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index c8adcd06d0..34ddc94423 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -75,6 +75,9 @@
             virtlog-configuration
             virtlog-service-type
 
+            lxd-configuration
+            lxd-service-type
+
             %qemu-platforms
             lookup-qemu-platforms
             qemu-platform?
@@ -548,6 +551,69 @@ potential infinite waits blocking libvirt."))
    `((libvirt-configuration ,libvirt-configuration-fields))
    'libvirt-configuration))
 
+\f
+;;;
+;;; LXD linux container daemon.
+;;;
+
+(define-configuration lxd-configuration
+  (lxd
+   (package lxd)
+   "LXD package.")
+  (debug?
+   (boolean #f)
+   "Enable or disable debug messages.")
+  (verbose?
+   (boolean #f)
+   "Enable or disable information messages."))
+
+(define %lxd-accounts
+  (list (user-group (name "lxd") (system? #t))))
+
+(define (%lxd-activation config)
+  #~(begin
+      (use-modules (guix build utils))
+      (mkdir-p "/var/log/lxd")))
+
+(define (lxd-shepherd-service config)
+  (let* ((lxd (lxd-configuration-lxd config))
+         (debug? (lxd-configuration-debug? config))
+         (verbose? (lxd-configuration-verbose? config)))
+    (list
+     (shepherd-service
+      (documentation "LXD daemon.")
+      (provision '(lxd))
+      (requirement '(dbus-system
+                     elogind
+                     file-system-/sys/fs/cgroup/blkio
+                     file-system-/sys/fs/cgroup/cpu
+                     file-system-/sys/fs/cgroup/cpuset
+                     file-system-/sys/fs/cgroup/devices
+                     file-system-/sys/fs/cgroup/memory
+                     file-system-/sys/fs/cgroup/pids
+                     file-system-/sys/fs/cgroup/systemd
+                     networking
+                     udev))
+      (start #~(make-forkexec-constructor
+                (list (string-append #$lxd "/bin/lxd")
+                      "--group=lxd"
+                      "--logfile=/var/log/lxd/lxd.log"
+                      #$@(if debug? '("--debug") '())
+                      #$@(if verbose? '("--verbose") '()))))
+      (stop #~(make-kill-destructor))))))
+
+(define lxd-service-type
+  (service-type
+   (name 'lxd)
+   (extensions
+    (list (service-extension activation-service-type
+                             %lxd-activation)
+          (service-extension shepherd-root-service-type
+                             lxd-shepherd-service)
+          (service-extension account-service-type
+                             (const %lxd-accounts))))
+   (default-value (lxd-configuration))))
+
 \f
 ;;;
 ;;; Transparent QEMU emulation via binfmt_misc.
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index b9eda80958..7c3777298b 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -499,6 +499,17 @@ TARGET in the other system."
            (check? #f)
            (options "none,name=elogind")
            (create-mount-point? #t)
+           (dependencies (list (car %control-groups))))
+         ;; The systemd cgroup needs to exist to run systemd inside linux
+         ;; containers (eg. via LXD).  This is *not* required for elogind, but
+         ;; keeping it with the other systemd hacks seemed sensible, for now.
+         (file-system
+           (device "cgroup")
+           (mount-point "/sys/fs/cgroup/systemd")
+           (type "cgroup")
+           (check? #f)
+           (options "none,name=systemd")
+           (create-mount-point? #t)
            (dependencies (list (car %control-groups)))))
    %control-groups))
 
-- 
2.32.0