X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/4ca90ff5976434a2b6e758df38df54387ae70c1b..42ff7d3be642d66ba567f64882a1f2301b1a7bd9:/gnu/system/mapped-devices.scm?ds=inline 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