3588bb0f4a
* gnu/home-services.scm (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): New variables. * gnu/local.mk (GNU_SYSTEM_MODULES): Add home-services.scm. Signed-off-by: Oleg Pykhalov <go.wigust@gmail.com>
369 lines
15 KiB
Scheme
369 lines
15 KiB
Scheme
;;; 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.
|
|
;;;
|
|
;;; 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.
|
|
;;;
|
|
;;; 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.")))
|
|
|