From 50c72ecd9e272d959dfc346b5baea9137f6820ad Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 9 Oct 2018 11:51:12 +0200 Subject: profiles: Generalize 'canonicalize-profile'. * guix/profiles.scm (canonicalize-profile): Rewrite to work with any profile that lives under %PROFILE-DIRECTORY. --- guix/profiles.scm | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/guix/profiles.scm b/guix/profiles.scm index 6c3b26423e..99e6fe7371 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1652,19 +1652,18 @@ to user ~s.") (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 - - ;; 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 + ;; 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 -- cgit v1.2.3