diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-12-18 14:58:46 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-12-22 09:48:38 +0100 |
| commit | 42ff7d3be642d66ba567f64882a1f2301b1a7bd9 (patch) | |
| tree | 4283f1997e5c5747099ec8c1a866a27f37a31701 /gnu/system/mapped-devices.scm | |
| parent | 4ca90ff5976434a2b6e758df38df54387ae70c1b (diff) | |
| download | 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.
Diffstat (limited to 'gnu/system/mapped-devices.scm')
| -rw-r--r-- | gnu/system/mapped-devices.scm | 24 |
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 |