Archived
1
0
Fork 0

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:
Maxim Cournoyer 2021-06-30 14:20:01 -04:00
parent 243d74579d
commit 7cde70c7f8
No known key found for this signature in database
GPG key ID: 1260E46482E63562

View file

@ -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)))