summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/file-systems.scm46
-rw-r--r--gnu/system/linux-initrd.scm4
-rw-r--r--gnu/system/vm.scm2
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