From e7e3af766279d4e3e87cfe9eeb6458afb1f3bfe4 Mon Sep 17 00:00:00 2001
From: Petr Hodina <phodina@protonmail.com>
Date: Wed, 22 Dec 2021 21:31:59 +0100
Subject: [PATCH v2 7/7] services: Add lxd-service-type.

* 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.

diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 41afe451c1..15ee30f8e0 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -76,6 +76,9 @@ (define-module (gnu services virtualization)
             virtlog-configuration
             virtlog-service-type
 
+            lxd-configuration
+            lxd-service-type
+
             %qemu-platforms
             lookup-qemu-platforms
             qemu-platform?
@@ -562,6 +565,69 @@ (define (generate-libvirt-documentation)
    `((libvirt-configuration ,libvirt-configuration-fields))
    'libvirt-configuration))
 
+
+;;;
+;;; 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))))
+
 
 ;;;
 ;;; Transparent QEMU emulation via binfmt_misc.
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index f8f4276283..01e36268df 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -561,6 +561,17 @@ (define %elogind-file-systems
            (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.36.1