[bug#76143,v3,1/1] gnu: Find patches directory through symlinks.
Commit Message
From: Noé Lopez <noelopez@free.fr>
This fixes a bug where patches would not be found in %patch-path when the
Guile load path would contain a different path (via symlink or trailing slash)
to the %distro-root-directory than what was previously found. We use stat to
make sure that two different paths to the same directory are still matched.
For example: if the Guile path was /guix/ and %distro-root-directory was
/guix, patches would not be found even though the two directories are the
same.
* gnu/packages.scm (%patch-path): Compare directories with directory=?.
* guix/utils.scm (directory=?): New procedure.
* tests/utils.scm: Add tests for directory=?.
Change-Id: I73f65b6c050cdeff85637e13ffd0319dcc1d4958
---
gnu/packages.scm | 2 +-
guix/utils.scm | 16 ++++++++++++++++
tests/utils.scm | 13 +++++++++++++
3 files changed, 30 insertions(+), 1 deletion(-)
@@ -168,7 +168,7 @@ (define %patch-path
;; directories, allowing patches in $GUIX_PACKAGE_PATH to be found.
(make-parameter
(map (lambda (directory)
- (if (string=? directory %distro-root-directory)
+ (if (directory=? directory %distro-root-directory)
(string-append directory "/gnu/packages/patches")
directory))
%load-path)))
@@ -21,6 +21,7 @@
;;; Copyright © 2023 Zheng Junjie <873216071@qq.com>
;;; Copyright © 2023 Foundation Devices, Inc. <hello@foundationdevices.com>
;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
+;;; Copyright © 2025 Noé Lopez <noelopez@free.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -41,6 +42,7 @@ (define-module (guix utils)
#:use-module (guix config)
#:autoload (guix read-print) (object->string*)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-2)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-71)
@@ -162,6 +164,7 @@ (define-module (guix utils)
compressed-output-port
call-with-compressed-output-port
canonical-newline-port
+ directory=?
string-distance
string-closest
@@ -1150,6 +1153,19 @@ (define (canonical-newline-port port)
get-position
set-position!
close))
+
+(define* (directory=? directory #:rest directories)
+ (define (dev+ino directory)
+ (and-let* ((stats (stat directory #f))
+ (dev (stat:dev stats))
+ (ino (stat:ino stats)))
+ (cons dev ino)))
+ (define check (dev+ino directory))
+ (and check
+ (fold (lambda (element acc)
+ (and acc (equal? (dev+ino element) check)))
+ #t
+ directories)))
;;;
;;; Source location.
@@ -6,6 +6,7 @@
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2023 Foundation Devices, Inc. <hello@foundationdevices.com>
;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
+;;; Copyright © 2025 Noé Lopez <noelopez@free.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -370,6 +371,18 @@ (define-public package-2\n 'package)\n"
;; way.
"avr32" "avr32-unknown-none")))
+;; Try to not depend on the user’s filesystem.
+(test-equal "directory=?"
+ '(#t #t #t #t #t #f #f)
+ (list
+ (directory=? "/" "/")
+ (directory=? "/../" "//")
+ (directory=? "//../" "/")
+ (directory=? "/")
+ (directory=? "/" "/../" "//" "//..//../")
+ (directory=? "/proc/99999999" "/proc/99999999") ;nonexistent directories
+ (directory=? "/proc/99999999/../../" "/")))
+
(test-end)
(false-if-exception (delete-file temp-file))