diff options
| -rw-r--r-- | Makefile.am | 3 | ||||
| -rw-r--r-- | doc/guix.texi | 738 | ||||
| -rw-r--r-- | doc/he-config-bare-bones.scm | 24 | ||||
| -rw-r--r-- | etc/news.scm | 30 | ||||
| -rw-r--r-- | gnu/home-services.scm | 524 | ||||
| -rw-r--r-- | gnu/home-services/configuration.scm | 107 | ||||
| -rw-r--r-- | gnu/home-services/fontutils.scm | 65 | ||||
| -rw-r--r-- | gnu/home-services/mcron.scm | 115 | ||||
| -rw-r--r-- | gnu/home-services/shells.scm | 634 | ||||
| -rw-r--r-- | gnu/home-services/shepherd.scm | 134 | ||||
| -rw-r--r-- | gnu/home-services/symlink-manager.scm | 247 | ||||
| -rw-r--r-- | gnu/home-services/utils.scm | 77 | ||||
| -rw-r--r-- | gnu/home-services/xdg.scm | 476 | ||||
| -rw-r--r-- | gnu/home.scm | 106 | ||||
| -rw-r--r-- | gnu/local.mk | 11 | ||||
| -rw-r--r-- | guix/scripts/home.scm | 512 | ||||
| -rw-r--r-- | guix/scripts/home/import.scm | 241 | ||||
| -rw-r--r-- | guix/self.scm | 13 |
18 files changed, 4053 insertions, 4 deletions
diff --git a/Makefile.am b/Makefile.am index 042cf28464..b66789fa0b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -15,6 +15,7 @@ # Copyright © 2018 Alex Vong <alexvong1995@gmail.com> # Copyright © 2019 Efraim Flashner <efraim@flashner.co.il> # Copyright © 2021 Chris Marusich <cmmarusich@gmail.com> +# Copyright © 2021 Andrew Tropin <andrew@trop.in> # # This file is part of GNU Guix. # @@ -295,6 +296,8 @@ MODULES = \ guix/scripts/system.scm \ guix/scripts/system/search.scm \ guix/scripts/system/reconfigure.scm \ + guix/scripts/home.scm \ + guix/scripts/home/import.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ guix/scripts/import/crate.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 4bf14014eb..7956652050 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -96,6 +96,7 @@ Copyright @copyright{} 2021 Domagoj Stolfa@* Copyright @copyright{} 2021 Hui Lu@* Copyright @copyright{} 2021 pukkamustard@* Copyright @copyright{} 2021 Alice Brenon@* +Copyright @copyright{} 2021 Andrew Tropin@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -167,6 +168,7 @@ Weblate} (@pxref{Translating Guix}). * Programming Interface:: Using Guix in Scheme. * Utilities:: Package management commands. * System Configuration:: Configuring the operating system. +* Home Configuration:: Configuring the home environment. * Documentation:: Browsing software user manuals. * Installing Debugging Files:: Feeding the debugger. * Security Updates:: Deploying security fixes quickly. @@ -328,6 +330,10 @@ System Configuration * Running Guix in a VM:: How to run Guix System in a virtual machine. * Defining Services:: Adding new service definitions. +Home Environment Configuration + +* Invoking guix home:: Instantiating a home environment configuration. + Services * Base Services:: Essential system services. @@ -16181,9 +16187,9 @@ This is the type of the @code{mcron} service, whose value is an @code{mcron-configuration} object. This service type can be the target of a service extension that provides -it additional job specifications (@pxref{Service Composition}). In -other words, it is possible to define services that provide additional -mcron jobs to run. +additional job specifications (@pxref{Service Composition}). In other +words, it is possible to define services that provide additional mcron +jobs to run. @end defvr @deftp {Data Type} mcron-configuration @@ -35357,6 +35363,732 @@ system: This service represents PID@tie{}1. @end defvr +@node Home Configuration +@chapter Home Configuration +@cindex home configuration +Guix supports declarative configuration of @dfn{home environments} by +utilizing the configuration mechanism described in the previous chapter +(@pxref{Defining Services}), but for user's dotfiles and packages. It +works both on Guix System and foreign distros and allows users to +declare all the packages and services that should be installed and +configured for the user. Once a user has written a file containing +@code{home-environment} record, such a configuration can be +@dfn{instantiated} by an unprivileged user with the @command{guix home} +command (@pxref{Invoking guix home}). +@c Maybe later, it will be possible to make home configuration a part of +@c system configuration to make everything managed by guix system. + +@quotation Note +The functionality described in this section is still under development +and is subject to change. Get in touch with us on +@email{guix-devel@@gnu.org}! +@end quotation + +The user's home environment usually consists of three basic parts: +software, configuration, and state. Software in mainstream distros are +usually installed system-wide, but with GNU Guix most software packages +can be installed on a per-user basis without needing root privileges, +and are thus considered part of the user’s @dfn{home environment}. +Packages on their own not very useful in many cases, because often they +require some additional configuration, usually config files that reside +in @env{XDG_CONFIG_HOME} (@file{~/.config} by default) or other +directories. Everything else can be considered state, like media files, +application databases, and logs. + +Using Guix for managing home environments provides a number of +advantages: + +@itemize + +@item All software can be configured in one language (Guile Scheme), +this gives users the ability to share values between configurations of +different programs. + +@item A well-defined home environment is self-contained and can be +created in a declarative and reproducible way---there is no need to grab +external binaries or manually edit some configuration file. + +@item After every @command{guix home reconfigure} invocation, a new home +environment generation will be created. This means that users can +rollback to a previous home environment generation so they don’t have to +worry about breaking their configuration. + +@item It is possible to manage stateful data with Guix Home, this +includes the ability to automatically clone Git repositories on the +initial setup of the machine, and periodically running commands like +@command{rsync} to sync data with another host. This functionality is +still in an experimental stage, though. + +@end itemize + +@menu +* Declaring the Home Environment:: Customizing your Home. +* Configuring the Shell:: Enabling home environment. +* Home Services:: Specifying home services. +* Invoking guix home:: Instantiating a home configuration. +@end menu + +@node Declaring the Home Environment +@section Declaring the Home Environment +The home environment is configured by providing a +@code{home-environment} declaration in a file that can be passed to the +@command{guix home} command (@pxref{Invoking guix home}). A simple +setup can include Bash and a custom text configuration, like in the +example below. Don't be afraid to declare home environment parts, which +overlaps with your current dotfiles, before installing any configuration +files, Guix Home will back up existing config files to a separate place +in the home folder. + +@quotation Note +It is highly recommended that you manage your shell or shells with Guix +Home, because it will make sure that all the necessary scripts are +sourced by the shell configuration file. Otherwise you will need to do +it manually. (@pxref{Configuring the Shell}). +@end quotation + +@findex home-environment +@lisp +@include he-config-bare-bones.scm +@end lisp + +The @code{packages} field should be self-explanatory, it will install +the list of packages into the user's profile. The most important field +is @code{services}, it contains a list of @dfn{home services}, which are +the basic building blocks of a home environment. + +There is no daemon (at least not necessarily) related to a home service, +a home service is just an element that is used to declare part of home +environment and extend other parts of it. The extension mechanism +discussed in the previous chapter (@pxref{Defining Services}) should not +be confused with @ref{Shepherd Services}. Using this extension +mechanism and some Scheme code that glues things together gives the user +the freedom to declare their own, very custom, home environments. + +@node Configuring the Shell +@section Configuring the Shell +This section is safe to skip if your shell or shells are managed by +Guix Home. Otherwise, read it carefully. + +There are a few scripts that must be evaluated by a login shell to +activate the home environment. The shell startup files only read by +login shells often have @code{profile} suffix. For more information +about login shells see @ref{Invoking Bash,,, bash, The GNU Bash +Reference Manual} and see @ref{Bash Startup Files,,, bash, The GNU Bash +Reference Manual}. + +The first script that needs to be sourced is @file{setup-environment}, +which sets all the necessary environment variables (including variables +declared by the user) and the second one is @file{on-first-login}, which +starts Shepherd for the current user and performs actions declared by +other home services that extends +@code{home-run-on-first-login-service-type}. + +Guix Home will always create @file{~/.profile}, which contains the +following lines: + +@example +HOME_ENVIRONMENT=$HOME/.guix-home +. $HOME_ENVIRONMENT/setup-environment +$HOME_ENVIRONMENT/on-first-login +@end example + +This makes POSIX compliant login shells activate the home environment. +However, in most cases this file won't be read by most modern shells, +because they are run in non POSIX mode by default and have their own +@file{*profile} startup files. For example Bash will prefer +@file{~/.bash_profile} in case it exists and only if it doesn't will it +fallback to @file{~/.profile}. Zsh (if no additional options are +specified) will ignore @file{~/.profile}, even if @file{~/.zprofile} +doesn't exist. + +To make your shell respect @file{~/.profile}, add @code{. ~/.profile} or +@code{source ~/profile} to the startup file for the login shell. In +case of Bash, it is @file{~/.bash_profile}, and in case of Zsh, it is +@file{~/.zprofile}. + +@quotation Note +This step is only required if your shell is NOT managed by Guix Home. +Otherwise, everything will be done automatically. +@end quotation + +@node Home Services +@section Home Services +@cindex home services + +A @dfn{home service} is not necessarily something that has a daemon and +is managed by Shepherd (@pxref{Jump Start,,, shepherd, The GNU Shepherd +Manual}), in most cases it doesn't. It's a simple building block of the +home environment, often declaring a set of packages to be installed in +the home environment profile, a set of config files to be symlinked into +@env{XDG_CONFIG_HOME} (@file{~/.config} by default), and environment +variables to be set by a login shell. + +There is a service extension mechanism (@pxref{Service Composition}) +which allows home services to extend other home services and utilize +capabilities they provide; for example: declare mcron jobs +(@pxref{Top,,, mcron, GNU@tie{}Mcron}) by extending @ref{Mcron Home +Service}; declare daemons by extending @ref{Shepherd Home Service}; add +commands, which will be invoked on by the Bash by extending +@ref{Shells Home Services, @code{home-bash-service-type}}. + +A good way to discover avaliable home services is using the +@command{guix home search} command (@pxref{Invoking guix home}). After +the required home services are found, include its module with the +@code{use-modules} form (@pxref{use-modules,, Using Guile Modules, +guile, The GNU Guile Reference Manual}), or the @code{#:use-modules} +directive (@pxref{define-module,, Creating Guile Modules, guile, The GNU +Guile Reference Manual}) and declare a home service using the +@code{service} function, or extend a service type by declaring a new +service with the @code{simple-service} procedure from @code{(gnu +services)}. + +@menu +* Essential Home Services:: Environment variables, packages, on-* scripts. +* Shells: Shells Home Services. POSIX shells, Bash, Zsh. +* Mcron: Mcron Home Service. Scheduled User's Job Execution. +* Shepherd: Shepherd Home Service. Managing User's Daemons. +@end menu +@c In addition to that Home Services can provide + +@node Essential Home Services +@subsection Essential Home Services +There are a few essential services defined in @code{(gnu +home-services)}, they are mostly for internal use and are required to +build a home environment, but some of them will be useful for the end +user. + +@cindex environment variables + +@defvr {Scheme Variable} home-environment-variables-service-type +The service of this type will be instantiated by every home environment +automatically by default, there is no need to define it, but someone may +want to extend it with a list of pairs to set some environment +variables. + +@lisp +(list ("ENV_VAR1" . "value1") + ("ENV_VAR2" . "value2")) +@end lisp + +The easiest way to extend a service type, without defining new service +type is to use the @code{simple-service} helper from @code{(gnu +services)}. + +@lisp +(simple-service 'some-useful-env-vars-service + home-environment-variables-service-type + `(("LESSHISTFILE" . "$XDG_CACHE_HOME/.lesshst") + ("SHELL" . ,(file-append zsh "/bin/zsh")) + ("USELESS_VAR" . #f) + ("_JAVA_AWT_WM_NONREPARENTING" . #t))) +@end lisp + +If you include such a service in you home environment definition, it +will add the following content to the @file{setup-environment} script +(which is expected to be sourced by the login shell): + +@example +export LESSHISTFILE=$XDG_CACHE_HOME/.lesshst +export SHELL=/gnu/store/2hsg15n644f0glrcbkb1kqknmmqdar03-zsh-5.8/bin/zsh +export _JAVA_AWT_WM_NONREPARENTING +@end example + +@quotation Note +Make sure that module @code{(gnu packages shells)} is imported with +@code{use-modules} or any other way, this namespace contains the +definition of the @code{zsh} packages, which is used in the example +above. +@end quotation + +The association list (@pxref{Association Lists, alists, Association +Lists, guile, The GNU Guile Reference manual}) is a data structure +containing key-value pairs, for +@code{home-environment-variables-service-type} the key is always a +string, the value can be a string, string-valued gexp +(@pxref{G-Expressions}), file-like object (@pxref{G-Expressions, +file-like object}) or boolean. For gexps, the variable will be set to +the value of the gexp; for file-like objects, it will be set to the path +of the file in the store (@pxref{The Store}); for @code{#t}, it will +export the variable without any value; and for @code{#f}, it will omit +variable. + +@end defvr + +@defvr {Scheme Variable} home-profile-service-type +The service of this type will be instantiated by every home environment +automatically, there is no need to define it, but you may want to extend +it with a list of packages if you want to install additional packages +into your profile. Other services, which need to make some programs +avaliable to the user will also extend this service type. + +The extension value is just a list of packages: + +@lisp +(list htop vim emacs) +@end lisp + +The same approach as @code{simple-service} (@pxref{Service Reference, +simple-service}) for @code{home-environment-variables-service-type} can +be used here, too. Make sure that modules containing the specified +packages are imported with @code{use-modules}. To find a package or +information about its module use @command{guix search} (@pxref{Invoking +guix package}). Alternatively, @code{specification->package} can be +used to get the package record from string without importing related +module. +@end defvr + +There are few more essential services, but users are not expected to +extend them. + +@defvr {Scheme Variable} home-service-type +The root of home services DAG, it generates a folder, which later will be +symlinked to @file{~/.guix-home}, it contains configurations, +profile with binaries and libraries, and some necessary scripts to glue +things together. +@end defvr + +@defvr {Scheme Variable} home-run-on-first-login-service-type +The service of this type generates a Guile script, which is expected to +be executed by the login shell. It is only executed if the special flag +file inside @env{XDG_RUNTIME_DIR} hasn't been created, this prevents +redundant executions of the script if multiple login shells are spawned. + +It can be extended with a gexp. However, to autostart an application, +users @emph{should not} use this service, in most cases it's better to extend +@code{home-shpeherd-service-type} with a Shepherd service +(@pxref{Shepherd Services}), or extend the shell's startup file with +required command using the appropriate service type. +@end defvr + +@defvr {Scheme Variable} home-activation-service-type +The service of this type generates a guile script, which runs on every +@command{guix home reconfigure} invocation or any other action, which +leads to the activation of the home environment. +@end defvr + +@node Shells Home Services +@subsection Shells + +@cindex shell +@cindex login shell +@cindex interactive shell +@cindex bash +@cindex zsh + +Shells play a quite important role in the environment initialization +process, you can configure them manually as described in section +@ref{Configuring the Shell}, but the recommended way is to use home services +listed below. It's both easier and more reliable. + +Each home environment instantiates +@code{home-shell-profile-service-type}, which creates a +@file{~/.profile} startup file for all POSIX-compatible shells. This +file contains all the necessary steps to properly initialize the +environment, but many modern shells like Bash or Zsh prefer their own +startup files, that's why the respective home services +(@code{home-bash-service-type} and @code{home-zsh-service-type}) ensure +that @file{~/.profile} is sourced by @file{~/.bash_profile} and +@file{~/.zprofile}, respectively. + +@subsubheading Shell Profile Service + +@deftp {Data Type} home-shell-profile-configuration +Available @code{home-shell-profile-configuration} fields are: + +@table @asis +@item @code{profile} (default: @code{()}) (type: text-config) +@code{home-shell-profile} is instantiated automatically by +@code{home-environment}, DO NOT create this service manually, it can +only be extended. @code{profile} is a list of strings or gexps, which +will go to @file{~/.profile}. By default @file{~/.profile} contains the +initialization code, which have to be evaluated by login shell to make +home-environment's profile avaliable to the user, but other commands can +be added to the file if it is really necessary. In most cases shell's +configuration files are preferred places for user's customizations. +Extend home-shell-profile service only if you really know what you do. + +@end table + +@end deftp + +@subsubheading Bash Home Service + +@deftp {Data Type} home-bash-configuration +Available @code{home-bash-configuration} fields are: + +@table @asis +@item @code{package} (default: @code{bash}) (type: package) +The Bash package to use. + +@item @code{guix-defaults?} (default: @code{#t}) (type: boolean) +Add sane defaults like reading @file{/etc/bashrc}, coloring output for +@code{ls} provided by guix to @file{.bashrc}. + +@item @code{environment-variables} (default: @code{()}) (type: alist) +Association list of environment variables to set for the Bash session. + +@item @code{bash-profile} (default: @code{()}) (type: text-config) +List of strings or gexps, which will be added to @file{.bash_profile}. +Used for executing user's commands at start of login shell (In most +cases the shell started on tty just after login). @file{.bash_login} +won't be ever read, because @file{.bash_profile} always present. + +@item @code{bashrc} (default: @code{()}) (type: text-config) +List of strings or gexps, which will be added to @file{.bashrc}. Used +for executing user's commands at start of interactive shell (The shell +for interactive usage started by typing @code{bash} or by terminal app +or any other program). + +@item @code{bash-logout} (default: @code{()}) (type: text-config) +List of strings or gexps, which will be added to @file{.bash_logout}. +Used for executing user's commands at the exit of login shell. It won't +be read in some cases (if the shell terminates by exec'ing another +process for example). + +@end table + +@end deftp + +@subsubheading Zsh Home Service + +@deftp {Data Type} home-zsh-configuration +Available @code{home-zsh-configuration} fields are: + +@table @asis +@item @code{package} (default: @code{zsh}) (type: package) +The Zsh package to use. + +@item @code{xdg-flavor?} (default: @code{#t}) (type: boolean) +Place all the configs to @file{$XDG_CONFIG_HOME/zsh}. Makes +@file{~/.zshenv} to set @env{ZDOTDIR} to @file{$XDG_CONFIG_HOME/zsh}. +Shell startup process will continue with +@file{$XDG_CONFIG_HOME/zsh/.zshenv}. + +@item @code{environment-variables} (default: @code{()}) (type: alist) +Association list of environment variables to set for the Zsh session. + +@item @code{zshenv} (default: @code{()}) (type: text-config) +List of strings or gexps, which will be added to @file{.zshenv}. Used +for setting user's shell environment variables. Must not contain +commands assuming the presence of tty or producing output. Will be read +always. Will be read before any other file in @env{ZDOTDIR}. + +@item @code{zprofile} (default: @code{()}) (type: text-config) +List of strings or gexps, which will be added to @file{.zprofile}. Used +for executing user's commands at start of login shell (In most cases the +shell started on tty just after login). Will be read before +@file{.zlogin}. + +@item @code{zshrc} (default: @code{()}) (type: text-config) +List of strings or gexps, which will be added to @file{.zshrc}. Used +for executing user's commands at start of interactive shell (The shell +for interactive usage started by typing @code{zsh} or by terminal app or +any other program). + +@item @code{zlogin} (default: @code{()}) (type: text-config) +List of strings or gexps, which will be added to @file{.zlogin}. Used +for executing user's commands at the end of starting process of login +shell. + +@item @code{zlogout} (default: @code{()}) (type: text-config) +List of strings or gexps, which will be added to @file{.zlogout}. Used +for executing user's commands at the exit of login shell. It won't be +read in some cases (if the shell terminates by exec'ing another process +for example). + +@end table + +@end deftp + +@node Mcron Home Service +@subsection Scheduled User's Job Execution + +@cindex cron +@cindex mcron +@cindex scheduling jobs + +The @code{(gnu home-services mcron)} module provides an interface to +GNU@tie{}mcron, a daemon to run jobs at scheduled times (@pxref{Top,,, +mcron, GNU@tie{}mcron}). The information about system's mcron is +applicable here (@pxref{Scheduled Job Execution}), the only difference +for home services is that they have to be declared in a +@code{home-envirnoment} record instead of an @code{operating-system} +record. + +@defvr {Scheme Variable} home-mcron-service-type +This is the type of the @code{mcron} home service, whose value is an +@code{home-mcron-configuration} object. It allows to manage scheduled +tasks. + +This service type can be the target of a service extension that provides +additional job specifications (@pxref{Service Composition}). In other +words, it is possible to define services that provide additional mcron +jobs to run. +@end defvr + +@deftp {Data Type} home-mcron-configuration +Data type representing the configuration of mcron. + +@table @asis +@item @code{mcron} (default: @var{mcron}) +The mcron package to use. + +@item @code{jobs} +This is a list of gexps (@pxref{G-Expressions}), where each gexp +corresponds to an mcron job specification (@pxref{Syntax, mcron job +specifications,, mcron, GNU@tie{}mcron}). +@end table +@end deftp + +@node Shepherd Home Service +@subsection Managing User's Daemons + +@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} + +Once you have written a home environment declaration (@pxref{Declaring +the Home Environment,,,,}, it can be @dfn{instantiated} using the +@command{guix home} command. The synopsis is: + +@example +guix home @var{options}@dots{} @var{action} @var{file} +@end example + +@var{file} must be the name of a file containing a +@code{home-environment} declaration. @var{action} specifies how the +home environment is instantiated, but there are few auxuliary actions +which don't instantiate it. Currently the following values are +supported: + +@table @code +@item search +Display available home service type definitions that match the given +regular expressions, sorted by relevance: + +@cindex shell +@cindex shell-profile +@cindex bash +@cindex zsh +@example +$ guix home search shell +name: home-shell-profile +location: gnu/home-services/shells.scm:73:2 +extends: home-files +description: Create `~/.profile', which is used for environment initialization ++ of POSIX compatible login shells. Can be extended with a list of strings or ++ gexps. +relevance: 6 + +name: home-zsh-plugin-manager +location: gnu/home-services/shellutils.scm:28:2 +extends: home-zsh home-profile +description: Install plugins in profile and configure Zsh to load them. +relevance: 1 + +name: home-zsh-direnv +location: gnu/home-services/shellutils.scm:69:2 +extends: home-profile home-zsh +description: Enables `direnv' for `zsh'. Adds hook to `.zshrc' and installs a ++ package in the profile. +relevance: 1 + +name: home-zsh-autosuggestions +location: gnu/home-services/shellutils.scm:43:2 +extends: home-zsh-plugin-manager home-zsh +description: Enables Fish-like fast/unobtrusive autosuggestions for `zsh' and ++ sets reasonable default values for some plugin's variables to improve perfomance ++ and adjust behavior: `(history completion)' is set for strategy, manual rebind ++ and async are enabled. +relevance: 1 + +name: home-zsh +location: gnu/home-services/shells.scm:236:2 +extends: home-files home-profile +description: Install and configure Zsh. +relevance: 1 + +name: home-bash +location: gnu/home-services/shells.scm:388:2 +extends: home-files home-profile +description: Install and configure Bash. +relevance: 1 + +@dots{} +@end example + +As for @command{guix package --search}, the result is written in +@code{recutils} format, which makes it easy to filter the output +(@pxref{Top, GNU recutils databases,, recutils, GNU recutils manual}). + +@item reconfigure +Build the home environment described in @var{file}, and switch to it. +Switching means that the activation script will be evaluated and (in +basic scenario) symlinks to configuration files generated from +@code{home-environment} declaration will be created in @file{~}. If the +file with the same path already exists in home folder it will be moved +to @file{~/TIMESTAMP-guix-home-legacy-configs-backup}, where TIMESTAMP +is a current UNIX epoch time. + +@quotation Note +It is highly recommended to run @command{guix pull} once before you run +@command{guix home reconfigure} for the first time (@pxref{Invoking guix +pull}). +@end quotation + +This effects all the configuration specified in @var{file}. The command +starts Shepherd services specified in @var{file} that are not currently +running; if a service is currently running, this command will arrange +for it to be upgraded the next time it is stopped (e.g.@: by @code{herd +stop X} or @code{herd restart X}). + +This command creates a new generation whose number is one greater than +the current generation (as reported by @command{guix home +list-generations}). If that generation already exists, it will be +overwritten. This behavior mirrors that of @command{guix package} +(@pxref{Invoking guix package}). + +@cindex provenance tracking, of the home environment +Upon completion, the new home is deployed under @file{~/.guix-home}. +This directory contains @dfn{provenance meta-data}: the list of channels +in use (@pxref{Channels}) and @var{file} itself, when available. You +can view the provenance information by running: + +@example +guix home describe +@end example + +This information is useful should you later want to inspect how this +particular generation was built. In fact, assuming @var{file} is +self-contained, you can later rebuild generation @var{n} of your +home environment with: + +@example +guix time-machine \ + -C /var/guix/profiles/per-user/@var{USER}/guix-home-@var{n}-link/channels.scm -- \ + home reconfigure \ + /var/guix/profiles/per-user/@var{USER}/guix-home-@var{n}-link/configuration.scm + +@end example + +You can think of it as some sort of built-in version control! Your +home is not just a binary artifact: @emph{it carries its own source}. +@c @xref{Service Reference, @code{provenance-service-type}}, for more +@c information on provenance tracking. + +@c @footnote{This action (and the related actions +@c @code{switch-generation} and @code{roll-back}) are usable after the +@c home environment is initialized.}. + +@item switch-generation +@cindex home generations +Switch to an existing home generation. This action atomically switches +the home profile to the specified home generation. + +The target generation can be specified explicitly by its generation +number. For example, the following invocation would switch to home +generation 7: + +@example +guix home switch-generation 7 +@end example + +The target generation can also be specified relative to the current +generation with the form @code{+N} or @code{-N}, where @code{+3} means +``3 generations ahead of the current generation,'' and @code{-1} means +``1 generation prior to the current generation.'' When specifying a +negative value such as @code{-1}, you must precede it with @code{--} to +prevent it from being parsed as an option. For example: + +@example +guix home switch-generation -- -1 +@end example + +This action will fail if the specified generation does not exist. + +@item roll-back +@cindex rolling back +Switch to the preceding home generation. This is the inverse +of @command{reconfigure}, and it is exactly the same as invoking +@command{switch-generation} with an argument of @code{-1}. + +@item delete-generations +@cindex deleting home generations +@cindex saving space +Delete home generations, making them candidates for garbage collection +(@pxref{Invoking guix gc}, for information on how to run the ``garbage +collector''). + +This works in the same way as @samp{guix package --delete-generations} +(@pxref{Invoking guix package, @option{--delete-generations}}). With no +arguments, all home generations but the current one are deleted: + +@example +guix home delete-generations +@end example + +You can also select the generations you want to delete. The example below +deletes all the home generations that are more than two month old: + +@example +guix home delete-generations 2m +@end example + +@item build +Build the derivation of the home environment, which includes all the +configuration files and programs needed. This action does not actually +install anything. + +@item describe +Describe the current home generation: its file name, as well as +provenance information when available. + +@item list-generations +List a summary of each generation of the home environment available on +disk, in a human-readable way. This is similar to the +@option{--list-generations} option of @command{guix package} +(@pxref{Invoking guix package}). + +Optionally, one can specify a pattern, with the same syntax that is used +in @command{guix package --list-generations}, to restrict the list of +generations displayed. For instance, the following command displays +generations that are up to 10 days old: + +@example +$ guix home list-generations 10d +@end example + +@end table @node Documentation @chapter Documentation diff --git a/doc/he-config-bare-bones.scm b/doc/he-config-bare-bones.scm new file mode 100644 index 0000000000..01be46a7b0 --- /dev/null +++ b/doc/he-config-bare-bones.scm @@ -0,0 +1,24 @@ +(use-modules (gnu home) + (gnu home-services) + (gnu home-services shells) + (gnu services) + (gnu packages admin) + (guix gexp)) + + +(home-environment + (packages (list htop)) + (services + (list + (service home-bash-service-type + (home-bash-configuration + (guix-defaults? #t) + (bash-profile '("\ +export HISTFILE=$XDG_CACHE_HOME/.bash_history")))) + + (simple-service 'test-config + home-files-service-type + (list `("config/test.conf" + ,(plain-file "tmp-file.txt" + "the content of ~/.config/test.conf"))))))) + diff --git a/etc/news.scm b/etc/news.scm index 63d832a610..dc45aaf496 100644 --- a/etc/news.scm +++ b/etc/news.scm @@ -15,6 +15,7 @@ ;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com> ;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;; Copyright © 2021 Andrew Tropin <andrew@trop.in> ;; ;; Copying and distribution of this file, with or without modification, are ;; permitted in any medium without royalty provided the copyright notice and @@ -22,6 +23,35 @@ (channel-news (version 0) +(entry (commit "a2324d8b56eabf8117bca220a507cc791edffd2e") + (title + (en "Guix Home is a part of GNU Guix") + (ru "Guix Home теперь поставляется в составе GNU Guix")) + (body + (en "Guix Home splitted out from rde project and now is a part of +Guix proper. The new @command{guix home} with its actions allows users to +manage their packages and configurations (aka. dotfiles) in a declarative way, +similar to how many people manage their system with @command{guix system}. + +Take a look at available actions and arguments: +@example +guix home --help +@end example + +See @command{info \"(guix) Home Configuration\"} for more information.") + (ru "Guix Home отделился от проекта rde и теперь является частью +Guix. Новая команда @command{guix home} даёт возможность пользователям +управлять их пакетами и конфигурациями (дотфайлами) для них в декларативном +стиле, аналогично тому, как многие люди управляют своими системами с помощью +@command{guix system}. + +Чтобы получить список доступных действий и аргументов: +@example +guix home --help +@end example + +Смотрите @command{info \"(guix) Home Configuration\"} для получения более +детальных сведений."))) (entry (commit "5b32ad4f6f555d305659cee825879df075b06331") (title diff --git a/gnu/home-services.scm b/gnu/home-services.scm new file mode 100644 index 0000000000..9f1e986616 --- /dev/null +++ b/gnu/home-services.scm @@ -0,0 +1,524 @@ +;;; 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 + home-run-on-change-service-type + home-provenance-service-type + + fold-home-service-types) + + #: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. +;;; +;;; home-run-on-change-service-type allows to trigger actions during +;;; activation if file or directory specified by pattern is changed. +;;; +;;; 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 -0" + (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 #\nul))))) + (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."))) + + +;;; +;;; On-change. +;;; + +(define (compute-on-change-gexp eval-gexps? pattern-gexp-tuples) + #~(begin + (define (equal-regulars? file1 file2) + "Check if FILE1 and FILE2 are bit for bit identical." + (let* ((cmp-binary #$(file-append + (@ (gnu packages base) diffutils) "/bin/cmp")) + (stats1 (lstat file1)) + (stats2 (lstat file2))) + (cond + ((= (stat:ino stats1) (stat:ino stats2)) #t) + ((not (= (stat:size stats1) (stat:size stats2))) #f) + + (else (= (system* cmp-binary file1 file2) 0))))) + + (define (equal-symlinks? symlink1 symlink2) + "Check if SYMLINK1 and SYMLINK2 are pointing to the same target." + (string=? (readlink symlink1) (readlink symlink2))) + + (define (equal-directories? dir1 dir2) + "Check if DIR1 and DIR2 have the same content." + (define (ordinary-file file) + (not (or (string=? file ".") + (string=? file "..")))) + (let* ((files1 (scandir dir1 ordinary-file)) + (files2 (scandir dir2 ordinary-file))) + (if (equal? files1 files2) + (map (lambda (file) + (equal-files? + (string-append dir1 "/" file) + (string-append dir2 "/" file))) + files1) + #f))) + + (define (equal-files? file1 file2) + "Compares files, symlinks or directories of the same type." + (case (file-type file1) + ((directory) (equal-directories? file1 file2)) + ((symlink) (equal-symlinks? file1 file2)) + ((regular) (equal-regulars? file1 file2)) + (else + (display "The file type is unsupported by on-change service.\n") + #f))) + + (define (file-type file) + (stat:type (lstat file))) + + (define (something-changed? file1 file2) + (cond + ((and (not (file-exists? file1)) + (not (file-exists? file2))) #f) + ((or (not (file-exists? file1)) + (not (file-exists? file2))) #t) + + ((not (eq? (file-type file1) (file-type file2))) #t) + + (else + (not (equal-files? file1 file2))))) + + (define expressions-to-eval + (map + (lambda (x) + (let* ((file1 (string-append + (or (getenv "GUIX_OLD_HOME") + "/gnu/store/non-existing-generation") + "/" (car x))) + (file2 (string-append (getenv "GUIX_NEW_HOME") "/" (car x))) + (_ (format #t "Comparing ~a and\n~10t~a..." file1 file2)) + (any-changes? (something-changed? file1 file2)) + (_ (format #t " done (~a)\n" + (if any-changes? "changed" "same")))) + (if any-changes? (cadr x) ""))) + '#$pattern-gexp-tuples)) + + (if #$eval-gexps? + (begin + (display "Evaling on-change gexps.\n\n") + (for-each primitive-eval expressions-to-eval) + (display "On-change gexps evaluation finished.\n\n")) + (display "\ +On-change gexps won't be evaluated, disabled by service +configuration.\n")))) + +(define home-run-on-change-service-type + (service-type (name 'home-run-on-change) + (extensions + (list (service-extension + home-activation-service-type + identity))) + (compose concatenate) + (extend compute-on-change-gexp) + (default-value #t) + (description "\ +G-expressions to run if the specified files have changed since the +last generation. The extension should be a list of lists where the +first element is the pattern for file or directory that expected to be +changed, and the second element is the G-expression to be evaluated."))) + + +;;; +;;; Provenance tracking. +;;; + +(define home-provenance-service-type + (service-type + (name 'home-provenance) + (extensions + (list (service-extension + home-service-type + (service-extension-compute + (first (service-type-extensions provenance-service-type)))))) + (default-value #f) ;the HE config file + (description "\ +Store provenance information about the home environment in the home +environment itself: the channels used when building the home +environment, and its configuration file, when available."))) + +(define sexp->home-provenance sexp->system-provenance) +(define home-provenance system-provenance) + + +;;; +;;; Searching +;;; + +(define (parent-directory directory) + "Get the parent directory of DIRECTORY" + (string-join (drop-right (string-split directory #\/) 1) "/")) + +(define %guix-home-root-directory + ;; Absolute file name of the module hierarchy. + (parent-directory (dirname (search-path %load-path "gnu/home-services.scm")))) + +(define %service-type-path + ;; Search path for service types. + (make-parameter `((,%guix-home-root-directory . "gnu/home-services")))) + +(define (all-home-service-modules) + "Return the default set of home-service modules." + (cons (resolve-interface '(gnu home-services)) + (all-modules (%service-type-path) + #:warn warn-about-load-error))) + +(define* (fold-home-service-types proc seed) + (fold-service-types proc seed (all-home-service-modules))) diff --git a/gnu/home-services/configuration.scm b/gnu/home-services/configuration.scm new file mode 100644 index 0000000000..3698006c37 --- /dev/null +++ b/gnu/home-services/configuration.scm @@ -0,0 +1,107 @@ +;;; 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 configuration) + #:use-module (gnu services configuration) + #:use-module (guix gexp) + #:use-module (srfi srfi-1) + #:use-module (ice-9 curried-definitions) + #:use-module (ice-9 match) + + #:export (filter-configuration-fields + + interpose + list-of + + list-of-strings? + alist? + string-or-gexp? + serialize-string-or-gexp + text-config? + serialize-text-config + generic-serialize-alist-entry + generic-serialize-alist)) + +(define* (filter-configuration-fields configuration-fields fields + #:optional negate?) + "Retrieve the fields listed in FIELDS from CONFIGURATION-FIELDS. +If NEGATE? is @code{#t}, retrieve all fields except FIELDS." + (filter (lambda (field) + (let ((member? (member (configuration-field-name field) fields))) + (if (not negate?) member? (not member?)))) + configuration-fields)) + + +(define* (interpose ls #:optional (delimiter "\n") (grammar 'infix)) + "Same as @code{string-join}, but without join and string, returns an +DELIMITER interposed LS. Support 'infix and 'suffix GRAMMAR values." + (when (not (member grammar '(infix suffix))) + (raise + (formatted-message + (G_ "The GRAMMAR value must be 'infix or 'suffix, but ~a provided.") + grammar))) + (fold-right (lambda (e acc) + (cons e + (if (and (null? acc) (eq? grammar 'infix)) + acc + (cons delimiter acc)))) + '() ls)) + +(define (list-of pred?) + "Return a procedure that takes a list and check if all the elements of +the list result in @code{#t} when applying PRED? on them." + (lambda (x) + (if (list? x) + (every pred? x) + #f))) + + +(define list-of-strings? + (list-of string?)) + +(define alist? list?) + +(define (string-or-gexp? sg) (or (string? sg) (gexp? sg))) +(define (serialize-string-or-gexp field-name val) "") + +(define (text-config? config) + (and (list? config) (every string-or-gexp? config))) +(define (serialize-text-config field-name val) + #~(string-append #$@(interpose val "\n" 'suffix))) + +(define ((generic-serialize-alist-entry serialize-field) entry) + "Apply the SERIALIZE-FIELD procedure on the field and value of ENTRY." + (match entry + ((field . val) (serialize-field field val)))) + +(define (generic-serialize-alist combine serialize-field fields) + "Generate a configuration from an association list FIELDS. + +SERIALIZE-FIELD is a procedure that takes two arguments, it will be +applied on the fields and values of FIELDS using the +@code{generic-serialize-alist-entry} procedure. + +COMBINE is a procedure that takes one or more arguments and combines +all the alist entries into one value, @code{string-append} or +@code{append} are usually good candidates for this. + +See the @code{serialize-alist} procedure in `@code{(gnu home-services +version-control}' for an example usage.)}" + (apply combine + (map (generic-serialize-alist-entry serialize-field) fields))) diff --git a/gnu/home-services/fontutils.scm b/gnu/home-services/fontutils.scm new file mode 100644 index 0000000000..28bfc3d3f7 --- /dev/null +++ b/gnu/home-services/fontutils.scm @@ -0,0 +1,65 @@ +;;; 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 fontutils) + #:use-module (gnu home-services) + #:use-module (gnu packages fontutils) + #:use-module (guix gexp) + + #:export (home-fontconfig-service-type)) + +;;; Commentary: +;;; +;;; Services related to fonts. home-fontconfig service provides +;;; fontconfig configuration, which allows fc-* utilities to find +;;; fonts in Guix Home's profile and regenerates font cache on +;;; activation. +;;; +;;; Code: + +(define (add-fontconfig-config-file he-symlink-path) + `(("config/fontconfig/fonts.conf" + ,(mixed-text-file + "fonts.conf" + "<?xml version='1.0'?> +<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'> +<fontconfig> + <dir>~/.guix-home/profile/share/fonts</dir> +</fontconfig>")))) + +(define (regenerate-font-cache-gexp _) + `(("profile/share/fonts" + ,#~(system* #$(file-append fontconfig "/bin/fc-cache") "-fv")))) + +(define home-fontconfig-service-type + (service-type (name 'home-fontconfig) + (extensions + (list (service-extension + home-files-service-type + add-fontconfig-config-file) + (service-extension + home-run-on-change-service-type + regenerate-font-cache-gexp) + (service-extension + home-profile-service-type + (const (list fontconfig))))) + (default-value #f) + (description + "Provides configuration file for fontconfig and make +fc-* utilities aware of font packages installed in Guix Home's profile."))) diff --git a/gnu/home-services/mcron.scm b/gnu/home-services/mcron.scm new file mode 100644 index 0000000000..fdfde179a5 --- /dev/null +++ b/gnu/home-services/mcron.scm @@ -0,0 +1,115 @@ +;;; 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 mcron) + #:use-module (gnu packages guile-xyz) + #:use-module (gnu home-services) + #:use-module (gnu home-services shepherd) + #:use-module (gnu services shepherd) + #:use-module (guix records) + #:use-module (guix gexp) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + + #:export (home-mcron-configuration + home-mcron-service-type)) + +;;; Commentary: +;; +;; Service for the GNU mcron cron job manager. +;; +;; Example configuration, the first job runs mbsync once every ten +;; minutes, the second one writes "Mcron service" to ~/mcron-file once +;; every minute. +;; +;; (service home-mcron-service-type +;; (home-mcron-configuration +;; (jobs (list #~(job '(next-minute +;; (range 0 60 10)) +;; (lambda () +;; (system* "mbsync" "--all"))) +;; #~(job next-minute-from +;; (lambda () +;; (call-with-output-file (string-append (getenv "HOME") +;; "/mcron-file") +;; (lambda (port) +;; (display "Mcron service" port))))))))) +;; +;;; Code: + +(define-record-type* <home-mcron-configuration> home-mcron-configuration + make-home-mcron-configuration + home-mcron-configuration? + (package home-mcron-configuration-package ; package + (default mcron)) + (jobs home-mcron-configuration-jobs ; list of jobs + (default '()))) + +(define job-files (@@ (gnu services mcron) job-files)) +(define shepherd-schedule-action + (@@ (gnu services mcron) shepherd-schedule-action)) + +(define home-mcron-shepherd-services + (match-lambda + (($ <home-mcron-configuration> mcron '()) ; no jobs to run + '()) + (($ <home-mcron-configuration> mcron jobs) + (let ((files (job-files mcron jobs))) + (list (shepherd-service + (documentation "User cron jobs.") + (provision '(mcron)) + (modules `((srfi srfi-1) + (srfi srfi-26) + (ice-9 popen) ; for the 'schedule' action + (ice-9 rdelim) + (ice-9 match) + ,@%default-modules)) + (start #~(make-forkexec-constructor + (list #$(file-append mcron "/bin/mcron") #$@files) + #:log-file (string-append + (or (getenv "XDG_LOG_HOME") + (format #f "~a/.local/var/log" + (getenv "HOME"))) + "/mcron.log"))) + (stop #~(make-kill-destructor)) + (actions + (list (shepherd-schedule-action mcron files))))))))) + +(define home-mcron-profile (compose list home-mcron-configuration-package)) + +(define (home-mcron-extend config jobs) + (home-mcron-configuration + (inherit config) + (jobs (append (home-mcron-configuration-jobs config) + jobs)))) + +(define home-mcron-service-type + (service-type (name 'home-mcron) + (extensions + (list (service-extension + home-shepherd-service-type + home-mcron-shepherd-services) + (service-extension + home-profile-service-type + home-mcron-profile))) + (compose concatenate) + (extend home-mcron-extend) + (default-value (home-mcron-configuration)) + (description + "Install and configure the GNU mcron cron job manager."))) diff --git a/gnu/home-services/shells.scm b/gnu/home-services/shells.scm new file mode 100644 index 0000000000..ecb02098f7 --- /dev/null +++ b/gnu/home-services/shells.scm @@ -0,0 +1,634 @@ +;;; 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 shells) + #:use-module (gnu services configuration) + #:use-module (gnu home-services configuration) + #:use-module (gnu home-services utils) + #:use-module (gnu home-services) + #:use-module (gnu packages shells) + #:use-module (gnu packages bash) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) + + #:export (home-shell-profile-service-type + home-shell-profile-configuration + + home-bash-service-type + home-bash-configuration + home-bash-extension + + home-zsh-service-type + home-zsh-configuration + home-zsh-extension + + home-fish-service-type + home-fish-configuration + home-fish-extension)) + +;;; Commentary: +;;; +;;; This module contains shell related services like Zsh. +;;; +;;; Code: + + +;;; +;;; Shell profile. +;;; + +(define path? string?) +(define (serialize-path field-name val) val) + +(define-configuration home-shell-profile-configuration + (profile + (text-config '()) + "\ +@code{home-shell-profile} is instantiated automatically by +@code{home-environment}, DO NOT create this service manually, it can +only be extended. + +@code{profile} is a list of strings or gexps, which will go to +@file{~/.profile}. By default @file{~/.profile} contains the +initialization code, which have to be evaluated by login shell to make +home-environment's profile avaliable to the user, but other commands +can be added to the file if it is really necessary. + +In most cases shell's configuration files are preferred places for +user's customizations. Extend home-shell-profile service only if you +really know what you do.")) + +(define (add-shell-profile-file config) + `(("profile" + ,(mixed-text-file + "shell-profile" + "\ +HOME_ENVIRONMENT=$HOME/.guix-home +. $HOME_ENVIRONMENT/setup-environment +$HOME_ENVIRONMENT/on-first-login\n" + (serialize-configuration + config + (filter-configuration-fields + home-shell-profile-configuration-fields '(profile))))))) + +(define (add-profile-extensions config extensions) + (home-shell-profile-configuration + (inherit config) + (profile + (append (home-shell-profile-configuration-profile config) + extensions)))) + +(define home-shell-profile-service-type + (service-type (name 'home-shell-profile) + (extensions + (list (service-extension + home-files-service-type + add-shell-profile-file))) + (compose concatenate) + (extend add-profile-extensions) + (default-value (home-shell-profile-configuration)) + (description "Create @file{~/.profile}, which is used +for environment initialization of POSIX compliant login shells. This +service type can be extended with a list of strings or gexps."))) + +(define (serialize-boolean field-name val) "") +(define (serialize-posix-env-vars field-name val) + #~(string-append + #$@(map + (match-lambda + ((key . #f) + "") + ((key . #t) + #~(string-append "export " #$key "\n")) + ((key . value) + #~(string-append "export " #$key "=" #$value "\n"))) + val))) + + +;;; +;;; Zsh. +;;; + +(define-configuration home-zsh-configuration + (package + (package zsh) + "The Zsh package to use.") + (xdg-flavor? + (boolean #t) + "Place all the configs to @file{$XDG_CONFIG_HOME/zsh}. Makes +@file{~/.zshenv} to set @env{ZDOTDIR} to @file{$XDG_CONFIG_HOME/zsh}. +Shell startup process will continue with +@file{$XDG_CONFIG_HOME/zsh/.zshenv}.") + (environment-variables + (alist '()) + "Association list of environment variables to set for the Zsh session." + serialize-posix-env-vars) + (zshenv + (text-config '()) + "List of strings or gexps, which will be added to @file{.zshenv}. +Used for setting user's shell environment variables. Must not contain +commands assuming the presence of tty or producing output. Will be +read always. Will be read before any other file in @env{ZDOTDIR}.") + (zprofile + (text-config '()) + "List of strings or gexps, which will be added to @file{.zprofile}. +Used for executing user's commands at start of login shell (In most +cases the shell started on tty just after login). Will be read before +@file{.zlogin}.") + (zshrc + (text-config '()) + "List of strings or gexps, which will be added to @file{.zshrc}. +Used for executing user's commands at start of interactive shell (The +shell for interactive usage started by typing @code{zsh} or by +terminal app or any other program).") + (zlogin + (text-config '()) + "List of strings or gexps, which will be added to @file{.zlogin}. +Used for executing user's commands at the end of starting process of +login shell.") + (zlogout + (text-config '()) + "List of strings or gexps, which will be added to @file{.zlogout}. +Used for executing user's commands at the exit of login shell. It +won't be read in some cases (if the shell terminates by exec'ing +another process for example).")) + +(define (add-zsh-configuration config) + (let* ((xdg-flavor? (home-zsh-configuration-xdg-flavor? config))) + + (define prefix-file + (cut string-append + (if xdg-flavor? + "config/zsh/." + "") <>)) + + (define (filter-fields field) + (filter-configuration-fields home-zsh-configuration-fields + (list field))) + + (define (serialize-field field) + (serialize-configuration + config + (filter-fields field))) + + (define (file-if-not-empty field) + (let ((file-name (symbol->string field)) + (field-obj (car (filter-fields field)))) + (if (not (null? ((configuration-field-getter field-obj) config))) + `(,(prefix-file file-name) + ,(mixed-text-file + file-name + (serialize-field field))) + '()))) + + (filter + (compose not null?) + `(,(if xdg-flavor? + `("zshenv" + ,(mixed-text-file + "auxiliary-zshenv" + (if xdg-flavor? + "source ${XDG_CONFIG_HOME:-$HOME/.config}/zsh/.zshenv\n" + ""))) + '()) + (,(prefix-file "zshenv") + ,(mixed-text-file + "zshenv" + (if xdg-flavor? + "export ZDOTDIR=${XDG_CONFIG_HOME:-$HOME/.config}/zsh\n" + "") + (serialize-field 'zshenv) + (serialize-field 'environment-variables))) + (,(prefix-file "zprofile") + ,(mixed-text-file + "zprofile" + "\ +# Setups system and user profiles and related variables +source /etc/profile +# Setups home environment profile +source ~/.profile + +# It's only necessary if zsh is a login shell, otherwise profiles will +# be already sourced by bash +" + (serialize-field 'zprofile))) + + ,@(list (file-if-not-empty 'zshrc) + (file-if-not-empty 'zlogin) + (file-if-not-empty 'zlogout)))))) + +(define (add-zsh-packages config) + (list (home-zsh-configuration-package config))) + +(define-configuration/no-serialization home-zsh-extension + (environment-variables + (alist '()) + "Association list of environment variables to set.") + (zshrc + (text-config '()) + "List of strings or gexps.") + (zshenv + (text-config '()) + "List of strings or gexps.") + (zprofile + (text-config '()) + "List of strings or gexps.") + (zlogin + (text-config '()) + "List of strings or gexps.") + (zlogout + (text-config '()) + "List of strings or gexps.")) + +(define (home-zsh-extensions original-config extension-configs) + (home-zsh-configuration + (inherit original-config) + (environment-variables + (append (home-zsh-configuration-environment-variables original-config) + (append-map + home-zsh-extension-environment-variables extension-configs))) + (zshrc + (append (home-zsh-configuration-zshrc original-config) + (append-map + home-zsh-extension-zshrc extension-configs))) + (zshenv + (append (home-zsh-configuration-zshenv original-config) + (append-map + home-zsh-extension-zshenv extension-configs))) + (zprofile + (append (home-zsh-configuration-zprofile original-config) + (append-map + home-zsh-extension-zprofile extension-configs))) + (zlogin + (append (home-zsh-configuration-zlogin original-config) + (append-map + home-zsh-extension-zlogin extension-configs))) + (zlogout + (append (home-zsh-configuration-zlogout original-config) + (append-map + home-zsh-extension-zlogout extension-configs))))) + +(define home-zsh-service-type + (service-type (name 'home-zsh) + (extensions + (list (service-extension + home-files-service-type + add-zsh-configuration) + (service-extension + home-profile-service-type + add-zsh-packages))) + (compose identity) + (extend home-zsh-extensions) + (default-value (home-zsh-configuration)) + (description "Install and configure Zsh."))) + + +;;; +;;; Bash. +;;; + +(define-configuration home-bash-configuration + (package + (package bash) + "The Bash package to use.") + (guix-defaults? + (boolean #t) + "Add sane defaults like reading @file{/etc/bashrc}, coloring output +for @code{ls} provided by guix to @file{.bashrc}.") + (environment-variables + (alist '()) + "Association list of environment variables to set for the Bash session." + serialize-posix-env-vars) + (bash-profile + (text-config '()) + "List of strings or gexps, which will be added to @file{.bash_profile}. +Used for executing user's commands at start of login shell (In most +cases the shell started on tty just after login). @file{.bash_login} +won't be ever read, because @file{.bash_profile} always present.") + (bashrc + (text-config '()) + "List of strings or gexps, which will be added to @file{.bashrc}. +Used for executing user's commands at start of interactive shell (The +shell for interactive usage started by typing @code{bash} or by +terminal app or any other program).") + (bash-logout + (text-config '()) + "List of strings or gexps, which will be added to @file{.bash_logout}. +Used for executing user's commands at the exit of login shell. It +won't be read in some cases (if the shell terminates by exec'ing +another process for example).")) + +;; TODO: Use value from (gnu system shadow) +(define guix-bashrc + "\ +# Bash initialization for interactive non-login shells and +# for remote shells (info \"(bash) Bash Startup Files\"). + +# Export 'SHELL' to child processes. Programs such as 'screen' +# honor it and otherwise use /bin/sh. +export SHELL + +if [[ $- != *i* ]] +then + # We are being invoked from a non-interactive shell. If this + # is an SSH session (as in \"ssh host command\"), source + # /etc/profile so we get PATH and other essential variables. + [[ -n \"$SSH_CLIENT\" ]] && source /etc/profile + + # Don't do anything else. + return +fi + +# Source the system-wide file. +source /etc/bashrc + +# Adjust the prompt depending on whether we're in 'guix environment'. +if [ -n \"$GUIX_ENVIRONMENT\" ] +then + PS1='\\u@\\h \\w [env]\\$ ' +else + PS1='\\u@\\h \\w\\$ ' +fi +alias ls='ls -p --color=auto' +alias ll='ls -l' +alias grep='grep --color=auto'\n") + +(define (add-bash-configuration config) + (define (filter-fields field) + (filter-configuration-fields home-bash-configuration-fields + (list field))) + + (define (serialize-field field) + (serialize-configuration + config + (filter-fields field))) + + (define* (file-if-not-empty field #:optional (extra-content #f)) + (let ((file-name (symbol->string field)) + (field-obj (car (filter-fields field)))) + (if (or extra-content + (not (null? ((configuration-field-getter field-obj) config)))) + `(,(object->snake-case-string file-name) + ,(mixed-text-file + (object->snake-case-string file-name) + (if extra-content extra-content "") + (serialize-field field))) + '()))) + + (filter + (compose not null?) + `(("bash_profile" + ,(mixed-text-file + "bash_profile" + "\ +# Setups system and user profiles and related variables +# /etc/profile will be sourced by bash automatically +# Setups home environment profile +if [ -f ~/.profile ]; then source ~/.profile; fi + +# Honor per-interactive-shell startup file +if [ -f ~/.bashrc ]; then source ~/.bashrc; fi +" + (serialize-field 'bash-profile) + (serialize-field 'environment-variables))) + + ,@(list (file-if-not-empty + 'bashrc + (if (home-bash-configuration-guix-defaults? config) + guix-bashrc + #f)) + (file-if-not-empty 'bash-logout))))) + +(define (add-bash-packages config) + (list (home-bash-configuration-package config))) + +(define-configuration/no-serialization home-bash-extension + (environment-variables + (alist '()) + "Association list of environment variables to set.") + (bash-profile + (text-config '()) + "List of strings or gexps.") + (bashrc + (text-config '()) + "List of strings or gexps.") + (bash-logout + (text-config '()) + "List of strings or gexps.")) + +(define (home-bash-extensions original-config extension-configs) + (home-bash-configuration + (inherit original-config) + (environment-variables + (append (home-bash-configuration-environment-variables original-config) + (append-map + home-bash-extension-environment-variables extension-configs))) + (bash-profile + (append (home-bash-configuration-bash-profile original-config) + (append-map + home-bash-extension-bash-profile extension-configs))) + (bashrc + (append (home-bash-configuration-bashrc original-config) + (append-map + home-bash-extension-bashrc extension-configs))) + (bash-logout + (append (home-bash-configuration-bash-logout original-config) + (append-map + home-bash-extension-bash-logout extension-configs))))) + +(define home-bash-service-type + (service-type (name 'home-bash) + (extensions + (list (service-extension + home-files-service-type + add-bash-configuration) + (service-extension + home-profile-service-type + add-bash-packages))) + (compose identity) + (extend home-bash-extensions) + (default-value (home-bash-configuration)) + (description "Install and configure GNU Bash."))) + + +;;; +;;; Fish. +;;; + +(define (serialize-fish-aliases field-name val) + #~(string-append + #$@(map (match-lambda + ((key . value) + #~(string-append "alias " #$key " \"" #$value "\"\n")) + (_ "")) + val))) + +(define (serialize-fish-abbreviations field-name val) + #~(string-append + #$@(map (match-lambda + ((key . value) + #~(string-append "abbr --add " #$key " " #$value "\n")) + (_ "")) + val))) + +(define (serialize-fish-env-vars field-name val) + #~(string-append + #$@(map (match-lambda + ((key . #f) + "") + ((key . #t) + #~(string-append "set " #$key "\n")) + ((key . value) + #~(string-append "set " #$key " " #$value "\n"))) + val))) + +(define-configuration home-fish-configuration + (package + (package fish) + "The Fish package to use.") + (config + (text-config '()) + "List of strings or gexps, which will be added to +@file{$XDG_CONFIG_HOME/fish/config.fish}.") + (environment-variables + (alist '()) + "Association list of environment variables to set in Fish." + serialize-fish-env-vars) + (aliases + (alist '()) + "Association list of aliases for Fish, both the key and the value +should be a string. An alias is just a simple function that wraps a +command, If you want something more akin to @dfn{aliases} in POSIX +shells, see the @code{abbreviations} field." + serialize-fish-aliases) + (abbreviations + (alist '()) + "Association list of abbreviations for Fish. These are words that, +when typed in the shell, will automatically expand to the full text." + serialize-fish-abbreviations)) + +(define (fish-files-service config) + `(("config/fish/config.fish" + ,(mixed-text-file + "fish-config.fish" + #~(string-append "\ +# if we haven't sourced the login config, do it +status --is-login; and not set -q __fish_login_config_sourced +and begin + + set --prepend fish_function_path " + #$fish-foreign-env + "/share/fish/functions + fenv source $HOME/.profile + set -e fish_function_path[1] + + set -g __fish_login_config_sourced 1 + +end\n\n") + (serialize-configuration + config + home-fish-configuration-fields))))) + +(define (fish-profile-service config) + (list (home-fish-configuration-package config))) + +(define-configuration/no-serialization home-fish-extension + (config + (text-config '()) + "List of strings or gexps for extending the Fish initialization file.") + (environment-variables + (alist '()) + "Association list of environment variables to set.") + (aliases + (alist '()) + "Association list of Fish aliases.") + (abbreviations + (alist '()) + "Association list of Fish abbreviations.")) + +(define (home-fish-extensions original-config extension-configs) + (home-fish-configuration + (inherit original-config) + (config + (append (home-fish-configuration-config original-config) + (append-map + home-fish-extension-config extension-configs))) + (environment-variables + (append (home-fish-configuration-environment-variables original-config) + (append-map + home-fish-extension-environment-variables extension-configs))) + (aliases + (append (home-fish-configuration-aliases original-config) + (append-map + home-fish-extension-aliases extension-configs))) + (abbreviations + (append (home-fish-configuration-abbreviations original-config) + (append-map + home-fish-extension-abbreviations extension-configs))))) + +;; TODO: Support for generating completion files +;; TODO: Support for installing plugins +(define home-fish-service-type + (service-type (name 'home-fish) + (extensions + (list (service-extension + home-files-service-type + fish-files-service) + (service-extension + home-profile-service-type + fish-profile-service))) + (compose identity) + (extend home-fish-extensions) + (default-value (home-fish-configuration)) + (description "\ +Install and configure Fish, the friendly interactive shell."))) + + +(define (generate-home-shell-profile-documentation) + (generate-documentation + `((home-shell-profile-configuration + ,home-shell-profile-configuration-fields)) + 'home-shell-profile-configuration)) + +(define (generate-home-bash-documentation) + (generate-documentation + `((home-bash-configuration + ,home-bash-configuration-fields)) + 'home-bash-configuration)) + +(define (generate-home-zsh-documentation) + (generate-documentation + `((home-zsh-configuration + ,home-zsh-configuration-fields)) + 'home-zsh-configuration)) + +(define (generate-home-fish-documentation) + (string-append + (generate-documentation + `((home-fish-configuration + ,home-fish-configuration-fields)) + 'home-fish-configuration) + "\n\n" + (generate-documentation + `((home-fish-extension + ,home-fish-extension-fields)) + 'home-fish-extension))) diff --git a/gnu/home-services/shepherd.scm b/gnu/home-services/shepherd.scm new file mode 100644 index 0000000000..120cfde1a1 --- /dev/null +++ b/gnu/home-services/shepherd.scm @@ -0,0 +1,134 @@ +;;; 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) + + #:export (home-shepherd-service-type + home-shepherd-configuration) + #: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/home-services/symlink-manager.scm b/gnu/home-services/symlink-manager.scm new file mode 100644 index 0000000000..11f5d503d4 --- /dev/null +++ b/gnu/home-services/symlink-manager.scm @@ -0,0 +1,247 @@ +;;; 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 symlink-manager) + #:use-module (gnu home-services) + #:use-module (guix gexp) + + #:export (home-symlink-manager-service-type)) + +;;; Comment: +;;; +;;; symlink-manager cares about configuration files: it backs up files +;;; created by user, removes symlinks and directories created by a +;;; previous generation, and creates new directories and symlinks to +;;; configuration files according to the content of files/ directory +;;; (created by home-files-service) of the current home environment +;;; generation. +;;; +;;; Code: + +(define (update-symlinks-script) + (program-file + "update-symlinks" + #~(begin + (use-modules (ice-9 ftw) + (ice-9 curried-definitions) + (ice-9 match) + (srfi srfi-1)) + (define ((simplify-file-tree parent) file) + "Convert the result produced by `file-system-tree' to less +verbose and more suitable for further processing format. + +Extract dir/file info from stat and compose a relative path to the +root of the file tree. + +Sample output: + +((dir . \".\") + ((dir . \"config\") + ((dir . \"config/fontconfig\") + (file . \"config/fontconfig/fonts.conf\")) + ((dir . \"config/isync\") + (file . \"config/isync/mbsyncrc\")))) +" + (match file + ((name stat) `(file . ,(string-append parent name))) + ((name stat children ...) + (cons `(dir . ,(string-append parent name)) + (map (simplify-file-tree + (if (equal? name ".") + "" + (string-append parent name "/"))) + children))))) + + (define ((file-tree-traverse preordering) node) + "Traverses the file tree in different orders, depending on PREORDERING. + +if PREORDERING is @code{#t} resulting list will contain directories +before files located in those directories, otherwise directory will +appear only after all nested items already listed." + (let ((prepend (lambda (a b) (append b a)))) + (match node + (('file . path) (list node)) + ((('dir . path) . rest) + ((if preordering append prepend) + (list (cons 'dir path)) + (append-map (file-tree-traverse preordering) rest)))))) + + (use-modules (guix build utils)) + + (let* ((config-home (or (getenv "XDG_CONFIG_HOME") + (string-append (getenv "HOME") "/.config"))) + + (he-path (string-append (getenv "HOME") "/.guix-home")) + (new-he-path (string-append he-path ".new")) + (new-home (getenv "GUIX_NEW_HOME")) + (old-home (getenv "GUIX_OLD_HOME")) + + (new-files-path (string-append new-home "/files")) + ;; Trailing dot is required, because files itself is symlink and + ;; to make file-system-tree works it should be a directory. + (new-files-dir-path (string-append new-files-path "/.")) + + (home-path (getenv "HOME")) + (backup-dir (string-append home-path "/" + (number->string (current-time)) + "-guix-home-legacy-configs-backup")) + + (old-tree (if old-home + ((simplify-file-tree "") + (file-system-tree + (string-append old-home "/files/."))) + #f)) + (new-tree ((simplify-file-tree "") + (file-system-tree new-files-dir-path))) + + (get-source-path + (lambda (path) + (readlink (string-append new-files-path "/" path)))) + + (get-target-path + (lambda (path) + (string-append home-path "/." path))) + + (get-backup-path + (lambda (path) + (string-append backup-dir "/." path))) + + (directory? + (lambda (path) + (equal? (stat:type (stat path)) 'directory))) + + (empty-directory? + (lambda (dir) + (equal? (scandir dir) '("." "..")))) + + (symlink-to-store? + (lambda (path) + (and + (equal? (stat:type (lstat path)) 'symlink) + (store-file-name? (readlink path))))) + + (backup-file + (lambda (path) + (mkdir-p backup-dir) + (format #t "Backing up ~a..." (get-target-path path)) + (mkdir-p (dirname (get-backup-path path))) + (rename-file (get-target-path path) (get-backup-path path)) + (display " done\n"))) + + (cleanup-symlinks + (lambda () + (let ((to-delete ((file-tree-traverse #f) old-tree))) + (display + "Cleaning up symlinks from previous home-environment.\n\n") + (map + (match-lambda + (('dir . ".") + (display "Cleanup finished.\n\n")) + + (('dir . path) + (if (and + (file-exists? (get-target-path path)) + (directory? (get-target-path path)) + (empty-directory? (get-target-path path))) + (begin + (format #t "Removing ~a..." + (get-target-path path)) + (rmdir (get-target-path path)) + (display " done\n")) + (format + #t "Skipping ~a (not an empty directory)... done\n" + (get-target-path path)))) + + (('file . path) + (when (file-exists? (get-target-path path)) + ;; DO NOT remove the file if it is no longer + ;; a symlink to the store, it will be backed + ;; up later during create-symlinks phase. + (if (symlink-to-store? (get-target-path path)) + (begin + (format #t "Removing ~a..." (get-target-path path)) + (delete-file (get-target-path path)) + (display " done\n")) + (format + #t + "Skipping ~a (not a symlink to store)... done\n" + (get-target-path path)))))) + to-delete)))) + + (create-symlinks + (lambda () + (let ((to-create ((file-tree-traverse #t) new-tree))) + (map + (match-lambda + (('dir . ".") + (display + "New symlinks to home-environment will be created soon.\n") + (format + #t "All conflicting files will go to ~a.\n\n" backup-dir)) + + (('dir . path) + (let ((target-path (get-target-path path))) + (when (and (file-exists? target-path) + (not (directory? target-path))) + (backup-file path)) + + (if (file-exists? target-path) + (format + #t "Skipping ~a (directory already exists)... done\n" + target-path) + (begin + (format #t "Creating ~a..." target-path) + (mkdir target-path) + (display " done\n"))))) + + (('file . path) + (when (file-exists? (get-target-path path)) + (backup-file path)) + (format #t "Symlinking ~a -> ~a..." + (get-target-path path) (get-source-path path)) + (symlink (get-source-path path) (get-target-path path)) + (display " done\n"))) + to-create))))) + + (when old-tree + (cleanup-symlinks)) + + (create-symlinks) + + (symlink new-home new-he-path) + (rename-file new-he-path he-path) + + (display " done\nFinished updating symlinks.\n\n"))))) + + +(define (update-symlinks-gexp _) + #~(primitive-load #$(update-symlinks-script))) + +(define home-symlink-manager-service-type + (service-type (name 'home-symlink-manager) + (extensions + (list + (service-extension + home-activation-service-type + update-symlinks-gexp))) + (default-value #f) + (description "Provide an @code{update-symlinks} +script, which creates symlinks to configuration files and directories +on every activation. If an existing file would be overwritten by a +symlink, backs up that file first."))) diff --git a/gnu/home-services/utils.scm b/gnu/home-services/utils.scm new file mode 100644 index 0000000000..3e490a0515 --- /dev/null +++ b/gnu/home-services/utils.scm @@ -0,0 +1,77 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> +;;; +;;; 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 utils) + #:use-module (ice-9 string-fun) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + + #:export (maybe-object->string + object->snake-case-string + object->camel-case-string)) + +(define (maybe-object->string object) + "Like @code{object->string} but don't do anyting if OBJECT already is +a string." + (if (string? object) + object + (object->string object))) + +;; Snake case: <https://en.wikipedia.org/wiki/Snake_case> +(define* (object->snake-case-string object #:optional (style 'lower)) + "Convert the object OBJECT to the equivalent string in ``snake +case''. STYLE can be three `@code{lower}', `@code{upper}', or +`@code{capitalize}', defaults to `@code{lower}'. + +@example +(object->snake-case-string 'variable-name 'upper) +@result{} \"VARIABLE_NAME\" @end example" + (if (not (member style '(lower upper capitalize))) + (error 'invalid-style (format #f "~a is not a valid style" style)) + (let ((stringified (maybe-object->string object))) + (string-replace-substring + (cond + ((equal? style 'lower) stringified) + ((equal? style 'upper) (string-upcase stringified)) + (else (string-capitalize stringified))) + "-" "_")))) + +(define* (object->camel-case-string object #:optional (style 'lower)) + "Convert the object OBJECT to the equivalent string in ``camel case''. +STYLE can be three `@code{lower}', `@code{upper}', defaults to +`@code{lower}'. + +@example +(object->camel-case-string 'variable-name 'upper) +@result{} \"VariableName\" +@end example" + (if (not (member style '(lower upper))) + (error 'invalid-style (format #f "~a is not a valid style" style)) + (let ((stringified (maybe-object->string object))) + (cond + ((eq? style 'upper) + (string-concatenate + (map string-capitalize + (string-split stringified (cut eqv? <> #\-))))) + ((eq? style 'lower) + (let ((splitted-string (string-split stringified (cut eqv? <> #\-)))) + (string-concatenate + (cons (first splitted-string) + (map string-capitalize + (cdr splitted-string)))))))))) diff --git a/gnu/home-services/xdg.scm b/gnu/home-services/xdg.scm new file mode 100644 index 0000000000..457ce999a1 --- /dev/null +++ b/gnu/home-services/xdg.scm @@ -0,0 +1,476 @@ +;;; 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 xdg) + #:use-module (gnu services configuration) + #:use-module (gnu home-services configuration) + #:use-module (gnu home-services) + #:use-module (gnu packages freedesktop) + #:use-module (gnu home-services utils) + #:use-module (guix gexp) + #:use-module (guix records) + #:use-module (guix i18n) + #:use-module (guix diagnostics) + + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (rnrs enums) + + #:export (home-xdg-base-directories-service-type + home-xdg-base-directories-configuration + home-xdg-base-directories-configuration? + + home-xdg-user-directories-service-type + home-xdg-user-directories-configuration + home-xdg-user-directories-configuration? + + xdg-desktop-action + xdg-desktop-entry + home-xdg-mime-applications-service-type + home-xdg-mime-applications-configuration)) + +;;; Commentary: +;; +;; This module contains services related to XDG directories and +;; applications. +;; +;; - XDG base directories +;; - XDG user directories +;; - XDG MIME applications +;; +;;; Code: + + +;;; +;;; XDG base directories. +;;; + +(define (serialize-path field-name val) "") +(define path? string?) + +(define-configuration home-xdg-base-directories-configuration + (cache-home + (path "$HOME/.cache") + "Base directory for programs to store user-specific non-essential +(cached) data. Files in this directory can be deleted anytime without +loss of important data.") + (config-home + (path "$HOME/.config") + "Base directory for programs to store configuration files. +Some programs store here log or state files, but it's not desired, +this directory should contain static configurations.") + (data-home + (path "$HOME/.local/share") + "Base directory for programs to store architecture independent +read-only shared data, analogus to @file{/usr/share}, but for user.") + (runtime-dir + (path "${XDG_RUNTIME_DIR:-/run/user/$UID}") + "Base directory for programs to store user-specific runtime files, +like sockets.") + (log-home + (path "$HOME/.local/var/log") + "Base directory for programs to store log files, analogus to +@file{/var/log}, but for user. It is not a part of XDG Base Directory +Specification, but helps to make implementation of home services more +consistent.") + (state-home + (path "$HOME/.local/var/lib") + "Base directory for programs to store state files, like databases, +analogus to @file{/var/lib}, but for user. It is not a part of XDG +Base Directory Specification, but helps to make implementation of home +services more consistent.")) + +(define (home-xdg-base-directories-environment-variables-service config) + (map + (lambda (field) + (cons (format + #f "XDG_~a" + (object->snake-case-string (configuration-field-name field) 'upper)) + ((configuration-field-getter field) config))) + home-xdg-base-directories-configuration-fields)) + +(define (ensure-xdg-base-dirs-on-activation config) + #~(map (lambda (xdg-base-dir-variable) + ((@@ (guix build utils) mkdir-p) + (getenv + xdg-base-dir-variable))) + '#$(map (lambda (field) + (format + #f "XDG_~a" + (object->snake-case-string + (configuration-field-name field) 'upper))) + home-xdg-base-directories-configuration-fields))) + +(define (last-extension-or-cfg config extensions) + "Picks configuration value from last provided extension. If there +are no extensions use configuration instead." + (or (and (not (null? extensions)) (last extensions)) config)) + +(define home-xdg-base-directories-service-type + (service-type (name 'home-xdg-base-directories) + (extensions + (list (service-extension + home-environment-variables-service-type + home-xdg-base-directories-environment-variables-service) + (service-extension + home-activation-service-type + ensure-xdg-base-dirs-on-activation))) + (default-value (home-xdg-base-directories-configuration)) + (compose identity) + (extend last-extension-or-cfg) + (description "Configure XDG base directories. This +service introduces two additional variables @env{XDG_STATE_HOME}, +@env{XDG_LOG_HOME}. They are not a part of XDG specification, at +least yet, but are convinient to have, it improves the consistency +between different home services. The services of this service-type is +instantiated by default, to provide non-default value, extend the +service-type (using @code{simple-service} for example)."))) + +(define (generate-home-xdg-base-directories-documentation) + (generate-documentation + `((home-xdg-base-directories-configuration + ,home-xdg-base-directories-configuration-fields)) + 'home-xdg-base-directories-configuration)) + + +;;; +;;; XDG user directories. +;;; + +(define (serialize-string field-name val) + ;; The path has to be quoted + (format #f "XDG_~a_DIR=\"~a\"\n" + (object->snake-case-string field-name 'upper) val)) + +(define-configuration home-xdg-user-directories-configuration + (desktop + (string "$HOME/Desktop") + "Default ``desktop'' directory, this is what you see on your +desktop when using a desktop environment, +e.g. GNOME (@pxref{XWindow,,,guix.info}).") + (documents + (string "$HOME/Documents") + "Default directory to put documents like PDFs.") + (download + (string "$HOME/Downloads") + "Default directory downloaded files, this is where your Web-broser +will put downloaded files in.") + (music + (string "$HOME/Music") + "Default directory for audio files.") + (pictures + (string "$HOME/Pictures") + "Default directory for pictures and images.") + (publicshare + (string "$HOME/Public") + "Default directory for shared files, which can be accessed by other +users on local machine or via network.") + (templates + (string "$HOME/Templates") + "Default directory for templates. They can be used by graphical +file manager or other apps for creating new files with some +pre-populated content.") + (videos + (string "$HOME/Videos") + "Default directory for videos.")) + +(define (home-xdg-user-directories-files-service config) + `(("config/user-dirs.conf" + ,(mixed-text-file + "user-dirs.conf" + "enabled=False\n")) + ("config/user-dirs.dirs" + ,(mixed-text-file + "user-dirs.dirs" + (serialize-configuration + config + home-xdg-user-directories-configuration-fields))))) + +(define (home-xdg-user-directories-activation-service config) + (let ((dirs (map (lambda (field) + ((configuration-field-getter field) config)) + home-xdg-user-directories-configuration-fields))) + #~(let ((ensure-dir + (lambda (path) + (mkdir-p + ((@@ (ice-9 string-fun) string-replace-substring) + path "$HOME" (getenv "HOME")))))) + (display "Creating XDG user directories...") + (map ensure-dir '#$dirs) + (display " done\n")))) + +(define home-xdg-user-directories-service-type + (service-type (name 'home-xdg-user-directories) + (extensions + (list (service-extension + home-files-service-type + home-xdg-user-directories-files-service) + (service-extension + home-activation-service-type + home-xdg-user-directories-activation-service))) + (default-value (home-xdg-user-directories-configuration)) + (description "Configure XDG user directories. To +disable a directory, point it to the $HOME."))) + +(define (generate-home-xdg-user-directories-documentation) + (generate-documentation + `((home-xdg-user-directories-configuration + ,home-xdg-user-directories-configuration-fields)) + 'home-xdg-user-directories-configuration)) + + +;;; +;;; XDG MIME applications. +;;; + +;; Example config +;; +;; (home-xdg-mime-applications-configuration +;; (added '((x-scheme-handler/magnet . torrent.desktop))) +;; (default '((inode/directory . file.desktop))) +;; (removed '((inode/directory . thunar.desktop))) +;; (desktop-entries +;; (list (xdg-desktop-entry +;; (file "file") +;; (name "File manager") +;; (type 'application) +;; (config +;; '((exec . "emacsclient -c -a emacs %u")))) +;; (xdg-desktop-entry +;; (file "text") +;; (name "Text editor") +;; (type 'application) +;; (config +;; '((exec . "emacsclient -c -a emacs %u"))) +;; (actions +;; (list (xdg-desktop-action +;; (action 'create) +;; (name "Create an action") +;; (config +;; '((exec . "echo hi")))))))))) + +;; See +;; <https://specifications.freedesktop.org/shared-mime-info-spec/shared-mime-info-spec-latest.html> +;; <https://specifications.freedesktop.org/mime-apps-spec/mime-apps-spec-latest.html> + +(define (serialize-alist field-name val) + (define (serialize-mimelist-entry key val) + (let ((val (cond + ((list? val) + (string-join (map maybe-object->string val) ";")) + ((or (string? val) (symbol? val)) + val) + (else (raise (formatted-message + (G_ "\ +The value of an XDG MIME entry must be a list, string or symbol, was given ~a") + val)))))) + (format #f "~a=~a\n" key val))) + + (define (merge-duplicates alist acc) + "Merge values that have the same key. + +@example +(merge-duplicates '((key1 . value1) + (key2 . value2) + (key1 . value3) + (key1 . value4)) '()) + +@result{} ((key1 . (value4 value3 value1)) (key2 . value2)) +@end example" + (cond + ((null? alist) acc) + (else (let* ((head (first alist)) + (tail (cdr alist)) + (key (first head)) + (value (cdr head)) + (duplicate? (assoc key acc))) + (if duplicate? + ;; XXX: This will change the order of things, + ;; though, it shouldn't be a problem for XDG MIME. + (merge-duplicates + tail + (alist-cons key + (cons value (maybe-list (cdr duplicate?))) + (alist-delete key acc))) + (merge-duplicates tail (cons head acc))))))) + + (string-append (if (equal? field-name 'default) + "\n[Default Applications]\n" + (format #f "\n[~a Associations]\n" + (string-capitalize (symbol->string field-name)))) + (generic-serialize-alist string-append + serialize-mimelist-entry + (merge-duplicates val '())))) + +(define xdg-desktop-types (make-enumeration + '(application + link + directory))) + +(define (xdg-desktop-type? type) + (unless (enum-set-member? type xdg-desktop-types) + (raise (formatted-message + (G_ "XDG desktop type must be of of ~a, was given: ~a") + (list->human-readable-list (enum-set->list xdg-desktop-types)) + type)))) + +;; TODO: Add proper docs for this +;; XXX: 'define-configuration' require that fields have a default +;; value. +(define-record-type* <xdg-desktop-action> + xdg-desktop-action make-xdg-desktop-action + xdg-desktop-action? + (action xdg-desktop-action-action) ; symbol + (name xdg-desktop-action-name) ; string + (config xdg-desktop-action-config ; alist + (default '()))) + +(define-record-type* <xdg-desktop-entry> + xdg-desktop-entry make-xdg-desktop-entry + xdg-desktop-entry? + ;; ".desktop" will automatically be added + (file xdg-desktop-entry-file) ; string + (name xdg-desktop-entry-name) ; string + (type xdg-desktop-entry-type) ; xdg-desktop-type + (config xdg-desktop-entry-config ; alist + (default '())) + (actions xdg-desktop-entry-actions ; list of <xdg-desktop-action> + (default '()))) + +(define desktop-entries? (list-of xdg-desktop-entry?)) +(define (serialize-desktop-entries field-name val) "") + +(define (serialize-xdg-desktop-entry entry) + "Return a tuple of the file name for ENTRY and the serialized +configuration." + (define (format-config key val) + (let ((val (cond + ((list? val) + (string-join (map maybe-object->string val) ";")) + ((boolean? val) + (if val "true" "false")) + (else val))) + (key (string-capitalize (maybe-object->string key)))) + (list (if (string-suffix? key "?") + (string-drop-right key (- (string-length key) 1)) + key) + "=" val "\n"))) + + (define (serialize-alist config) + (generic-serialize-alist identity format-config config)) + + (define (serialize-xdg-desktop-action action) + (match action + (($ <xdg-desktop-action> action name config) + `(,(format #f "[Desktop Action ~a]\n" + (string-capitalize (maybe-object->string action))) + ,(format #f "Name=~a\n" name) + ,@(serialize-alist config))))) + + (match entry + (($ <xdg-desktop-entry> file name type config actions) + (list (if (string-suffix? file ".desktop") + file + (string-append file ".desktop")) + `("[Desktop Entry]\n" + ,(format #f "Name=~a\n" name) + ,(format #f "Type=~a\n" + (string-capitalize (symbol->string type))) + ,@(serialize-alist config) + ,@(append-map serialize-xdg-desktop-action actions)))))) + +(define-configuration home-xdg-mime-applications-configuration + (added + (alist '()) + "An association list of MIME types and desktop entries which indicate +that the application should used to open the specified MIME type. The +value has to be string, symbol, or list of strings or symbols, this +applies to the `@code{default}', and `@code{removed}' fields as well.") + (default + (alist '()) + "An association list of MIME types and desktop entries which indicate +that the application should be the default for opening the specified +MIME type.") + (removed + (alist '()) + "An association list of MIME types and desktop entries which indicate +that the application cannot open the specified MIME type.") + (desktop-entries + (desktop-entries '()) + "A list of XDG desktop entries to create. See +@code{xdg-desktop-entry}.")) + +(define (home-xdg-mime-applications-files-service config) + (define (add-xdg-desktop-entry-file entry) + (let ((file (first entry)) + (config (second entry))) + (list (format #f "local/share/applications/~a" file) + (apply mixed-text-file + (format #f "xdg-desktop-~a-entry" file) + config)))) + + (append + `(("config/mimeapps.list" + ,(mixed-text-file + "xdg-mime-appplications" + (serialize-configuration + config + home-xdg-mime-applications-configuration-fields)))) + (map (compose add-xdg-desktop-entry-file serialize-xdg-desktop-entry) + (home-xdg-mime-applications-configuration-desktop-entries config)))) + +(define (home-xdg-mime-applications-extension old-config extension-configs) + (define (extract-fields config) + ;; return '(added default removed desktop-entries) + (list (home-xdg-mime-applications-configuration-added config) + (home-xdg-mime-applications-configuration-default config) + (home-xdg-mime-applications-configuration-removed config) + (home-xdg-mime-applications-configuration-desktop-entries config))) + + (define (append-configs elem acc) + (list (append (first elem) (first acc)) + (append (second elem) (second acc)) + (append (third elem) (third acc)) + (append (fourth elem) (fourth acc)))) + + ;; TODO: Implement procedure to check for duplicates without + ;; sacrificing performance. + ;; + ;; Combine all the alists from 'added', 'default' and 'removed' + ;; into one big alist. + (let ((folded-configs (fold append-configs + (extract-fields old-config) + (map extract-fields extension-configs)))) + (home-xdg-mime-applications-configuration + (added (first folded-configs)) + (default (second folded-configs)) + (removed (third folded-configs)) + (desktop-entries (fourth folded-configs))))) + +(define home-xdg-mime-applications-service-type + (service-type (name 'home-xdg-mime-applications) + (extensions + (list (service-extension + home-files-service-type + home-xdg-mime-applications-files-service))) + (compose identity) + (extend home-xdg-mime-applications-extension) + (default-value (home-xdg-mime-applications-configuration)) + (description + "Configure XDG MIME applications, and XDG desktop entries."))) diff --git a/gnu/home.scm b/gnu/home.scm new file mode 100644 index 0000000000..f4c9359e25 --- /dev/null +++ b/gnu/home.scm @@ -0,0 +1,106 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> +;;; +;;; 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) + #:use-module (gnu home-services) + #:use-module (gnu home-services symlink-manager) + #:use-module (gnu home-services shells) + #:use-module (gnu home-services xdg) + #:use-module (gnu home-services fontutils) + #:use-module (gnu services) + #:use-module (guix records) + #:use-module (guix diagnostics) + + #:export (home-environment + home-environment? + this-home-environment + + home-environment-derivation + home-environment-user-services + home-environment-essential-services + home-environment-services + home-environment-location + + home-environment-with-provenance)) + +;;; Comment: +;;; +;;; This module provides a <home-environment> record for managing +;;; per-user packages and configuration files in the similar way as +;;; <operating-system> do for system packages and configuration files. +;;; +;;; Code: + +(define-record-type* <home-environment> home-environment + make-home-environment + home-environment? + this-home-environment + + (packages home-environment-packages ; list of (PACKAGE OUTPUT...) + (default '())) + + (essential-services home-environment-essential-services ; list of services + (thunked) + (default (home-environment-default-essential-services + this-home-environment))) + + (services home-environment-user-services + (default '())) + + (location home-environment-location ; <location> + (default (and=> (current-source-location) + source-properties->location)) + (innate))) + +(define (home-environment-default-essential-services he) + "Return the list of essential services for home environment." + (list + (service home-run-on-first-login-service-type) + (service home-activation-service-type) + (service home-environment-variables-service-type) + + (service home-symlink-manager-service-type) + + (service home-fontconfig-service-type) + (service home-xdg-base-directories-service-type) + (service home-shell-profile-service-type) + + (service home-service-type) + (service home-profile-service-type (home-environment-packages he)))) + +(define* (home-environment-services he) + "Return all the services of home environment." + (instantiate-missing-services + (append (home-environment-user-services he) + (home-environment-essential-services he)))) + +(define* (home-environment-derivation he) + "Return a derivation that builds OS." + (let* ((services (home-environment-services he)) + (home (fold-services services + #:target-type home-service-type))) + (service-value home))) + +(define* (home-environment-with-provenance he config-file) + "Return a variant of HE that stores its own provenance information, +including CONFIG-FILE, if available. This is achieved by adding an instance +of HOME-PROVENANCE-SERVICE-TYPE to its services." + (home-environment + (inherit he) + (services (cons (service home-provenance-service-type config-file) + (home-environment-user-services he))))) diff --git a/gnu/local.mk b/gnu/local.mk index b8ae060326..5bd7dced5e 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -44,6 +44,7 @@ # Copyright © 2021 Arun Isaac <arunisaac@systemreboot.net> # Copyright © 2021 Sharlatan Hellseher <sharlatanus@gmail.com> # Copyright © 2021 Dmitry Polyakov <polyakov@liltechdude.xyz> +# Copyright © 2021 Andrew Tropin <andrew@trop.in> # # This file is part of GNU Guix. # @@ -72,6 +73,16 @@ GNU_SYSTEM_MODULES = \ %D%/bootloader/u-boot.scm \ %D%/bootloader/depthcharge.scm \ %D%/ci.scm \ + %D%/home.scm \ + %D%/home-services.scm \ + %D%/home-services/symlink-manager.scm \ + %D%/home-services/fontutils.scm \ + %D%/home-services/configuration.scm \ + %D%/home-services/shells.scm \ + %D%/home-services/shepherd.scm \ + %D%/home-services/mcron.scm \ + %D%/home-services/utils.scm \ + %D%/home-services/xdg.scm \ %D%/image.scm \ %D%/packages.scm \ %D%/packages/abduco.scm \ diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm new file mode 100644 index 0000000000..75df6d707d --- /dev/null +++ b/guix/scripts/home.scm @@ -0,0 +1,512 @@ +;;; 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 (guix scripts home) + #:use-module (gnu packages admin) + #:use-module ((gnu services) #:hide (delete)) + #:use-module (gnu packages) + #:use-module (gnu home) + #:use-module (gnu home-services) + #:use-module (guix channels) + #:use-module (guix derivations) + #:use-module (guix ui) + #:use-module (guix grafts) + #:use-module (guix packages) + #:use-module (guix profiles) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix scripts package) + #:use-module (guix scripts build) + #:use-module (guix scripts system search) + #:autoload (guix scripts pull) (channel-commit-hyperlink) + #:use-module (guix scripts home import) + #:use-module ((guix status) #:select (with-status-verbosity)) + #:use-module (guix gexp) + #:use-module (guix monads) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-35) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:export (guix-home)) + + +;;; +;;; Options. +;;; + +(define %user-module + (make-user-module '((gnu home)))) + +(define %guix-home + (string-append %profile-directory "/guix-home")) + +(define (show-help) + (display (G_ "Usage: guix home [OPTION ...] ACTION [ARG ...] [FILE] +Build the home environment declared in FILE according to ACTION. +Some ACTIONS support additional ARGS.\n")) + (newline) + (display (G_ "The valid values for ACTION are:\n")) + (newline) + (display (G_ "\ + search search for existing service types\n")) + (display (G_ "\ + reconfigure switch to a new home environment configuration\n")) + (display (G_ "\ + roll-back switch to the previous home environment configuration\n")) + (display (G_ "\ + describe describe the current home environment\n")) + (display (G_ "\ + list-generations list the home environment generations\n")) + (display (G_ "\ + switch-generation switch to an existing home environment configuration\n")) + (display (G_ "\ + delete-generations delete old home environment generations\n")) + (display (G_ "\ + build build the home environment without installing anything\n")) + (display (G_ "\ + import generates a home environment definition from dotfiles\n")) + + (show-build-options-help) + (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) + (newline) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define (verbosity-level opts) + "Return the verbosity level based on OPTS, the alist of parsed options." + (or (assoc-ref opts 'verbosity) + (if (eq? (assoc-ref opts 'action) 'build) + 2 1))) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix show"))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) + %standard-build-options)) + +(define %default-options + `((build-mode . ,(build-mode normal)) + (graft? . #t) + (substitutes? . #t) + (offload? . #t) + (print-build-trace? . #t) + (print-extended-build-trace? . #t) + (multiplexed-build-output? . #t) + (verbosity . 3) + (debug . 0))) + + +;;; +;;; Actions. +;;; + +(define* (perform-action action he + #:key + dry-run? + derivations-only? + use-substitutes?) + "Perform ACTION for home environment. " + + (define println + (cut format #t "~a~%" <>)) + + (mlet* %store-monad + ((he-drv (home-environment-derivation he)) + (drvs (mapm/accumulate-builds lower-object (list he-drv))) + (% (if derivations-only? + (return + (for-each (compose println derivation-file-name) drvs)) + (built-derivations drvs))) + + (he-out-path -> (derivation->output-path he-drv))) + (if (or dry-run? derivations-only?) + (return #f) + (begin + (for-each (compose println derivation->output-path) drvs) + + (case action + ((reconfigure) + (let* ((number (generation-number %guix-home)) + (generation (generation-file-name + %guix-home (+ 1 number)))) + + (switch-symlinks generation he-out-path) + (switch-symlinks %guix-home generation) + (setenv "GUIX_NEW_HOME" he-out-path) + (primitive-load (string-append he-out-path "/activate")) + (setenv "GUIX_NEW_HOME" #f) + (return he-out-path))) + (else + (newline) + (return he-out-path))))))) + +(define (process-action action args opts) + "Process ACTION, a sub-command, with the arguments are listed in ARGS. +ACTION must be one of the sub-commands that takes a home environment +declaration as an argument (a file name.) OPTS is the raw alist of options +resulting from command-line parsing." + (define (ensure-home-environment file-or-exp obj) + (unless (home-environment? obj) + (leave (G_ "'~a' does not return a home environment ~%") + file-or-exp)) + obj) + + (let* ((file (match args + (() #f) + ((x . _) x))) + (expr (assoc-ref opts 'expression)) + (system (assoc-ref opts 'system)) + + (transform (lambda (obj) + (home-environment-with-provenance obj file))) + + (home-environment + (transform + (ensure-home-environment + (or file expr) + (cond + ((and expr file) + (leave + (G_ "both file and expression cannot be specified~%"))) + (expr + (read/eval expr)) + (file + (load* file %user-module + #:on-error (assoc-ref opts 'on-error))) + (else + (leave (G_ "no configuration specified~%"))))))) + + (dry? (assoc-ref opts 'dry-run?))) + + (with-store store + (set-build-options-from-command-line store opts) + (with-build-handler (build-notifier #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:verbosity + (verbosity-level opts) + #:dry-run? + (assoc-ref opts 'dry-run?)) + + (run-with-store store + (mbegin %store-monad + (set-guile-for-build (default-guile)) + + (case action + (else + (perform-action action home-environment + #:dry-run? dry? + #:derivations-only? (assoc-ref opts 'derivations-only?) + #:use-substitutes? (assoc-ref opts 'substitutes?)) + )))))) + (warn-about-disk-space))) + + +(define (process-command command args opts) + "Process COMMAND, one of the 'guix home' sub-commands. ARGS is its +argument list and OPTS is the option alist." + (define-syntax-rule (with-store* store exp ...) + (with-store store + (set-build-options-from-command-line store opts) + exp ...)) + (case command + ;; The following commands do not need to use the store, and they do not need + ;; an home environment file. + ((search) + (apply search args)) + ((import) + (let* ((profiles (delete-duplicates + (match (filter-map (match-lambda + (('profile . p) p) + (_ #f)) + opts) + (() (list %current-profile)) + (lst (reverse lst))))) + (manifest (concatenate-manifests + (map profile-manifest profiles)))) + (import-manifest manifest (current-output-port)))) + ((describe) + (match (generation-number %guix-home) + (0 + (error (G_ "no home environment generation, nothing to describe~%"))) + (generation + (display-home-environment-generation generation)))) + ((list-generations) + (let ((pattern (match args + (() #f) + ((pattern) pattern) + (x (leave (G_ "wrong number of arguments~%")))))) + (list-generations pattern))) + ((switch-generation) + (let ((pattern (match args + ((pattern) pattern) + (x (leave (G_ "wrong number of arguments~%")))))) + (with-store* store + (switch-to-home-environment-generation store pattern)))) + ((roll-back) + (let ((pattern (match args + (() "") + (x (leave (G_ "wrong number of arguments~%")))))) + (with-store* store + (roll-back-home-environment store)))) + ((delete-generations) + (let ((pattern (match args + (() #f) + ((pattern) pattern) + (x (leave (G_ "wrong number of arguments~%")))))) + (with-store* + store + (delete-matching-generations store %guix-home pattern)))) + (else (process-action command args opts)))) + +(define-command (guix-home . args) + (synopsis "build and deploy home environments") + + (define (parse-sub-command arg result) + ;; Parse sub-command ARG and augment RESULT accordingly. + (if (assoc-ref result 'action) + (alist-cons 'argument arg result) + (let ((action (string->symbol arg))) + (case action + ((build + reconfigure + extension-graph shepherd-graph + list-generations describe + delete-generations roll-back + switch-generation search + import) + (alist-cons 'action action result)) + (else (leave (G_ "~a: unknown action~%") action)))))) + + (define (match-pair car) + ;; Return a procedure that matches a pair with CAR. + (match-lambda + ((head . tail) + (and (eq? car head) tail)) + (_ #f))) + + (define (option-arguments opts) + ;; Extract the plain arguments from OPTS. + (let* ((args (reverse (filter-map (match-pair 'argument) opts))) + (count (length args)) + (action (assoc-ref opts 'action)) + (expr (assoc-ref opts 'expression))) + (define (fail) + (leave (G_ "wrong number of arguments for action '~a'~%") + action)) + + (unless action + (format (current-error-port) + (G_ "guix home: missing command name~%")) + (format (current-error-port) + (G_ "Try 'guix home --help' for more information.~%")) + (exit 1)) + + (case action + ((build reconfigure) + (unless (or (= count 1) + (and expr (= count 0))) + (fail))) + ((init) + (unless (= count 2) + (fail)))) + args)) + + (with-error-handling + (let* ((opts (parse-command-line args %options + (list %default-options) + #:argument-handler + parse-sub-command)) + (args (option-arguments opts)) + (command (assoc-ref opts 'action))) + (parameterize ((%graft? (assoc-ref opts 'graft?))) + (with-status-verbosity (verbosity-level opts) + (process-command command args opts)))))) + + +;;; +;;; Searching. +;;; + +(define service-type-name* + (compose symbol->string service-type-name)) + +(define (service-type-description-string type) + "Return the rendered and localised description of TYPE, a service type." + (and=> (service-type-description type) + (compose texi->plain-text P_))) + +(define %service-type-metrics + ;; Metrics used to estimate the relevance of a search result. + `((,service-type-name* . 3) + (,service-type-description-string . 2) + (,(lambda (type) + (match (and=> (service-type-location type) location-file) + ((? string? file) + (basename file ".scm")) + (#f + ""))) + . 1))) + +(define (find-service-types regexps) + "Return a list of service type/score pairs: service types whose name or +description matches REGEXPS sorted by relevance, and their score." + (let ((matches (fold-home-service-types + (lambda (type result) + (match (relevance type regexps + %service-type-metrics) + ((? zero?) + result) + (score + (cons (cons type score) result)))) + '()))) + (sort matches + (lambda (m1 m2) + (match m1 + ((type1 . score1) + (match m2 + ((type2 . score2) + (if (= score1 score2) + (string>? (service-type-name* type1) + (service-type-name* type2)) + (> score1 score2)))))))))) + +(define (search . args) + (with-error-handling + (let* ((regexps (map (cut make-regexp* <> regexp/icase) args)) + (matches (find-service-types regexps))) + (leave-on-EPIPE + (display-search-results matches (current-output-port) + #:print service-type->recutils + #:command "guix home search"))))) + + +;;; +;;; Generations. +;;; + +(define* (display-home-environment-generation + number + #:optional (profile %guix-home)) + "Display a summary of home-environment generation NUMBER in a +human-readable format." + (define (display-channel channel) + (format #t " ~a:~%" (channel-name channel)) + (format #t (G_ " repository URL: ~a~%") (channel-url channel)) + (when (channel-branch channel) + (format #t (G_ " branch: ~a~%") (channel-branch channel))) + (format #t (G_ " commit: ~a~%") + (if (supports-hyperlinks?) + (channel-commit-hyperlink channel) + (channel-commit channel)))) + + (unless (zero? number) + (let* ((generation (generation-file-name profile number))) + (define-values (channels config-file) + ;; The function will work for home environments too, we just + ;; need to keep provenance file. + (system-provenance generation)) + + (display-generation profile number) + (format #t (G_ " file name: ~a~%") generation) + (format #t (G_ " canonical file name: ~a~%") (readlink* generation)) + ;; TRANSLATORS: Please preserve the two-space indentation. + + (unless (null? channels) + ;; TRANSLATORS: Here "channel" is the same terminology as used in + ;; "guix describe" and "guix pull --channels". + (format #t (G_ " channels:~%")) + (for-each display-channel channels)) + (when config-file + (format #t (G_ " configuration file: ~a~%") + (if (supports-hyperlinks?) + (file-hyperlink config-file) + config-file)))))) + +(define* (list-generations pattern #:optional (profile %guix-home)) + "Display in a human-readable format all the home environment +generations matching PATTERN, a string. When PATTERN is #f, display +all the home environment generations." + (cond ((not (file-exists? profile)) ; XXX: race condition + (raise (condition (&profile-not-found-error + (profile profile))))) + ((not pattern) + (for-each display-home-environment-generation (profile-generations profile))) + ((matching-generations pattern profile) + => + (lambda (numbers) + (if (null-list? numbers) + (exit 1) + (leave-on-EPIPE + (for-each display-home-environment-generation numbers))))))) + + +;;; +;;; Switch generations. +;;; + +;; TODO: Make it public in (guix scripts system) +(define-syntax-rule (unless-file-not-found exp) + (catch 'system-error + (lambda () + exp) + (lambda args + (if (= ENOENT (system-error-errno args)) + #f + (apply throw args))))) + +(define (switch-to-home-environment-generation store spec) + "Switch the home-environment profile to the generation specified by +SPEC. STORE is an open connection to the store." + (let* ((number (relative-generation-spec->number %guix-home spec)) + (generation (generation-file-name %guix-home number)) + (activate (string-append generation "/activate"))) + (if number + (begin + (setenv "GUIX_NEW_HOME" (readlink generation)) + (switch-to-generation* %guix-home number) + (unless-file-not-found (primitive-load activate)) + (setenv "GUIX_NEW_HOME" #f)) + (leave (G_ "cannot switch to home environment generation '~a'~%") spec)))) + + +;;; +;;; Roll-back. +;;; + +(define (roll-back-home-environment store) + "Roll back the home-environment profile to its previous generation. +STORE is an open connection to the store." + (switch-to-home-environment-generation store "-1")) diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm new file mode 100644 index 0000000000..39f45dbeac --- /dev/null +++ b/guix/scripts/home/import.scm @@ -0,0 +1,241 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> +;;; +;;; 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 (guix scripts home import) + #:use-module (guix profiles) + #:use-module (guix ui) + #:use-module (ice-9 match) + #:use-module (ice-9 pretty-print) + #:use-module (srfi srfi-1) + #:export (import-manifest)) + +;;; Commentary: +;;; +;;; This module provides utilities for generating home service +;;; configurations from existing "dotfiles". +;;; +;;; Code: + + +(define (generate-bash-module+configuration) + (let ((rc (string-append (getenv "HOME") "/.bashrc")) + (profile (string-append (getenv "HOME") "/.bash_profile")) + (logout (string-append (getenv "HOME") "/.bash_logout"))) + `((gnu home-services bash) + (service home-bash-service-type + (home-bash-configuration + ,@(if (file-exists? rc) + `((bashrc + (list (slurp-file-gexp (local-file ,rc))))) + '()) + ,@(if (file-exists? profile) + `((bash-profile + (list (slurp-file-gexp + (local-file ,profile))))) + '()) + ,@(if (file-exists? logout) + `((bash-logout + (list (slurp-file-gexp + (local-file ,logout))))) + '())))))) + + +(define %files-configurations-alist + `((".bashrc" . ,generate-bash-module+configuration) + (".bash_profile" . ,generate-bash-module+configuration) + (".bash_logout" . ,generate-bash-module+configuration))) + +(define (modules+configurations) + (let ((configurations (delete-duplicates + (filter-map (match-lambda + ((file . proc) + (if (file-exists? + (string-append (getenv "HOME") "/" file)) + proc + #f))) + %files-configurations-alist) + (lambda (x y) + (equal? (procedure-name x) (procedure-name y)))))) + (map (lambda (proc) (proc)) configurations))) + +;; Based on `manifest->code' from (guix profiles) +;; MAYBE: Upstream it? +(define* (manifest->code manifest + #:key + (entry-package-version (const "")) + (home-environment? #f)) + "Return an sexp representing code to build an approximate version of +MANIFEST; the code is wrapped in a top-level 'begin' form. If +HOME-ENVIRONMENT? is #t, return an <home-environment> definition. +Call ENTRY-PACKAGE-VERSION to determine the version number to use in +the spec for a given entry; it can be set to 'manifest-entry-version' +for fully-specified version numbers, or to some other procedure to +disambiguate versions for packages for which several versions are +available." + (define (entry-transformations entry) + ;; Return the transformations that apply to ENTRY. + (assoc-ref (manifest-entry-properties entry) 'transformations)) + + (define transformation-procedures + ;; List of transformation options/procedure name pairs. + (let loop ((entries (manifest-entries manifest)) + (counter 1) + (result '())) + (match entries + (() result) + ((entry . tail) + (match (entry-transformations entry) + (#f + (loop tail counter result)) + (options + (if (assoc-ref result options) + (loop tail counter result) + (loop tail (+ 1 counter) + (alist-cons options + (string->symbol + (format #f "transform~a" counter)) + result))))))))) + + (define (qualified-name entry) + ;; Return the name of ENTRY possibly with "@" followed by a version. + (match (entry-package-version entry) + ("" (manifest-entry-name entry)) + (version (string-append (manifest-entry-name entry) + "@" version)))) + + (if (null? transformation-procedures) + (let ((specs (map (lambda (entry) + (match (manifest-entry-output entry) + ("out" (qualified-name entry)) + (output (string-append (qualified-name entry) + ":" output)))) + (manifest-entries manifest)))) + (if home-environment? + (let ((modules+configurations (modules+configurations))) + `(begin + (use-modules (gnu home) + (gnu packages) + ,@(map first modules+configurations)) + ,(home-environment-template + #:specs specs + #:services (map second modules+configurations)))) + `(begin + (use-modules (gnu packages)) + + (specifications->manifest + (list ,@specs))))) + (let* ((transform (lambda (options exp) + (if (not options) + exp + (let ((proc (assoc-ref transformation-procedures + options))) + `(,proc ,exp))))) + (packages (map (lambda (entry) + (define options + (entry-transformations entry)) + + (define name + (qualified-name entry)) + + (match (manifest-entry-output entry) + ("out" + (transform options + `(specification->package ,name))) + (output + `(list ,(transform + options + `(specification->package ,name)) + ,output)))) + (manifest-entries manifest))) + (transformations (map (match-lambda + ((options . name) + `(define ,name + (options->transformation ',options)))) + transformation-procedures))) + (if home-environment? + (let ((modules+configurations (modules+configurations))) + `(begin + (use-modules (guix transformations) + (gnu home) + (gnu packages) + ,@(map first modules+configurations)) + + ,@transformations + + ,(home-environment-template + #:packages packages + #:services (map second modules+configurations)))) + `(begin + (use-modules (guix transformations) + (gnu packages)) + + ,@transformations + + (packages->manifest + (list ,@packages))))))) + +(define* (home-environment-template #:key (packages #f) (specs #f) services) + "Return an S-exp containing a <home-environment> declaration +containing PACKAGES, or SPECS (package specifications), and SERVICES." + `(home-environment + (packages + ,@(if packages + `((list ,@packages)) + `((map specification->package + (list ,@specs))))) + (services (list ,@services)))) + +(define* (import-manifest + manifest + #:optional (port (current-output-port))) + "Write to PORT a <home-environment> corresponding to MANIFEST." + (define (version-spec entry) + (let ((name (manifest-entry-name entry))) + (match (map package-version (find-packages-by-name name)) + ((_) + ;; A single version of NAME is available, so do not specify the + ;; version number, even if the available version doesn't match ENTRY. + "") + (versions + ;; If ENTRY uses the latest version, don't specify any version. + ;; Otherwise return the shortest unique version prefix. Note that + ;; this is based on the currently available packages, which could + ;; differ from the packages available in the revision that was used + ;; to build MANIFEST. + (let ((current (manifest-entry-version entry))) + (if (every (cut version>? current <>) + (delete current versions)) + "" + (version-unique-prefix (manifest-entry-version entry) + versions))))))) + + (match (manifest->code manifest + #:entry-package-version version-spec + #:home-environment? #t) + (('begin exp ...) + (format port (G_ "\ +;; This \"home-environment\" file can be passed to 'guix home reconfigure' +;; to reproduce the content of your profile. This is \"symbolic\": it only +;; specifies package names. To reproduce the exact same profile, you also +;; need to capture the channels being used, as returned by \"guix describe\". +;; See the \"Replicating Guix\" section in the manual.\n")) + (for-each (lambda (exp) + (newline port) + (pretty-print exp port)) + exp)))) diff --git a/guix/self.scm b/guix/self.scm index 79d93357a2..5922ea6aa1 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -958,13 +958,23 @@ itself." #:guile-for-build guile-for-build)) + (define *home-modules* + (scheme-node "guix-home" + `((gnu home) + (gnu home-services) + ,@(scheme-modules* source "gnu/home-services")) + (list *core-package-modules* *package-modules* + *extra-modules* *core-modules* *system-modules*) + #:extensions dependencies + #:guile-for-build guile-for-build)) + (define *cli-modules* (scheme-node "guix-cli" (append (scheme-modules* source "/guix/scripts") `((gnu ci))) (list *core-modules* *extra-modules* *core-package-modules* *package-modules* - *system-modules*) + *system-modules* *home-modules*) #:extensions dependencies #:guile-for-build guile-for-build)) @@ -1012,6 +1022,7 @@ itself." *cli-modules* *system-test-modules* *system-modules* + *home-modules* *package-modules* *core-package-modules* *extra-modules* |