aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-12-18 14:58:46 +0100
committerLudovic Courtès <ludo@gnu.org>2017-12-22 09:48:38 +0100
commit42ff7d3be642d66ba567f64882a1f2301b1a7bd9 (patch)
tree4283f1997e5c5747099ec8c1a866a27f37a31701
parent4ca90ff5976434a2b6e758df38df54387ae70c1b (diff)
downloadguix-42ff7d3be642d66ba567f64882a1f2301b1a7bd9.tar
guix-42ff7d3be642d66ba567f64882a1f2301b1a7bd9.tar.gz
mapped-devices: 'luks-device-mapping' checks its source device.
* gnu/system/mapped-devices.scm (check-luks-device): New procedure. (luks-device-mapping)[check]: New field.
-rw-r--r--gnu/system/mapped-devices.scm24
1 files changed, 23 insertions, 1 deletions
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 06178ad321..dbeb0d3436 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -22,12 +22,19 @@
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (guix modules)
+ #:use-module (guix i18n)
+ #:use-module ((guix utils)
+ #:select (source-properties->location
+ &error-location))
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu system uuid)
+ #:autoload (gnu build file-systems) (find-partition-by-luks-uuid)
#:autoload (gnu packages cryptsetup) (cryptsetup-static)
#:autoload (gnu packages linux) (mdadm-static)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:use-module (ice-9 match)
#:export (mapped-device
mapped-device?
@@ -144,11 +151,26 @@
#~(zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup")
"close" #$target)))
+(define (check-luks-device md)
+ "Ensure the source of MD is valid."
+ (let ((source (mapped-device-source md)))
+ (or (not (uuid? source))
+ (not (zero? (getuid)))
+ (find-partition-by-luks-uuid (uuid-bytevector source))
+ (raise (condition
+ (&message
+ (message (format #f (G_ "no LUKS partition with UUID '~a'")
+ (uuid->string source))))
+ (&error-location
+ (location (source-properties->location
+ (mapped-device-location md)))))))))
+
(define luks-device-mapping
;; The type of LUKS mapped devices.
(mapped-device-kind
(open open-luks-device)
- (close close-luks-device)))
+ (close close-luks-device)
+ (check check-luks-device)))
(define (open-raid-device sources target)
"Return a gexp that assembles SOURCES (a list of devices) to the RAID device