From ffba7d498d36618ad21af3961a1a685ae91bae57 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 18 Apr 2016 00:23:16 +0200
Subject: mapped-devices: LUKS partitions can be designated by their UUID.

* gnu/system/mapped-devices.scm (device-mapping-service-type): Add
'modules' and 'imported-modules' fields to 'shepherd-service'.
(open-luks-device): Use 'find-partition-by-luks-uuid' to lookup the
partition when SOURCE is a bytevector.
* gnu/system/linux-initrd.scm (base-initrd): Augment 'use-modules'
form.
* doc/guix.texi (Mapped Devices): Give example with a UUID.
---
 gnu/system/linux-initrd.scm   |  9 ++++++++-
 gnu/system/mapped-devices.scm | 29 +++++++++++++++++++++++++----
 2 files changed, 33 insertions(+), 5 deletions(-)

(limited to 'gnu/system')

diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index aa9fbf6fe9..484bce71c4 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -229,7 +229,14 @@ (define device-mapping-commands
          (use-modules (gnu build linux-boot)
                       (guix build utils)
                       (guix build bournish)   ;add the 'bournish' meta-command
-                      (srfi srfi-26))
+                      (srfi srfi-26)
+
+                      ;; FIXME: The following modules are for
+                      ;; LUKS-DEVICE-MAPPING.  We should instead propagate
+                      ;; this info via gexps.
+                      ((gnu build file-systems)
+                       #:select (find-partition-by-luks-uuid))
+                      (rnrs bytevectors))
 
          (with-output-to-port (%make-void-port "w")
            (lambda ()
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 2706e255c5..450b4737ac 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -22,6 +22,7 @@ (define-module (gnu system mapped-devices)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:autoload   (gnu packages cryptsetup) (cryptsetup)
+  #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:export (mapped-device
             mapped-device?
@@ -77,7 +78,16 @@ (define device-mapping-service-type
        (documentation "Map a device node using Linux's device mapper.")
        (start #~(lambda () #$(open source target)))
        (stop #~(lambda _ (not #$(close source target))))
-       (respawn? #f))))))
+       (respawn? #f)
+
+       ;; Add the modules needed by LUKS-DEVICE-MAPPING.
+       ;; FIXME: This info should be propagated via gexps.
+       (modules `((rnrs bytevectors)              ;bytevector?
+                  ((gnu build file-systems)
+                   #:select (find-partition-by-luks-uuid))
+                  ,@%default-modules))
+       (imported-modules `((gnu build file-systems)
+                           ,@%default-imported-modules)))))))
 
 (define (device-mapping-service mapped-device)
   "Return a service that sets up @var{mapped-device}."
@@ -91,9 +101,20 @@ (define (device-mapping-service mapped-device)
 (define (open-luks-device source target)
   "Return a gexp that maps SOURCE to TARGET as a LUKS device, using
 'cryptsetup'."
-  #~(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup")
-                    "open" "--type" "luks"
-                    #$source #$target)))
+  #~(let ((source #$source))
+      (zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup")
+                      "open" "--type" "luks"
+
+                      ;; Note: We cannot use the "UUID=source" syntax here
+                      ;; because 'cryptsetup' implements it by searching the
+                      ;; udev-populated /dev/disk/by-id directory but udev may
+                      ;; be unavailable at the time we run this.
+                      (if (bytevector? source)
+                          (or (find-partition-by-luks-uuid source)
+                              (error "LUKS partition not found" source))
+                          source)
+
+                      #$target))))
 
 (define (close-luks-device source target)
   "Return a gexp that closes TARGET, a LUKS device."
-- 
cgit v1.2.3