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.
---
 doc/guix.texi                 | 20 ++++++++++++++++++--
 gnu/system/linux-initrd.scm   |  9 ++++++++-
 gnu/system/mapped-devices.scm | 29 +++++++++++++++++++++++++----
 3 files changed, 51 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index d5f7dcb30b..1b02ba0373 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6688,13 +6688,29 @@ Mapped devices are declared using the @code{mapped-device} form:
   (type luks-device-mapping))
 @end example
 
-@noindent
+Or, better yet, like this:
+
+@example
+(mapped-device
+  (source (uuid "cb67fc72-0d54-4c88-9d4b-b225f30b0f44"))
+  (target "home")
+  (type luks-device-mapping))
+@end example
+
 @cindex disk encryption
 @cindex LUKS
 This example specifies a mapping from @file{/dev/sda3} to
 @file{/dev/mapper/home} using LUKS---the
 @url{http://code.google.com/p/cryptsetup,Linux Unified Key Setup}, a
-standard mechanism for disk encryption.  The @file{/dev/mapper/home}
+standard mechanism for disk encryption.  In the second example, the UUID
+(unique identifier) is the LUKS UUID returned for the device by a
+command like:
+
+@example
+cryptsetup luksUUID /dev/sdx9
+@end example
+
+The @file{/dev/mapper/home}
 device can then be used as the @code{device} of a @code{file-system}
 declaration (@pxref{File Systems}).  The @code{mapped-device} form is
 detailed below.
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 @@ loaded at boot time in the order in which they appear."
          (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 @@
   #: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 @@
        (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 (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