[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[bug#29765] [PATCH 2/3] mapped-devices: 'luks-device-mapping' checks its

From: Ludovic Courtès
Subject: [bug#29765] [PATCH 2/3] mapped-devices: 'luks-device-mapping' checks its source device.
Date: Mon, 18 Dec 2017 15:17:41 +0100

* gnu/system/mapped-devices.scm (check-luks-device): New procedure.
(luks-device-mapping)[check]: New field.
 gnu/system/mapped-devices.scm | 24 +++++++++++++++++++++++-
 1 file changed, 23 insertions(+), 1 deletion(-)

diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 06178ad32..dbeb0d343 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
@@ -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.
    (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

reply via email to

[Prev in Thread] Current Thread [Next in Thread]