guix
/
guix
mirror of git://git.savannah.gnu.org/guix.git
3
4
Fork 0
Code Issues Releases Wiki Activity

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
1 changed files with 22 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
gnu/system/file-systems.scm
View File

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