summaryrefslogtreecommitdiff
path: root/gnu/system/file-systems.scm
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2021-06-30 14:20:01 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2021-07-03 22:29:13 -0400
commit7cde70c7f88e1b283bb61d8a35c5ceeafb39884e (patch)
tree4e4e98158a31d80fddbc71e1986f9c4b962ff4fd /gnu/system/file-systems.scm
parent243d74579d2afdcad1f709909a3ac149475b3e23 (diff)
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>
Diffstat (limited to 'gnu/system/file-systems.scm')
-rw-r--r--gnu/system/file-systems.scm34
1 files changed, 22 insertions, 12 deletions
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index fb87bfc85b..4a3c1fe008 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)))