diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/file-systems.scm | 46 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 4 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 2 |
3 files changed, 30 insertions, 22 deletions
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 464e87cb18..b9eda80958 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. ;;; @@ -231,8 +231,11 @@ (char-set-complement (char-set #\/))) (define (file-prefix? file1 file2) - "Return #t if FILE1 denotes the name of a file that is a parent of FILE2, -where both FILE1 and FILE2 are absolute file name. For example: + "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\") => #t @@ -240,19 +243,27 @@ where both FILE1 and FILE2 are absolute file name. For example: (file-prefix? \"/gn\" \"/gnu/store\") => #f " - (and (string-prefix? "/" file1) - (string-prefix? "/" 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))))))) + (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))) (define* (file-system-device->string device #:key uuid-type) "Return the string representations of the DEVICE field of a <file-system> @@ -624,9 +635,6 @@ store is located, else #f." s (string-append "/" s))) - (define (file-name-depth file-name) - (length (string-tokenize file-name %not-slash))) - (and-let* ((btrfs-subvolume-fs (filter btrfs-subvolume? file-systems)) (btrfs-subvolume-fs* (sort btrfs-subvolume-fs diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index c6ba9bb560..8c245b8445 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -36,7 +36,7 @@ #:use-module ((gnu packages xorg) #:select (console-setup xkeyboard-config)) #:use-module ((gnu packages make-bootstrap) - #:select (%guile-3.0-static-stripped)) + #:select (%guile-static-stripped)) #:use-module (gnu system file-systems) #:use-module (gnu system mapped-devices) #:use-module (gnu system keyboard) @@ -62,7 +62,7 @@ (define* (expression->initrd exp #:key - (guile %guile-3.0-static-stripped) + (guile %guile-static-stripped) (gzip gzip) (name "guile-initrd") (system (%current-system))) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index e4de8fd396..da076a95f9 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -713,7 +713,7 @@ with '-virtfs' options for the host file systems listed in SHARED-FS." #$@(map virtfs-option shared-fs) "-vga std" - (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly" + (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly=on" #$image))) (define* (system-qemu-image/shared-store-script os |