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

profiles: Generalize 'canonicalize-profile'.

Browse source 
* guix/profiles.scm (canonicalize-profile): Rewrite to work with any
profile that lives under %PROFILE-DIRECTORY.
This commit is contained in:
Ludovic Courtès 2018-10-09 11:51:12 +02:00
parent 77dcfb4c02
commit 50c72ecd9e
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 11 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
guix/profiles.scm
View file

@ -1652,19 +1652,18 @@ (define (ensure-profile-directory)
(getuid))))))))))
(define (canonicalize-profile profile)
"If PROFILE is %USER-PROFILE-DIRECTORY, return %CURRENT-PROFILE. Otherwise
return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if
'-p' was omitted." ; see <http://bugs.gnu.org/17939>
;; Trim trailing slashes so that the basename comparison below works as
;; intended.
"If PROFILE points to a profile in %PROFILE-DIRECTORY, return that.
Otherwise return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile'
as if '-p' was omitted." ; see <http://bugs.gnu.org/17939>
;; Trim trailing slashes so 'readlink' can do its job.
(let ((profile (string-trim-right profile #\/)))
(if (and %user-profile-directory
(string=? (canonicalize-path (dirname profile))
(dirname %user-profile-directory))
(string=? (basename profile) (basename %user-profile-directory)))
%current-profile
profile)))
(catch 'system-error
(lambda ()
(let ((target (readlink profile)))
(if (string=? (dirname target) %profile-directory)
target
profile)))
(const profile))))
(define (user-friendly-profile profile)
"Return either ~/.guix-profile if that's what PROFILE refers to, directly or