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:
		
							parent
							
								
									06baf4d6ba
								
							
						
					
					
						commit
						c90a4e8dcd
					
				
					 1 changed files with 39 additions and 9 deletions
				
			
		|  | @ -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'), | ||||
|  |  | |||
		Reference in a new issue