From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp10.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id gFi/FyIp1GItWAAAbAwnHQ (envelope-from ) for ; Sun, 17 Jul 2022 17:22:10 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp10.migadu.com with LMTPS id UKdRFiIp1GLJmwAAG6o9tA (envelope-from ) for ; Sun, 17 Jul 2022 17:22:10 +0200 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 1E80A406D2 for ; Sun, 17 Jul 2022 17:22:10 +0200 (CEST) Received: from localhost ([::1]:53484 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oD65x-0006Oq-4G for larch@yhetil.org; Sun, 17 Jul 2022 11:22:09 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:50598) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oD65r-0006Ob-4f for guix-patches@gnu.org; Sun, 17 Jul 2022 11:22:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:50583) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oD65q-0002SK-P3 for guix-patches@gnu.org; Sun, 17 Jul 2022 11:22:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oD65q-0004XX-Kv for guix-patches@gnu.org; Sun, 17 Jul 2022 11:22:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#56618] [PATCH 1/2] home: Add 'home-generation-base'. References: <20220717151930.23383-1-ludo@gnu.org> In-Reply-To: <20220717151930.23383-1-ludo@gnu.org> Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 17 Jul 2022 15:22:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56618 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 56618@debbugs.gnu.org Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= Received: via spool by 56618-submit@debbugs.gnu.org id=B56618.165807129517394 (code B ref 56618); Sun, 17 Jul 2022 15:22:02 +0000 Received: (at 56618) by debbugs.gnu.org; 17 Jul 2022 15:21:35 +0000 Received: from localhost ([127.0.0.1]:48339 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oD65P-0004WU-0X for submit@debbugs.gnu.org; Sun, 17 Jul 2022 11:21:35 -0400 Received: from eggs.gnu.org ([209.51.188.92]:37618) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oD65K-0004W3-6b for 56618@debbugs.gnu.org; Sun, 17 Jul 2022 11:21:32 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:47290) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oD65F-0002Os-0e; Sun, 17 Jul 2022 11:21:25 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to: references; bh=gtUPtd+LlNFmIcF70LQhtSEUq6aZFfCvH3vVXB9Yo7M=; b=aw9cv2pvXMpnec vFOM6QXtlGZxyfCiD9BSZjBrSolJzpblhqYN5ei3nzz5rbEdAUAl2snSFe9+kN4HXsSlyQAFcQz0z S2HSNG+TgnTpgrQein+V76KBDrcKSrid2agxiWvm9hRho3F5nRJsFzawDzXWtmpb33Z1SZSSQUAtZ 4qWfSWHUX+n2fZMSXlROjQ32QDSaWM4r7ByTPXIsLse2jkbXf6fq92EwAVNtgsMsjKccphdbi1C8g 3xzNBfRHwq3KKBTPCKybh/uyfQUpBYKp7OQkCRYRVLZG1hcam1Y4aUgm0My8cQqQLF0gy64NDi1P3 J5hybL2Hlp21PcP/JxWw==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:56420 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oD65E-0001jK-Hv; Sun, 17 Jul 2022 11:21:24 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Sun, 17 Jul 2022 17:21:16 +0200 Message-Id: <20220717152117.23452-1-ludo@gnu.org> X-Mailer: git-send-email 2.36.1 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 X-Migadu-To: larch@yhetil.org X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1658071330; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding: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=gtUPtd+LlNFmIcF70LQhtSEUq6aZFfCvH3vVXB9Yo7M=; b=QFn8l2Ig4Ofb0/NT9jCIEsBdDH11Ru4z2X4LqSR8ibV8umvEk8PPQv46mc9HBFGmphTNgB zSSkFAWvBCJPx+DGRyMnNx+i/3WZ2kifQQXAtrvkhvFxZAihH0KL7DYrO+D/f12uIR6Ij5 sM5BPnHsdxLqsmBDfjhzzojoTWoltZfUJV79gvW4r1Ub+TN+dqrzeVANeSiS2m7+QXHYX9 +O5d/Y0tFaxbNuCVv00qYRunf15n+0PYMkOD30ACFSb9V4Pyi0g/h4O+MC+yB4eNHo79Ev nLaj19i/22qjMvdPDF5qunl4wYDq8JtYu7vOMUiGB/ZDfRT5KmTVpfcSYQ3lcg== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1658071330; a=rsa-sha256; cv=none; b=BBNCdxPnE08fLNdzmsyEMzyutcNB99oFdCHxNiptf9YgZWOD5pag5v5c/K20WP2hMBUGfz tqWmYWOOadgyfDgq9I5UJc/Dy7RWlxh31uC3zxLG3CH8ml7ZdnUspuj531uUKLSDc+gG2d 2zpc1fG78w/Gos80mub3DZrL7N6m/oKpIm/6PNNg5OJNI0ke4/jRIDClgDoDk8KCLAbFr8 j5cK4tjn5sizwATDCWNE7QsDLn/4UIYekmlO1jvO+DVIfevFB/i0AYhIx5wCNlMgDxb39e 8Z8e6M6L0hc9YOiNmAFPYuCOE7APyDtBsIsmY+m/aJZL8wRYKEsCIYyvCnlXrg== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=gnu.org header.s=fencepost-gnu-org header.b=aw9cv2pv; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -1.84 Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=gnu.org header.s=fencepost-gnu-org header.b=aw9cv2pv; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: 1E80A406D2 X-Spam-Score: -1.84 X-Migadu-Scanner: scn0.migadu.com X-TUID: CzNoRFeryzql * gnu/home.scm (%profile-generation-rx): New variable. (home-generation-base): New procedure. --- gnu/home.scm | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/gnu/home.scm b/gnu/home.scm index a9f0a469a5..4ddbafe412 100644 --- a/gnu/home.scm +++ b/gnu/home.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Andrew Tropin +;;; Copyright © 2022 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,7 +28,8 @@ (define-module (gnu home) #:use-module (guix diagnostics) #:use-module (guix gexp) #:use-module (guix store) - + #:use-module (ice-9 match) + #:use-module (ice-9 regex) #:export (home-environment home-environment? this-home-environment @@ -38,7 +40,9 @@ (define-module (gnu home) home-environment-services home-environment-location - home-environment-with-provenance)) + home-environment-with-provenance + + home-generation-base)) ;;; Comment: ;;; @@ -114,3 +118,21 @@ (define-gexp-compiler (home-environment-compiler (he ) (run-with-store store (home-environment-derivation he) #:system system #:target target))))) + +(define %profile-generation-rx + ;; Regexp that matches profile generation. + (make-regexp "(.*)-([0-9]+)-link$")) + +(define (home-generation-base file) + "If FILE is a Home generation GC root such as \"guix-home-42-link\", +return its corresponding base---e.g., \"guix-home\". Otherwise return #f. + +This is similar to the 'generation-profile' procedure but applied to Home +generations." + (match (regexp-exec %profile-generation-rx file) + (#f #f) + (m (let ((profile (match:substring m 1))) + ;; Distinguish from a "real" profile and from a system generation. + (and (file-exists? (string-append profile "/on-first-login")) + (file-exists? (string-append profile "/profile/manifest")) + profile))))) -- 2.36.1