diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-12-18 15:05:55 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-12-22 09:48:41 +0100 |
| commit | 893d0b0bf320eb20b9dd7c57eefcd2fc1371225d (patch) | |
| tree | bb6d49b8997f22391e9873277e888ca8d7cf10cb | |
| parent | 42ff7d3be642d66ba567f64882a1f2301b1a7bd9 (diff) | |
| download | guix-893d0b0bf320eb20b9dd7c57eefcd2fc1371225d.tar.gz | |
guix system: Check mapped devices upon 'init' and 'reconfigure'.
* guix/scripts/system.scm (check-mapped-devices): New procedure. (perform-action): Add call to 'check-mapped-devices'.
| -rw-r--r-- | guix/scripts/system.scm | 24 |
1 files changed, 21 insertions, 3 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 36aed3331f..ebcf3e4f3b 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -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 |