ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

home: Add 'home-generation-base'.

Browse source 
This reverts commit 670818a404,
thereby reinstating 5df8f7802e.

* gnu/home.scm (%profile-generation-rx): New variable.
(home-generation-base): New procedure.
This commit is contained in:
Ludovic Courtès 2022-07-31 23:00:53 +02:00
parent a3a6931c75
commit 61db74a687
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 24 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
gnu/home.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 <home-environment>)
(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)))))