From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id qHOWJXCz9WAmuAAAgWs5BA (envelope-from ) for ; Mon, 19 Jul 2021 19:16:32 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id WElWIXCz9WDKcgAA1q6Kng (envelope-from ) for ; Mon, 19 Jul 2021 17:16:32 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 871E719CA3 for ; Mon, 19 Jul 2021 19:16:31 +0200 (CEST) Received: from localhost ([::1]:51854 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1m5WsY-0000yT-Jw for larch@yhetil.org; Mon, 19 Jul 2021 13:16:30 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:42802) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1m5WsC-0000FI-0J for guix-patches@gnu.org; Mon, 19 Jul 2021 13:16:09 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:48671) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1m5Ws6-0004bC-6U for guix-patches@gnu.org; Mon, 19 Jul 2021 13:16:07 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1m5Ws6-0000uo-2Y for guix-patches@gnu.org; Mon, 19 Jul 2021 13:16:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#49419] [PATCH v3 1/4] home-services: Add most essential home services References: <87y2akhiz1.fsf@trop.in> Resent-From: Andrew Tropin Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 19 Jul 2021 17:16:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 49419 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 49419@debbugs.gnu.org Received: via spool by 49419-submit@debbugs.gnu.org id=B49419.16267149331648 (code B ref 49419); Mon, 19 Jul 2021 17:16:02 +0000 Received: (at 49419) by debbugs.gnu.org; 19 Jul 2021 17:15:33 +0000 Received: from localhost ([127.0.0.1]:60207 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1m5Wrc-0000Pk-16 for submit@debbugs.gnu.org; Mon, 19 Jul 2021 13:15:32 -0400 Received: from mail-lf1-f46.google.com ([209.85.167.46]:35478) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1m5Wra-0000Hk-5J for 49419@debbugs.gnu.org; Mon, 19 Jul 2021 13:15:31 -0400 Received: by mail-lf1-f46.google.com with SMTP id i5so31484648lfe.2 for <49419@debbugs.gnu.org>; Mon, 19 Jul 2021 10:15:30 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=trop-in.20150623.gappssmtp.com; s=20150623; h=from:to:subject:in-reply-to:date:message-id:mime-version; bh=mGKammPXpQo7ZmQA4JaaWKm3bImCdj++E7lhep3Q1Zk=; b=y5QoMyr5diYodXu2q8Cw/Y+WZuJn9T75eE3En52oLPvNsR1wP8LhnitZrG70+mT2c6 LM8d8EpSqwtS4lgSV4RqP+qH37efTaEfI3wXcpHd2kV9vHyI9gpaaUA5m96BSdu9XaZl NItf8JnX8gqCh7S6yqEqScOTXL9OIo0spcGET+DH+UXL08wbDF9h4zodJ8XrlXhIW0kZ 9hWvU7BZgG8czKITRqH5L0vxPqx1DoVJVGc2nNZus3WyK4mJl09tg7RvH7XThz1k+90f xB6XhXQ8KNxMXmgcEFunGVdhgYk2X5GrDZCUw2uzTNOXE+KbVPLANPB8B5B2G8gC7N1Y TjLQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:in-reply-to:date:message-id :mime-version; bh=mGKammPXpQo7ZmQA4JaaWKm3bImCdj++E7lhep3Q1Zk=; b=ZbRaD24esdVm1E8csVwmZcKqmZ9/u6XEojWmd3XuwY1XOEoXnBjtzH5UjjtYn+bEDw Y3zDePG4vINJrXyqATcNngWwo1HcVQiDhGnHyqLBXWcvCYXIZFLqwKQHHJD9EFYvA8Rn SOzyhEB7fDkCSmkpR8Vgy3U7+LB0NQE2WhiCrySnXqY98lOrvVrSDI1GtXqTdXainZwS lrI7BoGkQneJ76wU72SjgZfN0BB0qi7wQsMnsTzsEmtpSarEPf9paVI64BXiY13xcMmQ Afr0Iv1yst+he+p2beijJv2l6I2OFM8bzumIoT3a/CRmZmAxsMpQD7XW3HeTIBLAJyTu vpjQ== X-Gm-Message-State: AOAM530WnRVWuJpqRweuRNPxIoID7YS+AUynB9Y5l5FRHLuF5rXRJmjb 2Odb0lHbT8ypNfUtHlXb//MsILq5borLmA== X-Google-Smtp-Source: ABdhPJyqQuop3rDZ+RzazCQDc67a7qXEbVGwhUi7LVoTudAFdrKKgdZrZZzVP3+flIE0ANZfOtRY9A== X-Received: by 2002:a05:6512:1517:: with SMTP id bq23mr6342528lfb.48.1626714923963; Mon, 19 Jul 2021 10:15:23 -0700 (PDT) Received: from localhost ([85.249.24.60]) by smtp.gmail.com with ESMTPSA id s14sm2166019ljj.88.2021.07.19.10.15.22 for <49419@debbugs.gnu.org> (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 19 Jul 2021 10:15:23 -0700 (PDT) From: Andrew Tropin In-Reply-To: <87v956g1g5.fsf@trop.in> Date: Mon, 5 Jul 2021 18:37:13 +0300 Message-ID: <87tukqg1am.fsf@trop.in> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1626714992; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-type:content-type:resent-cc:resent-from:resent-sender: resent-message-id:in-reply-to:in-reply-to:references:references: list-id:list-help:list-unsubscribe:list-subscribe:list-post: dkim-signature; bh=mGKammPXpQo7ZmQA4JaaWKm3bImCdj++E7lhep3Q1Zk=; b=mEInKYfCkEKHTiiYXhbrFDhE0fEyPXakRbkP+MzVhwo7JwsFc9EALthfjlpohOn1qH7fvE VFS0+hFyKmHeDxJA8PbBjDJvIzCkKZlUikGau5vVqoHId+dS+U/XzqCZT+Y4FCcXnvD5iW AE/bNnHk4vn+QZTDngb9oIFsltshLOLe8tHHpRMESDZZSUqsmp++OO8wRIfq8iP4fcTAfd QFnmQb9jb4F2P8+NNXm679T6iAhgrYko6XjRtonoATU8e6Bk8SvbpBozl8Fkr46gYAE0z3 CL6nKVTinQtqTCE5rSlrceWrQSHHsXDvj6WDLPwVnT/QeJ8rw5LUXW2nlZpu5w== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1626714992; a=rsa-sha256; cv=none; b=iLT5lgzS+F/YCLO11+UUwLQFDAg1LstViPzqdSTEdA0dumsa7R6rqPHzyIBpkEgHNFIf4+ qYKoz2D1N8dnf2h7JIMGBOgAq/v7soe1/yRruuq9RAKWe8vtivyMSsTeADzrB2HC/PxKcJ h0pUFjHklDQZkDXE9NWjrqLNLhDtmV45MavFvyR7Vd2tU+C+jpZVuom9OqY9cccMmbrK4d mldH7tvGnKtVfQBggk+pisfmBN8TdgiPilbdQmLT8fAITWvUSvuRT3QAqu/NFjkMCVpyw/ 6v4nVlSudn5TKiwRXDOiuz7VqLUKpn04hFsb4plbDXEkfypwePyB019pnBgcIg== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=trop-in.20150623.gappssmtp.com header.s=20150623 header.b=y5QoMyr5; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Spam-Score: -2.51 Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=trop-in.20150623.gappssmtp.com header.s=20150623 header.b=y5QoMyr5; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: 871E719CA3 X-Spam-Score: -2.51 X-Migadu-Scanner: scn0.migadu.com X-TUID: U4neau69XbvS --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable home-service-type is a root of home services DAG. home-profile-service-type is almost the same as profile-service-type, at le= ast 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 progr= am, 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 h= ome 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 crea= tes links for various dotfiles (like $XDG_CONFIG_HOME/$APP/...) to store, but is possible to implement alternative approaches like read-only home from Julie= n'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: =2D 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. =2D Sets GUIX_NEW_HOME and possibly GUIX_OLD_HOME vars to paths in the stor= e. Later those variables can be used by activation gexps, for example by symlink-manager or run-on-change services. =2D Run all activation gexps provided by other home services. =2D-- gnu/home-services.scm | 328 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 328 insertions(+) create mode 100644 gnu/home-services.scm diff --git a/gnu/home-services.scm b/gnu/home-services.scm new file mode 100644 index 0000000000..a89a061a81 =2D-- /dev/null +++ b/gnu/home-services.scm @@ -0,0 +1,328 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2021 Andrew Tropin +;;; Copyright =C2=A9 2021 Xinglu Chen +;;; +;;; 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 . + +(define-module (gnu home-services) + #:use-module (gnu services) + #:use-module (guix channels) + #:use-module (guix monads) + #:use-module (guix store) + #:use-module (guix gexp) + #:use-module (guix profiles) + #:use-module (guix sets) + #:use-module (guix ui) + #:use-module (guix discovery) + #:use-module (guix diagnostics) + + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + + #:export (home-service-type + home-profile-service-type + home-environment-variables-service-type + home-files-service-type + home-run-on-first-login-service-type + home-activation-service-type) + + #:re-export (service + service-type + service-extension)) + +;;; Comment: +;;; +;;; This module is similar to (gnu system services) module, but +;;; provides Home Services, which are supposed to be used for building +;;; home-environment. +;;; +;;; Home Services use the same extension as System Services. Consult +;;; (gnu system services) module or manual for more information. +;;; +;;; Code: + + +(define (home-derivation entries mextensions) + "Return as a monadic value the derivation of the 'home' +directory containing the given entries." + (mlet %store-monad ((extensions (mapm/accumulate-builds identity + mextensions))) + (lower-object + (file-union "home" (append entries (concatenate extensions)))))) + +(define home-service-type + ;; This is the ultimate service type, the root of the home service + ;; DAG. The service of this type is extended by monadic name/item + ;; pairs. These items end up in the "home-environment directory" as + ;; returned by 'home-environment-derivation'. + (service-type (name 'home) + (extensions '()) + (compose identity) + (extend home-derivation) + (default-value '()) + (description + "Build the home environment top-level directory, +which in turn refers to everything the home environment needs: its +packages, configuration files, activation script, and so on."))) + +(define (packages->profile-entry packages) + "Return a system entry for the profile containing PACKAGES." + ;; XXX: 'mlet' is needed here for one reason: to get the proper + ;; '%current-target' and '%current-target-system' bindings when + ;; 'packages->manifest' is called, and thus when the 'package-inputs' + ;; etc. procedures are called on PACKAGES. That way, conditionals in th= ose + ;; inputs see the "correct" value of these two parameters. See + ;; . + (mlet %store-monad ((_ (current-target-system))) + (return `(("profile" ,(profile + (content (packages->manifest + (map identity + ;;(options->transformation transforma= tions) + (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) + (stringsetup-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-environme= nt"))) + (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 interac= tively + (dirname (car (command-line))))) + (old-home-env (getenv "GUIX_OLD_HOME")) + (old-home (or old-home-env + (if (file-exists? (he-init-file he-path)) + (readlink he-path) + #f)))) + (if (file-exists? (he-init-file new-home)) + (let* ((port ((@ (ice-9 popen) open-input-pipe) + (format #f "source ~a && env" + (he-init-file new-home)))) + (result ((@ (ice-9 rdelim) read-delimited) "" port)) + (vars (map (lambda (x) + (let ((si (string-index x #\=3D))) + (cons (string-take x si) + (string-drop x (1+ si))))) + ((@ (srfi srfi-1) remove) + string-null? + (string-split result #\newline))))) + (close-port port) + (map (lambda (x) (setenv (car x) (cdr x))) vars) + + (setenv "GUIX_NEW_HOME" new-home) + (setenv "GUIX_OLD_HOME" old-home) + + #$@gexps + + ;; Do not unset env variable if it was set outside. + (unless new-home-env (setenv "GUIX_NEW_HOME" #f)) + (unless old-home-env (setenv "GUIX_OLD_HOME" #f))) + (format #t "\ +Activation script was either called or loaded by file from this direcotry: +~a +It doesn't seem that home environment is somewhere around. +Make sure that you call ./activate by symlink from -home store item.\n" + new-home))))) + +(define (activation-script-entry m-activation) + "Return, as a monadic value, an entry for the activation script +in the home environment directory." + (mlet %store-monad ((activation m-activation)) + (return `(("activate" ,activation))))) + +(define home-activation-service-type + (service-type (name 'home-activation) + (extensions + (list (service-extension + home-service-type + activation-script-entry))) + (compose identity) + (extend compute-activation-script) + (default-value #f) + (description "Run gexps to activate the current +generation of home environment and update the state of the home +directory. @command{activate} script automatically called during +reconfiguration or generation switching. This service can be extended +with one gexp, but many times, and all gexps must be idempotent."))) + =2D-=20 2.32.0 --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJDBAEBCgAtFiEEKEGaxlA4dEDH6S/6IgjSCVjB3rAFAmD1NnEPHGFuZHJld0B0 cm9wLmluAAoJECII0glYwd6wKj0P/1yJqD1Co76x/igTqNPHhMpJLsQKUHjm3CyD DsxZwnO+UuMA3by1lXaBTAyic66yHmnPgE7IPz4pozwAE2Xva8ABBqdPVaexMJzP 0/tQ/gCo3/QNhU1buCzh8NGVkXXiPhwl0m1mf0OGCRGokrR3igYOaFOpmhHxFqhk y6SBOu4/dtiIgtr2RpmXdqEQXz+PrPjDm45R2ECAKiPrMmxJ7gxEa9wg8j1f5MAV 2ZA6iibuOEszlxsmBS4BMCRy3bqxrX4PH5zGiUJpnTlE8adbYYszl8ZsWfv0uKeA EJ3jLxr5djLvKwWkNEHPsjP9LEoAdW5pkcz/5MYVu8vws7ipKuHJlG2BdNtjHKFz jbgQbPKkwJm9+W81rIUoOCUloe6rcfWYIE6UUH5xiMtd7xRv5xqyF60YUfLOgKKi KR5D6a+pFpZdErdfF3wLYTbdGkGEw+FdC7x8OWUmpXWWBoyX4V44Tqd5o5eQ7c7l OM2559idBWCNT7BV+ycYrpksV3YTUlK8qMk5vxO8MRKfhRGAOYN9sYwpziksjk0J ahaMNpcgaXlSbAHOlwUmdT6LuHCZsdm8r1cmN99ztQpnOlLPxB8/QXoTijNBb/ja NIVghlpSaTt6YItOV8gT5gWf5kKDpuVUs4CnezV+fzigQJhKGweel79ZtBHOA4ud LSK5fIIb =5c5Y -----END PGP SIGNATURE----- --=-=-=--