describe: Try harder to find the ‘guix pull’ profile.

Fixes <https://issues.guix.gnu.org/66705>.

The strategy used by ‘current-profile’ so far would fail to find the
right profile (the one created by ‘guix pull’ or ‘guix time-machine’) in
cases where said profile is itself included in another profile.  This
happens, for instance, when running ‘guix shell -CW -- guix describe’,
which, as a result, would display nothing but the ‘guix’ channel.

This patch fixes that by having ‘current-profile’ not just check for the
presence of a ‘manifest’ file but also parse it to determine whether
it’s a ‘guix pull’ kind of manifest.

* guix/describe.scm (find-profile): New procedure.
(current-profile): Adjust to use it.

Change-Id: I9194f54ce1496a6591e247c76203f497f28c330b
This commit is contained in:
Ludovic Courtès 2024-03-19 12:56:49 +01:00
parent 06baf4d6ba
commit c90a4e8dcd
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 39 additions and 9 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018-2021, 2024 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -27,6 +27,7 @@
sexp->channel
manifest-entry-channel)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (ice-9 match)
#:export (current-profile
current-profile-date
@ -55,20 +56,49 @@
;; later on.
(program-arguments))
(define (find-profile program)
"Return the profile created by 'guix pull' or 'guix time-machine' that
PROGRAM lives in; PROGRAM is expected to end in \"/bin/guix\". Return #f if
such a profile could not be found."
(and (string-suffix? "/bin/guix" program)
;; Note: We want to do _lexical dot-dot resolution_. Using ".." for
;; real would instead take us into the /gnu/store directory that
;; ~/.config/guix/current/bin points to, whereas we want to obtain
;; ~/.config/guix/current.
(let ((candidate (dirname (dirname program))))
(and (file-exists? (string-append candidate "/manifest"))
(let ((manifest (guard (c ((profile-error? c) #f))
(profile-manifest candidate))))
(define (fallback)
(or (and=> (false-if-exception (readlink program))
find-profile)
(and=> (false-if-exception (readlink (dirname program)))
(lambda (target)
(find-profile (in-vicinity target "guix"))))))
;; Is CANDIDATE the "right" profile--the one created by 'guix
;; pull'? It might be that CANDIDATE itself contains a
;; symlink to the "right" profile; this happens for instance
;; when using 'guix shell -CW'. Thus, if CANDIDATE doesn't
;; fit the bill, dereference PROGRAM or its parent directory
;; and try again.
(match (and manifest
(manifest-lookup manifest
(manifest-pattern (name "guix"))))
(#f
(fallback))
(entry
(if (assq 'source (manifest-entry-properties entry))
candidate
(fallback)))))))))
(define current-profile
(mlambda ()
"Return the profile (created by 'guix pull') the calling process lives in,
or #f if this is not applicable."
(match initial-program-arguments
((program . _)
(and (string-suffix? "/bin/guix" program)
;; Note: We want to do _lexical dot-dot resolution_. Using ".."
;; for real would instead take us into the /gnu/store directory
;; that ~/.config/guix/current/bin points to, whereas we want to
;; obtain ~/.config/guix/current.
(let ((candidate (dirname (dirname program))))
(and (file-exists? (string-append candidate "/manifest"))
candidate)))))))
(find-profile program)))))
(define (current-profile-date)
"Return the creation date of the current profile (produced by 'guix pull'),