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 <andreas@enge.fr>. * 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.
This commit is contained in:
parent
0b07350675
commit
2bdd7ac17c
@ -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)
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user