21/21: home-services: Add Shepherd.

[guix-commits]

wigust pushed a commit to branch wip-guix-home
in repository guix.

commit 6b5ff71b993611d413d3c179b3d50115cd87f408
Author: Andrew Tropin <andrew@trop.in>
AuthorDate: Thu Sep 2 12:33:36 2021 +0300

    home-services: Add Shepherd.
    
    * gnu/home-services/shepherd.scm: New file.
    * gnu/local.mk: Add this.
    * doc/guix.texi: Add documentation about Shepherd Home Service.
    
    Signed-off-by: Oleg Pykhalov <go.wigust@gmail.com>
---
 doc/guix.texi                  |  32 +++++++++-
 gnu/home-services/shepherd.scm | 132 +++++++++++++++++++++++++++++++++++++++++
 gnu/local.mk                   |   1 +
 3 files changed, 164 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 637ec27..e546fcc 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -35689,7 +35689,37 @@ mcron info here
 
 @node Shepherd Home Service
 @subsection Managing User's Daemons
-shepherd info here
+
+@cindex shepherd services
+
+@defvr {Scheme Variable} home-shepherd-service-type
+The service type for the userland Shepherd, which allows one to manage
+long-running processes or one-shot tasks.  User's Shepherd is not an
+init process (PID 1), but almost all other information described in
+(@pxref{Shepherd Services}) is applicable here too.
+
+This is the service type that extensions target when they want to create
+shepherd services (@pxref{Service Types and Services}, for an example).
+Each extension must pass a list of @code{<shepherd-service>}.  Its
+value must be a @code{shepherd-configuration}, as described below.
+@end defvr
+
+@deftp {Data Type} shepherd-configuration
+This data type represents the Shepherd's configuration.
+
+@table @code
+@item shepherd (default: @code{shepherd})
+The Shepherd package to use.
+
+@item auto-start? (default: @code{#t})
+Whether or not to start Shepherd on first login.
+
+@item services (default: @code{'()})
+A list of @code{<shepherd-service>} to start.
+You should probably use the service extension
+mechanism instead (@pxref{Shepherd Services}).
+@end table
+@end deftp
 
 @node Invoking guix home
 @section Invoking @code{guix home}
diff --git a/gnu/home-services/shepherd.scm b/gnu/home-services/shepherd.scm
new file mode 100644
index 0000000..b9fd3c3
--- /dev/null
+++ b/gnu/home-services/shepherd.scm
@@ -0,0 +1,132 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;;
+;;; 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 home-services shepherd)
+  #:use-module (gnu home-services)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu services shepherd)
+  #:use-module (guix sets)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+
+  #:use-module (srfi srfi-1)
+
+  #:re-export (shepherd-service
+               shepherd-action))
+
+(define-record-type* <home-shepherd-configuration>
+  home-shepherd-configuration make-home-shepherd-configuration
+  home-shepherd-configuration?
+  (shepherd home-shepherd-configuration-shepherd
+            (default shepherd)) ; package
+  (auto-start? home-shepherd-configuration-auto-start?
+               (default #t))
+  (services home-shepherd-configuration-services
+            (default '())))
+
+(define (home-shepherd-configuration-file services shepherd)
+  "Return the shepherd configuration file for SERVICES.  SHEPHERD is used
+as shepherd package."
+  (assert-valid-graph services)
+
+  (let ((files (map shepherd-service-file services))
+        ;; TODO: Add compilation of services, it can improve start
+        ;; time.
+        ;; (scm->go (cute scm->go <> shepherd))
+        )
+    (define config
+      #~(begin
+          (use-modules (srfi srfi-34)
+                       (system repl error-handling))
+          (apply
+           register-services
+           (map
+            (lambda (file) (load file))
+            '#$files))
+          (action 'root 'daemonize)
+          (format #t "Starting services...~%")
+          (for-each
+           (lambda (service) (start service))
+           '#$(append-map shepherd-service-provision
+                          (filter shepherd-service-auto-start?
+                                  services)))
+          (newline)))
+
+    (scheme-file "shepherd.conf" config)))
+
+(define (launch-shepherd-gexp config)
+  (let* ((shepherd (home-shepherd-configuration-shepherd config))
+         (services (home-shepherd-configuration-services config)))
+    (if (home-shepherd-configuration-auto-start? config)
+        (with-imported-modules '((guix build utils))
+          #~(let ((log-dir (or (getenv "XDG_LOG_HOME")
+                               (format #f "~a/.local/var/log" (getenv 
"HOME")))))
+              ((@ (guix build utils) mkdir-p) log-dir)
+              (system*
+               #$(file-append shepherd "/bin/shepherd")
+               "--logfile"
+               (string-append
+                log-dir
+                "/shepherd.log")
+               "--config"
+               #$(home-shepherd-configuration-file services shepherd))))
+        #~"")))
+
+(define (reload-configuration-gexp config)
+  (let* ((shepherd (home-shepherd-configuration-shepherd config))
+         (services (home-shepherd-configuration-services config)))
+    #~(system*
+       #$(file-append shepherd "/bin/herd")
+       "load" "root"
+       #$(home-shepherd-configuration-file services shepherd))))
+
+(define (ensure-shepherd-gexp config)
+  #~(if (file-exists?
+         (string-append
+          (or (getenv "XDG_RUNTIME_DIR")
+              (format #f "/run/user/~a" (getuid)))
+          "/shepherd/socket"))
+        #$(reload-configuration-gexp config)
+        #$(launch-shepherd-gexp config)))
+
+(define-public home-shepherd-service-type
+  (service-type (name 'home-shepherd)
+                (extensions
+                 (list (service-extension
+                        home-run-on-first-login-service-type
+                        launch-shepherd-gexp)
+                       (service-extension
+                        home-activation-service-type
+                        ensure-shepherd-gexp)
+                       (service-extension
+                        home-profile-service-type
+                        (lambda (config)
+                          `(,(home-shepherd-configuration-shepherd config))))))
+                (compose concatenate)
+                (extend
+                 (lambda (config extra-services)
+                   (home-shepherd-configuration
+                    (inherit config)
+                    (services
+                     (append (home-shepherd-configuration-services config)
+                             extra-services)))))
+                (default-value (home-shepherd-configuration))
+                (description "Configure and install userland Shepherd.")))
+
+
diff --git a/gnu/local.mk b/gnu/local.mk
index 0e2074a..31ad1a4 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -79,6 +79,7 @@ GNU_SYSTEM_MODULES =                          \
   %D%/home-services/fontutils.scm              \
   %D%/home-services/configuration.scm          \
   %D%/home-services/shells.scm                 \
+  %D%/home-services/shepherd.scm               \
   %D%/home-services/utils.scm                  \
   %D%/home-services/xdg.scm                    \
   %D%/image.scm                                        \