diff mbox series

[bug#49419,1/4] home-services: Add most essential home services

Message ID 87wnq4hivq.fsf@trop.in
State Accepted
Headers show
Series Essential home services | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job
cbaines/issue success View issue

Commit Message

Andrew Tropin July 5, 2021, 3:37 p.m. UTC 
home-service-type is a root of home services DAG.

home-profile-service-type is almost the same as profile-service-type, at least
for now.

home-environment-variables-service-type generates a @file{setup-environment}
shell script, which is expected to be sourced by login shell or other program,
which starts early and spawns all other processes.  Home services for shells
automatically add code for sourcing this file, if person do not use those home
services they have to source this script manually in their's shell *profile
file (details described in the manual).

home-files-service-type is similar to etc-service-type, but doesn't extend
home-activation, because deploy mechanism for config files is pluggable and
can be different for different home environments: The default one is called
symlink-manager (will be introudced in a separate patch series), which creates
links for various dotfiles (like $XDG_CONFIG_HOME/$APP/...) to store, but is
possible to implement alternative approaches like read-only home from Julien's
guix-home-manager.

home-run-on-first-login-service-type provides an @file{on-first-login} guile
script, which runs provided gexps once, when user makes first login.  It can
be used to start user's Shepherd and maybe some other process.  It relies on
assumption that /run/user/$UID will be created on login by some login
manager (elogind for example).

home-activation-service-type provides an @file{activate} guile script, which
do three main things:

- Sets environment variables to the values declared in
@file{setup-environment} shell script.  It's necessary, because user can set
for example XDG_CONFIG_HOME and it should be respected by activation gexp of
symlink-manager.

- Sets GUIX_NEW_HOME and possibly GUIX_OLD_HOME vars to paths in the store.
Later those variables can be used by activation gexps, for example by
symlink-manager or run-on-change services.

- Run all activation gexps provided by other home services.
---
 gnu/home-services.scm | 328 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 328 insertions(+)
 create mode 100644 gnu/home-services.scm

Comments

M July 5, 2021, 3:47 p.m. UTC | #1 
Hi,

Andrew Tropin schreef op ma 05-07-2021 om 18:37 [+0300]:
> +       (if (file-exists? (he-init-file new-home))
> +           (let* ((port   ((@@ (ice-9 popen) open-input-pipe)
> +                          (format #f "source ~a && env"
> +                                   (he-init-file new-home))))
> +                 (result ((@@ (ice-9 rdelim) read-delimited) "" port))
> +                 (vars (map (lambda (x)
> +                               (let ((si (string-index x #\=)))
> +                                 (cons (string-take x si)
> +                                       (string-drop x (1+ si)))))
> +                            ((@@ (srfi srfi-1) remove)
> +                             string-null?
> +                              (string-split result #\newline)))))

Why are you using @@ here?  'open-input-pipe', 'read-delimited' and 'remove'
are exported variables, so you can just use @ instead of the magic evil @@
operator.

From the guile manual:

 -- syntax: @ module-name binding-name
     Refer to the binding named BINDING-NAME in module MODULE-NAME.  The
     binding must have been exported by the module.

 -- syntax: @@ module-name binding-name
     Refer to the binding named BINDING-NAME in module MODULE-NAME.  The
     binding must not have been exported by the module.  This syntax is
     only intended for debugging purposes or as a last resort.  *Note
     Declarative Modules::, for some limitations on the use of ‘@@’.

Greetings,
Maxime.
Andrew Tropin July 5, 2021, 4:19 p.m. UTC | #2 
Maxime Devos <maximedevos@telenet.be> writes:

> Hi,
>
> Andrew Tropin schreef op ma 05-07-2021 om 18:37 [+0300]:
>> +       (if (file-exists? (he-init-file new-home))
>> +           (let* ((port   ((@@ (ice-9 popen) open-input-pipe)
>> +                          (format #f "source ~a && env"
>> +                                   (he-init-file new-home))))
>> +                 (result ((@@ (ice-9 rdelim) read-delimited) "" port))
>> +                 (vars (map (lambda (x)
>> +                               (let ((si (string-index x #\=)))
>> +                                 (cons (string-take x si)
>> +                                       (string-drop x (1+ si)))))
>> +                            ((@@ (srfi srfi-1) remove)
>> +                             string-null?
>> +                              (string-split result #\newline)))))
>
> Why are you using @@ here?  'open-input-pipe', 'read-delimited' and 'remove'
> are exported variables, so you can just use @ instead of the magic evil @@
> operator.

Because of a bad habbit, I needed it once and after that started to use
it uncoditionally.  It should be @, thanks for pointing!

BTW, how to add changes to the patches?  Do I need to resend a
particular patch with required updates or have to wait other reviews and
send a v2 patch series?
M July 5, 2021, 7:19 p.m. UTC | #3 
Andrew Tropin schreef op ma 05-07-2021 om 19:19 [+0300]:
> Maxime Devos <maximedevos@telenet.be> writes:
> 
> [...]
>
> BTW, how to add changes to the patches?  Do I need to resend a
> particular patch with required updates or have to wait other reviews and
> send a v2 patch series?

I would do a combination of those: reply to the mail of the reviewer with a
revised patch attached.  When you have received a ‘sufficient’ number of reviews
from others on the other patches in the series as well, send a v2.

Some benefits of this method:

  (1) it should be clear which patches should be applied,
      as the number of 'revised patches' without sending a new series
      version is limited.

      This is also the case if you send a new version after each little change,
      but can easily become _not_ the cas if you always respond with a revised
      patch without starting a new series version.

  (2) you don't clutter the mailboxes with new version after new version
      after each little change.

      This is particularily important if you have large patch series (say 13 or
      more patches), which doesn't seem to apply here.

WDYT?

Greetings,
Maxime.
Andrew Tropin July 6, 2021, 7:09 a.m. UTC | #4 
Maxime Devos <maximedevos@telenet.be> writes:

> Andrew Tropin schreef op ma 05-07-2021 om 19:19 [+0300]:
>> Maxime Devos <maximedevos@telenet.be> writes:
>> 
>> [...]
>>
>> BTW, how to add changes to the patches?  Do I need to resend a
>> particular patch with required updates or have to wait other reviews and
>> send a v2 patch series?
>
> I would do a combination of those: reply to the mail of the reviewer with a
> revised patch attached.  When you have received a ‘sufficient’ number of reviews
> from others on the other patches in the series as well, send a v2.
>
> Some benefits of this method:
>
>   (1) it should be clear which patches should be applied,
>       as the number of 'revised patches' without sending a new series
>       version is limited.
>
>       This is also the case if you send a new version after each little change,
>       but can easily become _not_ the cas if you always respond with a revised
>       patch without starting a new series version.
>
>   (2) you don't clutter the mailboxes with new version after new version
>       after each little change.
>
>       This is particularily important if you have large patch series (say 13 or
>       more patches), which doesn't seem to apply here.
>
> WDYT?

I came up with one more approach: I can send a patch, which address the
issues reviewer mentioned and after getting more reviews from other
peers I can rebase my original commits and incorparate all the
later patches to them and prepare v2 series.

[PATCH 0/4]
[PATCH 1/4]
fix1 to address issue from subthread1 reported by r1
fix2 to address issue from subthread2 reported by r2
fix3 to address issue from subthread2 came during discussion with r1 and r2
[PATCH 2/4]
...

Such approach makes it clear how the comments were addressed, because
now you see a diff, not the whole new patch.  On the other hand it can
be a little harder to reply, because you don't have the latest version
of the patch, but have only original patch and updates to it, so you
need to pick, which one you want to reply to.

I will try this one, to find its weak points.  It's better to practice
on this small patch series, rather something huge)

Another question: Is it better to inline or attach patches?
M July 6, 2021, 8:26 a.m. UTC | #5 
Andrew Tropin schreef op di 06-07-2021 om 10:09 [+0300]:
> Another question: Is it better to inline or attach patches?

FWIW, I can read both just fine in my e-mail application (evolution).
When it's inline, I can read the patch directly but also have
an option to save it somewhere.  When it is attached, there is some
button for ‘expanding’ the attachement so I can read it.  Both
work for me.  I don't know about other mail applications.

Greetings,
Maxime.
diff mbox series

Patch

diff --git a/gnu/home-services.scm b/gnu/home-services.scm
new file mode 100644
index 0000000000..44a7e68934
--- /dev/null
+++ b/gnu/home-services.scm
@@ -0,0 +1,328 @@ 
+;;; 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)
+  #:use-module (gnu services)
+  #:use-module (guix channels)
+  #:use-module (guix monads)
+  #:use-module (guix store)
+  #:use-module (guix gexp)
+  #:use-module (guix profiles)
+  #:use-module (guix sets)
+  #:use-module (guix ui)
+  #:use-module (guix discovery)
+  #:use-module (guix diagnostics)
+
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+
+  #:export (home-service-type
+	    home-profile-service-type
+	    home-environment-variables-service-type
+	    home-files-service-type
+	    home-run-on-first-login-service-type
+            home-activation-service-type)
+
+  #:re-export (service
+	       service-type
+	       service-extension))
+
+;;; Comment:
+;;;
+;;; This module is similar to (gnu system services) module, but
+;;; provides Home Services, which are supposed to be used for building
+;;; home-environment.
+;;;
+;;; Home Services use the same extension as System Services.  Consult
+;;; (gnu system services) module or manual for more information.
+;;;
+;;; Code:
+
+
+(define (home-derivation entries mextensions)
+  "Return as a monadic value the derivation of the 'home'
+directory containing the given entries."
+  (mlet %store-monad ((extensions (mapm/accumulate-builds identity
+                                                          mextensions)))
+    (lower-object
+     (file-union "home" (append entries (concatenate extensions))))))
+
+(define home-service-type
+  ;; This is the ultimate service type, the root of the home service
+  ;; DAG.  The service of this type is extended by monadic name/item
+  ;; pairs.  These items end up in the "home-environment directory" as
+  ;; returned by 'home-environment-derivation'.
+  (service-type (name 'home)
+                (extensions '())
+                (compose identity)
+                (extend home-derivation)
+		(default-value '())
+                (description
+                 "Build the home environment top-level directory,
+which in turn refers to everything the home environment needs: its
+packages, configuration files, activation script, and so on.")))
+
+(define (packages->profile-entry packages)
+  "Return a system entry for the profile containing PACKAGES."
+  ;; XXX: 'mlet' is needed here for one reason: to get the proper
+  ;; '%current-target' and '%current-target-system' bindings when
+  ;; 'packages->manifest' is called, and thus when the 'package-inputs'
+  ;; etc. procedures are called on PACKAGES.  That way, conditionals in those
+  ;; inputs see the "correct" value of these two parameters.  See
+  ;; <https://issues.guix.gnu.org/44952>.
+  (mlet %store-monad ((_ (current-target-system)))
+    (return `(("profile" ,(profile
+                           (content (packages->manifest
+                                     (map identity
+                                     ;;(options->transformation transformations)
+                                     (delete-duplicates packages eq?))))))))))
+
+;; MAYBE: Add a list of transformations for packages.  It's better to
+;; place it in home-profile-service-type to affect all profile
+;; packages and prevent conflicts, when other packages relies on
+;; non-transformed version of package.
+(define home-profile-service-type
+  (service-type (name 'home-profile)
+                (extensions
+                 (list (service-extension home-service-type
+                                          packages->profile-entry)))
+                (compose concatenate)
+                (extend append)
+                (description
+                 "This is the @dfn{home profile} and can be found in
+@file{~/.guix-home/profile}.  It contains packages and
+configuration files that the user has declared in their
+@code{home-environment} record.")))
+
+(define (environment-variables->setup-environment-script vars)
+  "Return a file that can be sourced by a POSIX compliant shell which
+initializes the environment.  The file will source the home
+environment profile, set some default environment variables, and set
+environment variables provided in @code{vars}.  @code{vars} is a list
+of pairs (@code{(key . value)}), @code{key} is a string and
+@code{value} is a string or gexp.
+
+If value is @code{#f} variable will be omitted.
+If value is @code{#t} variable will be just exported.
+For any other, value variable will be set to the @code{value} and
+exported."
+  (define (warn-about-duplicate-defenitions)
+    (fold
+     (lambda (x acc)
+       (when (equal? (car x) (car acc))
+	 (warning
+	  (G_ "duplicate definition for `~a' environment variable ~%") (car x)))
+       x)
+     (cons "" "")
+     (sort vars (lambda (a b)
+		  (string<? (car a) (car b))))))
+
+  (warn-about-duplicate-defenitions)
+  (with-monad
+   %store-monad
+   (return
+    `(("setup-environment"
+       ;; TODO: It's necessary to source ~/.guix-profile too
+       ;; on foreign distros
+       ,(apply mixed-text-file "setup-environment"
+	       "\
+HOME_ENVIRONMENT=$HOME/.guix-home
+GUIX_PROFILE=\"$HOME_ENVIRONMENT/profile\"
+PROFILE_FILE=\"$HOME_ENVIRONMENT/profile/etc/profile\"
+[ -f $PROFILE_FILE ] && . $PROFILE_FILE
+
+case $XDG_DATA_DIRS in
+  *$HOME_ENVIRONMENT/profile/share*) ;;
+  *) export XDG_DATA_DIRS=$HOME_ENVIRONMENT/profile/share:$XDG_DATA_DIRS ;;
+esac
+case $MANPATH in
+  *$HOME_ENVIRONMENT/profile/share/man*) ;;
+  *) export MANPATH=$HOME_ENVIRONMENT/profile/share/man:$MANPATH
+esac
+case $INFOPATH in
+  *$HOME_ENVIRONMENT/profile/share/info*) ;;
+  *) export INFOPATH=$HOME_ENVIRONMENT/profile/share/info:$INFOPATH ;;
+esac
+case $XDG_CONFIG_DIRS in
+  *$HOME_ENVIRONMENT/profile/etc/xdg*) ;;
+  *) export XDG_CONFIG_DIRS=$HOME_ENVIRONMENT/profile/etc/xdg:$XDG_CONFIG_DIRS ;;
+esac
+case $XCURSOR_PATH in
+  *$HOME_ENVIRONMENT/profile/share/icons*) ;;
+  *) export XCURSOR_PATH=$HOME_ENVIRONMENT/profile/share/icons:$XCURSOR_PATH ;;
+esac
+
+"
+
+	       (append-map
+		(match-lambda
+		  ((key . #f)
+		   '())
+		  ((key . #t)
+		   (list "export " key "\n"))
+		  ((key . value)
+                   (list "export " key "=" value "\n")))
+		vars)))))))
+
+(define home-environment-variables-service-type
+  (service-type (name 'home-environment-variables)
+                (extensions
+                 (list (service-extension
+			home-service-type
+                        environment-variables->setup-environment-script)))
+                (compose concatenate)
+                (extend append)
+		(default-value '())
+                (description "Set the environment variables.")))
+
+(define (files->files-directory files)
+  "Return a @code{files} directory that contains FILES."
+  (define (assert-no-duplicates files)
+    (let loop ((files files)
+               (seen (set)))
+      (match files
+        (() #t)
+        (((file _) rest ...)
+         (when (set-contains? seen file)
+           (raise (formatted-message (G_ "duplicate '~a' entry for files/")
+                                     file)))
+         (loop rest (set-insert file seen))))))
+
+  ;; Detect duplicates early instead of letting them through, eventually
+  ;; leading to a build failure of "files.drv".
+  (assert-no-duplicates files)
+
+  (file-union "files" files))
+
+(define (files-entry files)
+  "Return an entry for the @file{~/.guix-home/files}
+directory containing FILES."
+  (with-monad %store-monad
+    (return `(("files" ,(files->files-directory files))))))
+
+(define home-files-service-type
+  (service-type (name 'home-files)
+                (extensions
+                 (list (service-extension home-service-type
+                                          files-entry)))
+                (compose concatenate)
+                (extend append)
+		(default-value '())
+                (description "Configuration files for programs that
+will be put in @file{~/.guix-home/files}.")))
+
+(define (compute-on-first-login-script _ gexps)
+  (gexp->script
+   "on-first-login"
+   #~(let* ((xdg-runtime-dir (or (getenv "XDG_RUNTIME_DIR")
+				 (format #f "/run/user/~a" (getuid))))
+	    (flag-file-path (string-append
+			     xdg-runtime-dir "/on-first-login-executed"))
+	    (touch (lambda (file-name)
+		     (call-with-output-file file-name (const #t)))))
+       ;; XDG_RUNTIME_DIR dissapears on logout, that means such trick
+       ;; allows to launch on-first-login script on first login only
+       ;; after complete logout/reboot.
+       (when (not (file-exists? flag-file-path))
+	 (begin #$@gexps (touch flag-file-path))))))
+
+(define (on-first-login-script-entry m-on-first-login)
+  "Return, as a monadic value, an entry for the on-first-login script
+in the home environment directory."
+  (mlet %store-monad ((on-first-login m-on-first-login))
+	(return `(("on-first-login" ,on-first-login)))))
+
+(define home-run-on-first-login-service-type
+  (service-type (name 'home-run-on-first-login)
+                (extensions
+                 (list (service-extension
+			home-service-type
+                        on-first-login-script-entry)))
+                (compose identity)
+                (extend compute-on-first-login-script)
+		(default-value #f)
+                (description "Run gexps on first user login.  Can be
+extended with one gexp.")))
+
+
+(define (compute-activation-script init-gexp gexps)
+  (gexp->script
+   "activate"
+   #~(let* ((he-init-file (lambda (he) (string-append he "/setup-environment")))
+            (he-path (string-append (getenv "HOME") "/.guix-home"))
+            (new-home-env (getenv "GUIX_NEW_HOME"))
+            (new-home (or new-home-env
+                          ;; Path of the activation file if called interactively
+                          (dirname (car (command-line)))))
+            (old-home-env (getenv "GUIX_OLD_HOME"))
+            (old-home (or old-home-env
+                          (if (file-exists? (he-init-file he-path))
+                              (readlink he-path)
+                              #f))))
+       (if (file-exists? (he-init-file new-home))
+           (let* ((port   ((@@ (ice-9 popen) open-input-pipe)
+		           (format #f "source ~a && env"
+                                   (he-init-file new-home))))
+	          (result ((@@ (ice-9 rdelim) read-delimited) "" port))
+	          (vars (map (lambda (x)
+                               (let ((si (string-index x #\=)))
+                                 (cons (string-take x si)
+                                       (string-drop x (1+ si)))))
+			     ((@@ (srfi srfi-1) remove)
+			      string-null?
+                              (string-split result #\newline)))))
+	     (close-port port)
+	     (map (lambda (x) (setenv (car x) (cdr x))) vars)
+
+             (setenv "GUIX_NEW_HOME" new-home)
+             (setenv "GUIX_OLD_HOME" old-home)
+
+             #$@gexps
+
+             ;; Do not unset env variable if it was set outside.
+             (unless new-home-env (setenv "GUIX_NEW_HOME" #f))
+             (unless old-home-env (setenv "GUIX_OLD_HOME" #f)))
+           (format #t "\
+Activation script was either called or loaded by file from this direcotry:
+~a
+It doesn't seem that home environment is somewhere around.
+Make sure that you call ./activate by symlink from -home store item.\n"
+                   new-home)))))
+
+(define (activation-script-entry m-activation)
+  "Return, as a monadic value, an entry for the activation script
+in the home environment directory."
+  (mlet %store-monad ((activation m-activation))
+    (return `(("activate" ,activation)))))
+
+(define home-activation-service-type
+  (service-type (name 'home-activation)
+                (extensions
+                 (list (service-extension
+			home-service-type
+                        activation-script-entry)))
+                (compose identity)
+                (extend compute-activation-script)
+		(default-value #f)
+                (description "Run gexps to activate the current
+generation of home environment and update the state of the home
+directory.  @command{activate} script automatically called during
+reconfiguration or generation switching.  This service can be extended
+with one gexp, but many times, and all gexps must be idempotent.")))
+