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>
This commit is contained in:
parent
243d74579d
commit
7cde70c7f8
1 changed files with 22 additions and 12 deletions
|
@ -2,7 +2,7 @@
|
||||||
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2020 Google LLC
|
;;; Copyright © 2020 Google LLC
|
||||||
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -233,6 +233,9 @@
|
||||||
|
|
||||||
(define (file-prefix? file1 file2)
|
(define (file-prefix? file1 file2)
|
||||||
"Return #t if FILE1 denotes the name of a file that is a parent of 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:
|
For example:
|
||||||
|
|
||||||
(file-prefix? \"/gnu\" \"/gnu/store\")
|
(file-prefix? \"/gnu\" \"/gnu/store\")
|
||||||
|
@ -241,17 +244,24 @@ For example:
|
||||||
(file-prefix? \"/gn\" \"/gnu/store\")
|
(file-prefix? \"/gn\" \"/gnu/store\")
|
||||||
=> #f
|
=> #f
|
||||||
"
|
"
|
||||||
(let loop ((file1 (string-tokenize file1 %not-slash))
|
(define (absolute? file)
|
||||||
(file2 (string-tokenize file2 %not-slash)))
|
(string-prefix? "/" file))
|
||||||
(match file1
|
|
||||||
(()
|
(if (or (every absolute? (list file1 file2))
|
||||||
#t)
|
(every (negate absolute?) (list file1 file2)))
|
||||||
((head1 tail1 ...)
|
(let loop ((file1 (string-tokenize file1 %not-slash))
|
||||||
(match file2
|
(file2 (string-tokenize file2 %not-slash)))
|
||||||
((head2 tail2 ...)
|
(match file1
|
||||||
(and (string=? head1 head2) (loop tail1 tail2)))
|
(()
|
||||||
(()
|
#t)
|
||||||
#f))))))
|
((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)
|
(define (file-name-depth file-name)
|
||||||
(length (string-tokenize file-name %not-slash)))
|
(length (string-tokenize file-name %not-slash)))
|
||||||
|
|
Reference in a new issue