From 2b4185792d3ec9b43a5c1bb204b6846e5ac0f14a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 4 Jul 2016 23:54:18 +0200 Subject: gexp: 'gexp->file' emits code to set '%load-path'. * guix/gexp.scm (gexp->file): Add #:set-load-path? parameter and honor it. * gnu/system.scm (operating-system-parameters-file): Pass #:set-load-path? #f. * doc/guix.texi (G-Expressions): Adjust accordingly. --- gnu/system.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index 96ea153cd0..a49b3f29b3 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -731,7 +731,8 @@ this file is the reconstruction of GRUB menu entries for old configurations." (kernel #$(operating-system-kernel os)) (kernel-arguments #$(operating-system-kernel-arguments os)) - (initrd #$initrd))))) + (initrd #$initrd)) + #:set-load-path? #f))) ;;; -- cgit v1.2.3 From 2bdd7ac17ceff60cd5ef77e530f62cea902bf90d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 18 Jul 2016 00:51:02 +0200 Subject: system: Honor the 'dependencies' field of file systems. This allows mapped devices listed in 'dependencies' to be properly taken into account. Reported by Andreas Enge . * gnu/system.scm (mapped-device-user): Check whether DEVICE is a member of the 'dependencies' of FS. * tests/system.scm (%luks-device, %os-with-mapped-device): New variables. ("operating-system-user-mapped-devices") ("operating-system-boot-mapped-devices") ("operating-system-boot-mapped-devices, implicit dependency"): New tests. --- gnu/system.scm | 7 +++++-- tests/system.scm | 43 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 48 insertions(+), 2 deletions(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index a49b3f29b3..476720b9f9 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -81,6 +81,8 @@ operating-system-mapped-devices operating-system-file-systems operating-system-store-file-system + operating-system-user-mapped-devices + operating-system-boot-mapped-devices operating-system-activation-script operating-system-user-accounts operating-system-shepherd-service-names @@ -208,8 +210,9 @@ as 'needed-for-boot'." "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f." (let ((target (string-append "/dev/mapper/" (mapped-device-target device)))) (find (lambda (fs) - (and (eq? 'device (file-system-title fs)) - (string=? (file-system-device fs) target))) + (or (member device (file-system-dependencies fs)) + (and (eq? 'device (file-system-title fs)) + (string=? (file-system-device fs) target)))) file-systems))) (define (operating-system-user-mapped-devices os) diff --git a/tests/system.scm b/tests/system.scm index b935bd07eb..b5bb9af016 100644 --- a/tests/system.scm +++ b/tests/system.scm @@ -41,6 +41,25 @@ (users %base-user-accounts))) +(define %luks-device + (mapped-device + (source "/dev/foo") (target "my-luks-device") + (type luks-device-mapping))) + +(define %os-with-mapped-device + (operating-system + (host-name "komputilo") + (timezone "Europe/Berlin") + (locale "en_US.utf8") + (bootloader (grub-configuration (device "/dev/sdX"))) + (mapped-devices (list %luks-device)) + (file-systems (cons (file-system + (inherit %root-fs) + (dependencies (list %luks-device))) + %base-file-systems)) + (users %base-user-accounts))) + + (test-begin "system") (test-assert "operating-system-store-file-system" @@ -71,4 +90,28 @@ %base-file-systems))))) (eq? gnu (operating-system-store-file-system os)))) +(test-equal "operating-system-user-mapped-devices" + '() + (operating-system-user-mapped-devices %os-with-mapped-device)) + +(test-equal "operating-system-boot-mapped-devices" + (list %luks-device) + (operating-system-boot-mapped-devices %os-with-mapped-device)) + +(test-equal "operating-system-boot-mapped-devices, implicit dependency" + (list %luks-device) + + ;; Here we expect the implicit dependency between "/" and + ;; "/dev/mapper/my-luks-device" to be found, in spite of the lack of a + ;; 'dependencies' field in the root file system. + (operating-system-boot-mapped-devices + (operating-system + (inherit %os-with-mapped-device) + (file-systems (cons (file-system + (device "/dev/mapper/my-luks-device") + (title 'device) + (mount-point "/") + (type "ext4")) + %base-file-systems))))) + (test-end) -- cgit v1.2.3