guix/guix
3
4
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00
Code Issues Releases Wiki Activity

guix system: Check mapped devices upon 'init' and 'reconfigure'.

Browse source 
* guix/scripts/system.scm (check-mapped-devices): New procedure.
(perform-action): Add call to 'check-mapped-devices'.
This commit is contained in:
Ludovic Courtès 2017-12-18 15:05:55 +01:00
parent 42ff7d3be6
commit 893d0b0bf3
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 21 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
guix/scripts/system.scm
View file

@ -44,6 +44,7 @@
#:use-module (gnu system)
#:use-module (gnu bootloader)
#:use-module (gnu system file-systems)
#:use-module (gnu system mapped-devices)
#:use-module (gnu system linux-container)
#:use-module (gnu system uuid)
#:use-module (gnu system vm)
@ -621,6 +622,22 @@ any, are available. Raise an error if they're not."
;; Better be safe than sorry.
(exit 1))))
(define (check-mapped-devices mapped-devices)
"Check that each of MAPPED-DEVICES is valid according to the 'check'
procedure of its type."
(for-each (lambda (md)
(let ((check (mapped-device-kind-check
(mapped-device-type md))))
;; We expect CHECK to raise an exception with a detailed
;; '&message' if something goes wrong, but handle the case
;; where it just returns #f.
(unless (check md)
(leave (G_ "~a: invalid '~a' mapped device~%")
(location->string
(source-properties->location
(mapped-device-location md)))))))
mapped-devices))
;;;
;;; Action.
@ -710,9 +727,10 @@ output when building a system derivation, such as a disk image."
;; Check whether the declared file systems exist. This is better than
;; instantiating a broken configuration. Assume that we can only check if
;; running as root.
(when (and (memq action '(init reconfigure))
(zero? (getuid)))
(check-file-system-availability (operating-system-file-systems os)))
(when (memq action '(init reconfigure))
(when (zero? (getuid))
(check-file-system-availability (operating-system-file-systems os)))
(check-mapped-devices (operating-system-mapped-devices os)))
(mlet* %store-monad
((sys (system-derivation-for-action os action