ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

system: Honor the 'dependencies' field of file systems.

Browse source 
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:
Ludovic Courtès 2016-07-18 00:51:02 +02:00
parent 0b07350675
commit 2bdd7ac17c
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 48 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gnu/system.scm
View file

@ -81,6 +81,8 @@ (define-module (gnu system)
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 @@ (define (mapped-device-user device file-systems)
"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)

43
tests/system.scm
View file

@ -41,6 +41,25 @@ (define %os
(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 @@ (define %os
%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)