From patchwork Thu Aug 5 05:45:38 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Andrew Tropin X-Patchwork-Id: 31835 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 27ACB27BC6B; Thu, 5 Aug 2021 06:49:11 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 3E68627BC78 for ; Thu, 5 Aug 2021 06:49:10 +0100 (BST) Received: from localhost ([::1]:46332 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mBWFh-0001lM-9k for patchwork@mira.cbaines.net; Thu, 05 Aug 2021 01:49:09 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:36730) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mBWFa-0001kh-Fv for guix-patches@gnu.org; Thu, 05 Aug 2021 01:49:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:34105) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mBWFa-0001Ax-9M for guix-patches@gnu.org; Thu, 05 Aug 2021 01:49:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mBWFa-0006no-8C for guix-patches@gnu.org; Thu, 05 Aug 2021 01:49:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#49419] [PATCH v4 1/4] home-services: Add most essential home services Resent-From: Andrew Tropin Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 05 Aug 2021 05:49: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.162814250226041 (code B ref 49419); Thu, 05 Aug 2021 05:49:02 +0000 Received: (at 49419) by debbugs.gnu.org; 5 Aug 2021 05:48:22 +0000 Received: from localhost ([127.0.0.1]:45638 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mBWEv-0006lw-58 for submit@debbugs.gnu.org; Thu, 05 Aug 2021 01:48:21 -0400 Received: from mail-lf1-f49.google.com ([209.85.167.49]:39786) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mBWEt-0006lU-0U for 49419@debbugs.gnu.org; Thu, 05 Aug 2021 01:48:20 -0400 Received: by mail-lf1-f49.google.com with SMTP id t9so8827830lfc.6 for <49419@debbugs.gnu.org>; Wed, 04 Aug 2021 22:48:18 -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:references:date:message-id:mime-version; bh=kYHjrgm4fUtztklEgus04dPZaqWxTVg6VLzyoxJf7SA=; b=YxfIp2TW6x7XuA4B2Q/E2nLl6gxDTaVwiKg7OlTZS+MGUNDo+AIySE6umXkvinoyx9 dxWgNKyosadEiQQh+1AImmZ6TtMfrYvstYziv9u2JPKBJ0Evwr7n1BAQcbgbAEXLIUrd HyJvIY/jMDxQ1h/yM739LhzWWz24ukkLVf3Uz+xlbDDEh5SHSQd73783ahnJxBh9qUUj 5RF/yG4McrVbziwLcmUb0bgODvL5RT/pS8WJxboToAxBO/Lgx8wnsq3Ty7fvsLC/feDD cOGVraiYQzTdBpxZjJJUGQtyDU92u4yNHUmatqBqTej8b54z1cFLc42o0opYn3Qxi/uZ wVig== 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:references:date :message-id:mime-version; bh=kYHjrgm4fUtztklEgus04dPZaqWxTVg6VLzyoxJf7SA=; b=sNfL0hdHAKPMUiEelN8s5Z81ddlO7Q7pdFyiQZ/ScbJnRnTgmKexjqCgS5f3IknMsm 4df1KYf4DNtG/T3v/5sy8/IxIcbdtBQDlU4OmhN3N4i2EK/SsWSLcJQXwgP4HQJT+/yC A1c3WAfFZDyRqjsPcOKLBzEzY8v4GF5hSS8XDtQ8liElbA/qWeVWfnxPRKAeSgyUSFbp ae9X3X4VkbB3nFKmBNNXxRY1sy0NwHIwdqnIR68fE/l4SRi1A61M6NMrlQG2x/oJgriQ r1iR9h8hdGXYSpuhj93/nvj1Mq0Koa0Re1YD2erUXYAZjWbl4DixR01Ns5kRNZVMqaxG 0yZA== X-Gm-Message-State: AOAM533B5WpNpYyYH1K3pQpoEC7FY46G7jAV6bzO+zbt4lTpJ+6rNb1M 62u74jajSDV2ADi/iPXLw52KxZKbN4NvMHvk X-Google-Smtp-Source: ABdhPJx4N/pTH8gS8hrhW5yZ4yZOg6MCYI0aLrrQeV6oPEGVFnd6jXX+QBmBXKo7AlYq8PD8BBe21A== X-Received: by 2002:ac2:5fc7:: with SMTP id q7mr2262531lfg.524.1628142492439; Wed, 04 Aug 2021 22:48:12 -0700 (PDT) Received: from localhost (109-252-93-92.nat.spd-mgts.ru. [109.252.93.92]) by smtp.gmail.com with ESMTPSA id c16sm298793ljh.98.2021.08.04.22.48.11 for <49419@debbugs.gnu.org> (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 04 Aug 2021 22:48:11 -0700 (PDT) From: Andrew Tropin In-Reply-To: <87tuk4mors.fsf@trop.in> References: <87y2akhiz1.fsf@trop.in> <87tuk4mors.fsf@trop.in> Date: Thu, 05 Aug 2021 08:45:38 +0300 Message-ID: <87pmusmol9.fsf@trop.in> MIME-Version: 1.0 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+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/home-services.scm (home-service-type, home-profile-service-type) (home-environment-variables-service-type, home-files-service-type) (home-run-on-first-login-service-type, home-activation-service-type): New variables. --- gnu/home-services.scm | 368 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 368 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..4a6458abec --- /dev/null +++ b/gnu/home-services.scm @@ -0,0 +1,368 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Andrew Tropin +;;; Copyright © 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. +;;; +;;; home-service-type is a root of home services DAG. +;;; +;;; home-profile-service-type is almost the same as profile-service-type, at least +;;; for now. +;;; +;;; home-environment-variables-service-type generates a @file{setup-environment} +;;; shell script, which is expected to be sourced by login shell or other program, +;;; which starts early and spawns all other processes. Home services for shells +;;; automatically add code for sourcing this file, if person do not use those home +;;; services they have to source this script manually in their's shell *profile +;;; file (details described in the manual). +;;; +;;; home-files-service-type is similar to etc-service-type, but doesn't extend +;;; home-activation, because deploy mechanism for config files is pluggable and +;;; can be different for different home environments: The default one is called +;;; symlink-manager (will be introudced in a separate patch series), which creates +;;; links for various dotfiles (like $XDG_CONFIG_HOME/$APP/...) to store, but is +;;; possible to implement alternative approaches like read-only home from Julien's +;;; guix-home-manager. +;;; +;;; home-run-on-first-login-service-type provides an @file{on-first-login} guile +;;; script, which runs provided gexps once, when user makes first login. It can +;;; be used to start user's Shepherd and maybe some other process. It relies on +;;; assumption that /run/user/$UID will be created on login by some login +;;; manager (elogind for example). +;;; +;;; home-activation-service-type provides an @file{activate} guile script, which +;;; do three main things: +;;; +;;; - Sets environment variables to the values declared in +;;; @file{setup-environment} shell script. It's necessary, because user can set +;;; for example XDG_CONFIG_HOME and it should be respected by activation gexp of +;;; symlink-manager. +;;; +;;; - Sets GUIX_NEW_HOME and possibly GUIX_OLD_HOME vars to paths in the store. +;;; Later those variables can be used by activation gexps, for example by +;;; symlink-manager or run-on-change services. +;;; +;;; - Run all activation gexps provided by other home services. +;;; +;;; Code: + + +(define (home-derivation entries mextensions) + "Return as a monadic value the derivation of the 'home' +directory containing the given entries." + (mlet %store-monad ((extensions (mapm/accumulate-builds identity + mextensions))) + (lower-object + (file-union "home" (append entries (concatenate extensions)))))) + +(define home-service-type + ;; This is the ultimate service type, the root of the home service + ;; DAG. The service of this type is extended by monadic name/item + ;; pairs. These items end up in the "home-environment directory" as + ;; returned by 'home-environment-derivation'. + (service-type (name 'home) + (extensions '()) + (compose identity) + (extend home-derivation) + (default-value '()) + (description + "Build the home environment top-level directory, +which in turn refers to everything the home environment needs: its +packages, configuration files, activation script, and so on."))) + +(define (packages->profile-entry packages) + "Return a system entry for the profile containing PACKAGES." + ;; XXX: 'mlet' is needed here for one reason: to get the proper + ;; '%current-target' and '%current-target-system' bindings when + ;; 'packages->manifest' is called, and thus when the 'package-inputs' + ;; etc. procedures are called on PACKAGES. That way, conditionals in those + ;; inputs see the "correct" value of these two parameters. See + ;; . + (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) + (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-environment"))) + (he-path (string-append (getenv "HOME") "/.guix-home")) + (new-home-env (getenv "GUIX_NEW_HOME")) + (new-home (or new-home-env + ;; Path of the activation file if called interactively + (dirname (car (command-line))))) + (old-home-env (getenv "GUIX_OLD_HOME")) + (old-home (or old-home-env + (if (file-exists? (he-init-file he-path)) + (readlink he-path) + #f)))) + (if (file-exists? (he-init-file new-home)) + (let* ((port ((@ (ice-9 popen) open-input-pipe) + (format #f "source ~a && env" + (he-init-file new-home)))) + (result ((@ (ice-9 rdelim) read-delimited) "" port)) + (vars (map (lambda (x) + (let ((si (string-index x #\=))) + (cons (string-take x si) + (string-drop x (1+ si))))) + ((@ (srfi srfi-1) remove) + string-null? + (string-split result #\newline))))) + (close-port port) + (map (lambda (x) (setenv (car x) (cdr x))) vars) + + (setenv "GUIX_NEW_HOME" new-home) + (setenv "GUIX_OLD_HOME" old-home) + + #$@gexps + + ;; Do not unset env variable if it was set outside. + (unless new-home-env (setenv "GUIX_NEW_HOME" #f)) + (unless old-home-env (setenv "GUIX_OLD_HOME" #f))) + (format #t "\ +Activation script was either called or loaded by file from this direcotry: +~a +It doesn't seem that home environment is somewhere around. +Make sure that you call ./activate by symlink from -home store item.\n" + new-home))))) + +(define (activation-script-entry m-activation) + "Return, as a monadic value, an entry for the activation script +in the home environment directory." + (mlet %store-monad ((activation m-activation)) + (return `(("activate" ,activation))))) + +(define home-activation-service-type + (service-type (name 'home-activation) + (extensions + (list (service-extension + home-service-type + activation-script-entry))) + (compose identity) + (extend compute-activation-script) + (default-value #f) + (description "Run gexps to activate the current +generation of home environment and update the state of the home +directory. @command{activate} script automatically called during +reconfiguration or generation switching. This service can be extended +with one gexp, but many times, and all gexps must be idempotent."))) + From patchwork Thu Aug 5 05:46:22 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andrew Tropin X-Patchwork-Id: 31837 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 8553D27BC82; Thu, 5 Aug 2021 06:49:18 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 1221827BC6B for ; Thu, 5 Aug 2021 06:49:18 +0100 (BST) Received: from localhost ([::1]:46936 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mBWFp-0002AS-34 for patchwork@mira.cbaines.net; Thu, 05 Aug 2021 01:49:17 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:36732) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mBWFa-0001ku-RL for guix-patches@gnu.org; Thu, 05 Aug 2021 01:49:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:34106) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mBWFa-0001B3-LV for guix-patches@gnu.org; Thu, 05 Aug 2021 01:49:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mBWFa-0006nw-Kx for guix-patches@gnu.org; Thu, 05 Aug 2021 01:49:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#49419] [PATCH v4 2/4] home-services: Add home-run-on-change-service-type Resent-From: Andrew Tropin Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 05 Aug 2021 05:49: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.162814250426055 (code B ref 49419); Thu, 05 Aug 2021 05:49:02 +0000 Received: (at 49419) by debbugs.gnu.org; 5 Aug 2021 05:48:24 +0000 Received: from localhost ([127.0.0.1]:45641 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mBWEx-0006mB-Ul for submit@debbugs.gnu.org; Thu, 05 Aug 2021 01:48:24 -0400 Received: from mail-lf1-f53.google.com ([209.85.167.53]:46673) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mBWEw-0006ld-61 for 49419@debbugs.gnu.org; Thu, 05 Aug 2021 01:48:22 -0400 Received: by mail-lf1-f53.google.com with SMTP id n17so6144869lft.13 for <49419@debbugs.gnu.org>; Wed, 04 Aug 2021 22:48:22 -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:references:date:message-id:mime-version; bh=YlAzzSc+mdsxWuVnzk3GnyglD9z4SEk3pY2qS7tWLcg=; b=UcbkQCoQ3EizV+TlbZBDsq/VvdgOr9jOsz40hH+aP6qdnkgZkBtrZ/UYZwJWH0Ru7c Jxq169HKsB/aYVWCcIOBtE1+l/KWRjrMwv2nDeEqyn50Nc2ApK5ZFBj5kdnfbYUNmCuv XLeIauI4ioQSl2/f3s+pUMROroO9zZa2tvc/et3kFUxZCEJb8DxIcCQmSyB67TosQGJU ZsBVpXmH8pVD7vBI30sTwj7IIGp8dDX1O3bFVP4AXv5Fc83SeTZw76rD+Cx30Tk+Bs3A GlFYaBOdbPMcfadlfkWrd471CPj8Ziyj57mdqD8T1wek0GjE6I9N9hwQPaLc9UIasG08 2TaA== 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:references:date :message-id:mime-version; bh=YlAzzSc+mdsxWuVnzk3GnyglD9z4SEk3pY2qS7tWLcg=; b=lMLJVCorCtPrU1Xb/gOXdZgqKb6Q01aWNeYbeOBv6wlIteDx90jL5xNy02m9XgbNaY rCguSz2ziKmIBZbaimeL7vDY9n7AR7/pfKGX9kn4AwS0JWfUdiYzNi8p4CeM22iLotsq F1NYDJEWRbZCdXnFDwBWPILfYEGl/lwon/3dTTzU/fwfDRS95mINlV4WphdSUTfEr6Wp 8TFh0zBlUV1y0/LrdKPro6Wnse1jhEgX0XbJpakB6eiHGE6l8Kf/GtL1G28U4THfV+X3 yqbynyfYpNXtY1oZxdKhsXdZBepblsso0n1zBrMw7uq37f0R3jWHUfkuGqQpMPiS+Sw4 Lbew== X-Gm-Message-State: AOAM531VecMfZuqtGCb1lvSunh5NIhL+aGtGS6uYXCnSMmQRyYMAbyVi d5HtV+vxRmzr9Svyb2H6ayYelKm808zbpYX6 X-Google-Smtp-Source: ABdhPJz39VQoM2yIZgGrdaBNDh4h7csKuWcUfL2AZBDYn5l9SMz1Zxy8R+d+TkihlCXig7pgZ2FWjQ== X-Received: by 2002:ac2:4150:: with SMTP id c16mr2305289lfi.127.1628142496105; Wed, 04 Aug 2021 22:48:16 -0700 (PDT) Received: from localhost ([109.252.93.92]) by smtp.gmail.com with ESMTPSA id j10sm401306lfk.286.2021.08.04.22.48.15 for <49419@debbugs.gnu.org> (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 04 Aug 2021 22:48:15 -0700 (PDT) From: Andrew Tropin In-Reply-To: <87tuk4mors.fsf@trop.in> References: <87y2akhiz1.fsf@trop.in> <87tuk4mors.fsf@trop.in> Date: Thu, 05 Aug 2021 08:46:22 +0300 Message-ID: <87mtpwmok1.fsf@trop.in> MIME-Version: 1.0 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+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/home-services.scm (home-run-on-change-service-type): New variable. --- gnu/home-services.scm | 103 +++++++++++++++++++++++++++++++++++++++++- 1 file changed, 102 insertions(+), 1 deletion(-) diff --git a/gnu/home-services.scm b/gnu/home-services.scm index 4a6458abec..32b59f55df 100644 --- a/gnu/home-services.scm +++ b/gnu/home-services.scm @@ -37,7 +37,8 @@ home-environment-variables-service-type home-files-service-type home-run-on-first-login-service-type - home-activation-service-type) + home-activation-service-type + home-run-on-change-service-type) #:re-export (service service-type @@ -92,6 +93,9 @@ ;;; ;;; - 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: @@ -366,3 +370,100 @@ 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 (getenv "GUIX_OLD_HOME") "/" (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 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."))) From patchwork Thu Aug 5 05:46:58 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andrew Tropin X-Patchwork-Id: 31838 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id D0C3627BC6B; Thu, 5 Aug 2021 06:49:18 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 5CF2227BC78 for ; Thu, 5 Aug 2021 06:49:18 +0100 (BST) Received: from localhost ([::1]:46984 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mBWFp-0002CV-Ey for patchwork@mira.cbaines.net; Thu, 05 Aug 2021 01:49:17 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:36734) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mBWFb-0001l3-Co for guix-patches@gnu.org; Thu, 05 Aug 2021 01:49:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:34107) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mBWFb-0001B9-6q for guix-patches@gnu.org; Thu, 05 Aug 2021 01:49:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mBWFb-0006o3-1W for guix-patches@gnu.org; Thu, 05 Aug 2021 01:49:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#49419] [PATCH v4 3/4] home-services: Add home-provenance-service-type Resent-From: Andrew Tropin Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 05 Aug 2021 05:49: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.162814250826072 (code B ref 49419); Thu, 05 Aug 2021 05:49:02 +0000 Received: (at 49419) by debbugs.gnu.org; 5 Aug 2021 05:48:28 +0000 Received: from localhost ([127.0.0.1]:45644 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mBWF2-0006mS-At for submit@debbugs.gnu.org; Thu, 05 Aug 2021 01:48:28 -0400 Received: from mail-lf1-f41.google.com ([209.85.167.41]:33615) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mBWF1-0006lx-4Q for 49419@debbugs.gnu.org; Thu, 05 Aug 2021 01:48:27 -0400 Received: by mail-lf1-f41.google.com with SMTP id p38so8936078lfa.0 for <49419@debbugs.gnu.org>; Wed, 04 Aug 2021 22:48:27 -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:references:date:message-id:mime-version; bh=snZ4ZNwtRzA2+DvxEtESiaS3qrykzVqCJe6xThrel2w=; b=UMJENF2b6HXZO3WwdyFqM0qf8RsKRJiZ7AYtmWiAyI7dtxyUBsrUwy5DtscpCJLky4 Vu3vioFFr5hll/7dykl1oj/XAc/RfaoLDGzN/kqFWTJlMIalUhX/XwXFGx7jxt6Bfj4+ QZ7kkA9ylE81AcKPdwXPlct8XF1mtLZ+ipN0B6ZJt8bLtGme8DKsIifVNsU3+B2g4OQe au8VgxT9Ci6vDogcwmtXRdz/ekzLpTLoJEJPa8CLwn2UikBl2xnfaDM/n7nRDGCSxWKK O1S7WDL98JFvAM/Yv41xz6+UQy+1DAeoV8ZnTo8lOcfVCu5wgG9jlZcv7JSI29Cy/oey 8nMw== 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:references:date :message-id:mime-version; bh=snZ4ZNwtRzA2+DvxEtESiaS3qrykzVqCJe6xThrel2w=; b=Ho9XSRH5fLvHvHPKZxL0B79IzGe8eAtOqSdDn3ktvewOeqarzTun53v2dkUpgE9G6J 2CpqJVbcCdJTgnmgH8wzCJ8hmyU25JUo4x64YVt04VcHH4PT5idLo1L9lUjmhToQHj5b XnLiOmZWPQfFffpm19UkiR9h5H23cCNNKJ2ksJhJayzUzw5qnpuU9N2lk9x5otldA23B xAKLgsUQ+edPmQ2JgI9s1pZPmoNCeQ/GuwkMjvC0Tgz7VKJIuas58Z9UoXvwAo1kTBPO i8tx/5OF8tBLmhvnUhRhb93UGeF9Pae7KRH7jsj5FIlrlxlaON8fGR0p/tYzNsAjHVj4 MQrw== X-Gm-Message-State: AOAM533CDrn/NWYyVnzNY6z2F2zioVU8nlj4I50CAqRp9VBWmuN1A1Tu o9g66If5iZHUAG3xpT1Ando7SshWdbzC8EPB X-Google-Smtp-Source: ABdhPJz0fWli93xb/8+Q6VU4tbl7h9xDR19Ily9RyjoB55cvkk8kESO7y8qDyXBzzccHz/bbxYk8hQ== X-Received: by 2002:ac2:4c0d:: with SMTP id t13mr2289892lfq.118.1628142501090; Wed, 04 Aug 2021 22:48:21 -0700 (PDT) Received: from localhost (109-252-93-92.nat.spd-mgts.ru. [109.252.93.92]) by smtp.gmail.com with ESMTPSA id l21sm320046ljc.94.2021.08.04.22.48.19 for <49419@debbugs.gnu.org> (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 04 Aug 2021 22:48:20 -0700 (PDT) From: Andrew Tropin In-Reply-To: <87tuk4mors.fsf@trop.in> References: <87y2akhiz1.fsf@trop.in> <87tuk4mors.fsf@trop.in> Date: Thu, 05 Aug 2021 08:46:58 +0300 Message-ID: <87k0l0moj1.fsf@trop.in> MIME-Version: 1.0 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+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/home-services.scm (home-provenance-service-type, sexp->home-provenance, home-provenance): New variables. --- gnu/home-services.scm | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/gnu/home-services.scm b/gnu/home-services.scm index 32b59f55df..d320d3a44d 100644 --- a/gnu/home-services.scm +++ b/gnu/home-services.scm @@ -38,7 +38,10 @@ home-files-service-type home-run-on-first-login-service-type home-activation-service-type - home-run-on-change-service-type) + home-run-on-change-service-type + home-provenance-service-type + + fold-home-service-types) #:re-export (service service-type @@ -467,3 +470,25 @@ 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) From patchwork Thu Aug 5 05:47:40 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andrew Tropin X-Patchwork-Id: 31836 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 73AB227BC6B; Thu, 5 Aug 2021 06:49:11 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 35A9627BC78 for ; Thu, 5 Aug 2021 06:49:11 +0100 (BST) Received: from localhost ([::1]:46368 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mBWFi-0001nK-8L for patchwork@mira.cbaines.net; Thu, 05 Aug 2021 01:49:10 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:36736) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mBWFb-0001lB-LO for guix-patches@gnu.org; Thu, 05 Aug 2021 01:49:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:34108) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mBWFb-0001BE-F6 for guix-patches@gnu.org; Thu, 05 Aug 2021 01:49:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mBWFb-0006oA-Dk for guix-patches@gnu.org; Thu, 05 Aug 2021 01:49:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#49419] [PATCH v4 4/4] home-services: Add fold-home-service-types function Resent-From: Andrew Tropin Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 05 Aug 2021 05:49:03 +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.162814251126087 (code B ref 49419); Thu, 05 Aug 2021 05:49:03 +0000 Received: (at 49419) by debbugs.gnu.org; 5 Aug 2021 05:48:31 +0000 Received: from localhost ([127.0.0.1]:45647 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mBWF5-0006mh-Hp for submit@debbugs.gnu.org; Thu, 05 Aug 2021 01:48:31 -0400 Received: from mail-lj1-f172.google.com ([209.85.208.172]:35573) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mBWF4-0006mJ-MA for 49419@debbugs.gnu.org; Thu, 05 Aug 2021 01:48:31 -0400 Received: by mail-lj1-f172.google.com with SMTP id x9so3562683ljj.2 for <49419@debbugs.gnu.org>; Wed, 04 Aug 2021 22:48: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:references:date:message-id:mime-version; bh=8S15RKfEMo4F0g5qCAJ7N/QpXm9mgOVxmPG0QA0WzY0=; b=SFaXmQaeOCe3sbAh57shejRH3nJfDvnUAunBzzwyZM3AvGHRn0pJu4HdxM1/5TKSks tqewJWKgGZreOKIqnMaR6q2uF5MmtLnSlJJP/ftxdjDNV6GtBheNigJhTID9lyS4ZF0L 5t5iD82FfmRNHHNIZGY7M0N2kyQBJ+78VRUYgKmQy7BQa9YZF04nqk+Tcw0pWpuEgrd+ XAEq+tOsM7g8w8r+R/EctfNoFxZ6c1+IKv9yAPWMBMdsbo6MSdpRsMEGGeRj4H4EoUzJ dBftxAWxY2D/WQ638fRdyyacVDJ3Xoeat10OGsbGWIWzFDfpyXWLSpmD66mdVTJDnxKs KZBQ== 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:references:date :message-id:mime-version; bh=8S15RKfEMo4F0g5qCAJ7N/QpXm9mgOVxmPG0QA0WzY0=; b=UtPxBCPEFzSQYxTBP+kLOIoolc8pW67bFTFZ/ONGnqnmBIK+PQtAS76fTiefMCKIUI TumwgruP/KpKkR/Dt1SS792JcoCwQxUhM8CcSeScT+8xRr7mApSInIV75zxm/TRFfrUI M8sBFkacxVkBDAw1zjCOscenpYMBheiKFo59Xm00KvE6TTCSZvlQh0YfUIqkSYwjkB6J GVmtGCuhk8km4cBsAgCCj+o/bsz1IeeXJ/lJb6/HiMF/p0QtZpymF22DK02otaOI34xJ U7OiDgKA6qdnJuKkLtVRGegihDNfI6rlxTgaW3yHAumt88oBq59ZO/5Fx2gMlG7As2bP 9MEA== X-Gm-Message-State: AOAM532PySDcgkZMAAfsOe+p6Sfp2U5aLYYOz/Y53+UwW71Avo1qNCYN qQ/dM7V0HtU+LYy0T2sl2G6B0hjz2RIwbn9u X-Google-Smtp-Source: ABdhPJzjQjzqVNb+5q9aNDSbtKXOEweo8MEl4DqrHJEISahC0V7nncidMChwdILr3t3VfEclruhnWQ== X-Received: by 2002:a2e:890a:: with SMTP id d10mr2086703lji.310.1628142504550; Wed, 04 Aug 2021 22:48:24 -0700 (PDT) Received: from localhost ([109.252.93.92]) by smtp.gmail.com with ESMTPSA id c13sm402663lfm.208.2021.08.04.22.48.23 for <49419@debbugs.gnu.org> (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 04 Aug 2021 22:48:24 -0700 (PDT) From: Andrew Tropin In-Reply-To: <87tuk4mors.fsf@trop.in> References: <87y2akhiz1.fsf@trop.in> <87tuk4mors.fsf@trop.in> Date: Thu, 05 Aug 2021 08:47:40 +0300 Message-ID: <87h7g4mohv.fsf@trop.in> MIME-Version: 1.0 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+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/home-services.scm (parent-directory, %guix-home-root-directory, %service-type-path, all-home-service-modules, fold-home-service-types): New variables. --- gnu/home-services.scm | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/gnu/home-services.scm b/gnu/home-services.scm index d320d3a44d..16b9736d64 100644 --- a/gnu/home-services.scm +++ b/gnu/home-services.scm @@ -492,3 +492,29 @@ 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)))