branch master updated: file-systems: Ensure compared file names are both absolute or relative.

[guix-commits]

This is an automated email from the git hooks/post-receive script.

apteryx pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new 7cde70c  file-systems: Ensure compared file names are both absolute or 
relative.
7cde70c is described below

commit 7cde70c7f88e1b283bb61d8a35c5ceeafb39884e
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Wed Jun 30 14:20:01 2021 -0400

    file-systems: Ensure compared file names are both absolute or relative.
    
    * gnu/system/file-systems.scm (file-prefix?): Return #f unless both file 
names
    are absolute or relative.
    
    Reported-by: Ludovic Courtès <ludo@gnu.org>
---
 gnu/system/file-systems.scm | 34 ++++++++++++++++++++++------------
 1 file changed, 22 insertions(+), 12 deletions(-)

diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index fb87bfc..4a3c1fe 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès 
<ludo@gnu.org>
 ;;; Copyright © 2020 Google LLC
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
-;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -233,6 +233,9 @@
 
 (define (file-prefix? file1 file2)
   "Return #t if FILE1 denotes the name of a file that is a parent of FILE2.
+FILE1 and FILE2 must both be either absolute or relative file names, else #f
+is returned.
+
 For example:
 
   (file-prefix? \"/gnu\" \"/gnu/store\")
@@ -241,17 +244,24 @@ For example:
   (file-prefix? \"/gn\" \"/gnu/store\")
   => #f
 "
-  (let loop ((file1 (string-tokenize file1 %not-slash))
-             (file2 (string-tokenize file2 %not-slash)))
-    (match file1
-      (()
-       #t)
-      ((head1 tail1 ...)
-       (match file2
-         ((head2 tail2 ...)
-          (and (string=? head1 head2) (loop tail1 tail2)))
-         (()
-          #f))))))
+  (define (absolute? file)
+    (string-prefix? "/" file))
+
+  (if (or (every absolute? (list file1 file2))
+          (every (negate absolute?) (list file1 file2)))
+      (let loop ((file1 (string-tokenize file1 %not-slash))
+                 (file2 (string-tokenize file2 %not-slash)))
+        (match file1
+          (()
+           #t)
+          ((head1 tail1 ...)
+           (match file2
+             ((head2 tail2 ...)
+              (and (string=? head1 head2) (loop tail1 tail2)))
+             (()
+              #f)))))
+      ;; FILE1 and FILE2 are a mix of absolute and relative file names.
+      #f))
 
 (define (file-name-depth file-name)
   (length (string-tokenize file-name %not-slash)))