Subject: [bug#32998] [PATCH 1/2] profiles: Generalize 'canonicalize-profile'.

From: Ludovic Courtès <[email-masked]>
Date: Tue, 9 Oct 2018 12:16:24 +0200

* 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 de3a04464..6b911b3fe 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1611,19 +1611,18 @@ because the NUMBER is zero.)"
   (string-append %profile-directory "/guix-profile"))
 
 (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
-- 
2.19.0