GNU bug report logs - #76143
[PATCH] gnu: Canonicalize paths before comparing.

Previous Next

Full log

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Noé Lopez <noe <at> xn--no-cja.eu>
To: guix-patches <at> gnu.org
Cc: Noé Lopez <noe <at> xn--no-cja.eu>
Subject: [PATCH] gnu: Canonicalize paths before comparing.
Date: Sat,  8 Feb 2025 14:36:08 +0100

From: Noé Lopez <noelopez <at> free.fr>

The comparison would fail if the load path for guix was not already
canonicalized, since it is doing a string comparison.

* gnu/packages.scm (%patch-path): Canonicalize paths before
comparing.
* guix/ui.scm (try-canonicalize-path): Move to (guix utils).
* guix/utils.scm (try-canonicalize-path): New function.

Change-Id: Id5d51ce483af74ac4e122563d84cc3e8d78c3246
---
 gnu/packages.scm | 11 ++++++-----
 guix/ui.scm      | 14 --------------
 guix/utils.scm   | 15 +++++++++++++++
 3 files changed, 21 insertions(+), 19 deletions(-)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index bdd5d21940..d043d0616d 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -167,11 +167,12 @@ (define %patch-path
   ;; Define it after '%package-module-path' so that '%load-path' contains user
   ;; directories, allowing patches in $GUIX_PACKAGE_PATH to be found.
   (make-parameter
-   (map (lambda (directory)
-          (if (string=? directory %distro-root-directory)
-              (string-append directory "/gnu/packages/patches")
-              directory))
-        %load-path)))
+   (let ((root (try-canonicalize-path %distro-root-directory)))
+     (map (lambda (directory)
+            (if (string=? (try-canonicalize-path directory) root)
+                (string-append directory "/gnu/packages/patches")
+                directory))
+          %load-path))))
 
 ;; This procedure is used by Emacs-Guix up to 0.5.1.1, so keep it for now.
 ;; See <https://github.com/alezost/guix.el/issues/30>.
diff --git a/guix/ui.scm b/guix/ui.scm
index 87a448bf72..a3a9bf4e42 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -206,20 +206,6 @@ (define-syntax-rule (without-compiler-optimizations exp)
   (parameterize (((@ (system base compile) default-optimization-level) 1))
     exp))
 
-(define (try-canonicalize-path file)
-  "Like 'canonicalize-path', but return FILE as-is if 'canonicalize-path'
-throws.
-
-This is necessary for corner cases where 'canonicalize-path' fails.  One
-example is on Linux when a /dev/fd/N file denotes a pipe, represented as a
-symlink to a non-existent file like 'pipe:[1234]', as in this example:
-
-  sh -c 'stat $(readlink -f /dev/fd/1)' | cat"
-  (catch 'system-error
-    (lambda ()
-      (canonicalize-path file))
-    (const file)))
-
 (define* (load* file user-module
                 #:key (on-error 'nothing-special))
   "Load the user provided Scheme source code FILE."
diff --git a/guix/utils.scm b/guix/utils.scm
index b6cf5aea4f..6e5b6b6caf 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -162,6 +162,7 @@ (define-module (guix utils)
             compressed-output-port
             call-with-compressed-output-port
             canonical-newline-port
+            try-canonicalize-path
 
             string-distance
             string-closest
@@ -1150,6 +1151,20 @@ (define (canonical-newline-port port)
                                  get-position
                                  set-position!
                                  close))
+
+(define (try-canonicalize-path file)
+  "Like 'canonicalize-path', but return FILE as-is if 'canonicalize-path'
+throws.
+
+This is necessary for corner cases where 'canonicalize-path' fails.  One
+example is on Linux when a /dev/fd/N file denotes a pipe, represented as a
+symlink to a non-existent file like 'pipe:[1234]', as in this example:
+
+  sh -c 'stat $(readlink -f /dev/fd/1)' | cat"
+  (catch 'system-error
+    (lambda ()
+      (canonicalize-path file))
+    (const file)))
 
 ;;;
 ;;; Source location.

base-commit: 9c36d38614079611aebe4721b9e087f98e57b1b3
-- 
2.48.1

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.