summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-12-18 15:05:55 +0100
committerLudovic Courtès <ludo@gnu.org>2017-12-22 09:48:41 +0100
commit893d0b0bf320eb20b9dd7c57eefcd2fc1371225d (patch)
treebb6d49b8997f22391e9873277e888ca8d7cf10cb
parent42ff7d3be642d66ba567f64882a1f2301b1a7bd9 (diff)
downloadpatches-893d0b0bf320eb20b9dd7c57eefcd2fc1371225d.tar
patches-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.scm24
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