1 files changed, 65 insertions, 11 deletions

diff --git a/gnu/system.scm b/gnu/system.scm
index db7b7e7a2f..d15c864384 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -105,6 +105,8 @@
   (mapped-devices operating-system-mapped-devices ; list of <mapped-device>
                   (default '()))
   (file-systems operating-system-file-systems)    ; list of fs
+  (swap-devices operating-system-swap-devices     ; list of strings
+                (default '()))
 
   (users operating-system-users                   ; list of user accounts
          (default '()))
@@ -160,13 +162,24 @@ file."
 ;;; Services.
 ;;;
 
-(define (luks-device-mapping source target)
+(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)))
 
+(define (close-luks-device source target)
+  "Return a gexp that closes TARGET, a LUKS device."
+  #~(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup")
+                    "close" #$target)))
+
+(define luks-device-mapping
+  ;; The type of LUKS mapped devices.
+  (mapped-device-kind
+   (open open-luks-device)
+   (close close-luks-device)))
+
 (define (other-file-system-services os)
   "Return file system services for the file systems of OS that are not marked
 as 'needed-for-boot'."
@@ -203,16 +216,52 @@ as 'needed-for-boot'."
                                            #:flags flags))))
                  file-systems)))
 
+(define (mapped-device-user device file-systems)
+  "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
+  (let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
+    (find (lambda (fs)
+            (string=? (file-system-device fs) target))
+          file-systems)))
+
+(define (operating-system-user-mapped-devices os)
+  "Return the subset of mapped devices that can be installed in
+user-land--i.e., those not needed during boot."
+  (let ((devices      (operating-system-mapped-devices os))
+        (file-systems (operating-system-file-systems os)))
+   (filter (lambda (md)
+             (let ((user (mapped-device-user md file-systems)))
+               (or (not user)
+                   (not (file-system-needed-for-boot? user)))))
+           devices)))
+
+(define (operating-system-boot-mapped-devices os)
+  "Return the subset of mapped devices that must be installed during boot,
+from the initrd."
+  (let ((devices      (operating-system-mapped-devices os))
+        (file-systems (operating-system-file-systems os)))
+   (filter (lambda (md)
+             (let ((user (mapped-device-user md file-systems)))
+               (and user (file-system-needed-for-boot? user))))
+           devices)))
+
 (define (device-mapping-services os)
   "Return the list of device-mapping services for OS as a monadic list."
   (sequence %store-monad
             (map (lambda (md)
-                   (let ((source  (mapped-device-source md))
-                         (target  (mapped-device-target md))
-                         (command (mapped-device-command md)))
+                   (let* ((source (mapped-device-source md))
+                          (target (mapped-device-target md))
+                          (type   (mapped-device-type md))
+                          (open   (mapped-device-kind-open type))
+                          (close  (mapped-device-kind-close type)))
                      (device-mapping-service target
-                                             (command source target))))
-                 (operating-system-mapped-devices os))))
+                                             (open source target)
+                                             (close source target))))
+                 (operating-system-user-mapped-devices os))))
+
+(define (swap-services os)
+  "Return the list of swap services for OS as a monadic list."
+  (sequence %store-monad
+            (map swap-service (operating-system-swap-devices os))))
 
 (define (essential-services os)
   "Return the list of essential services for OS.  These are special services
@@ -221,13 +270,14 @@ bookkeeping."
   (mlet* %store-monad ((mappings  (device-mapping-services os))
                        (root-fs   (root-file-system-service))
                        (other-fs  (other-file-system-services os))
+                       (swaps     (swap-services os))
                        (procs     (user-processes-service
                                    (map (compose first service-provision)
                                         other-fs)))
                        (host-name (host-name-service
                                    (operating-system-host-name os))))
     (return (cons* host-name procs root-fs
-                   (append other-fs mappings)))))
+                   (append other-fs mappings swaps)))))
 
 (define (operating-system-services os)
   "Return all the services of OS, including \"internal\" services that do not
@@ -539,10 +589,14 @@ we're running in the final root."
               boot?))
             (operating-system-file-systems os)))
 
-  ;; TODO: Pass the mapped devices required by boot-time file systems to the
-  ;; initrd.
-  (mlet %store-monad
-      ((initrd ((operating-system-initrd os) boot-file-systems)))
+  (define mapped-devices
+    (operating-system-boot-mapped-devices os))
+
+  (define make-initrd
+    (operating-system-initrd os))
+
+  (mlet %store-monad ((initrd (make-initrd boot-file-systems
+                                           #:mapped-devices mapped-devices)))
     (return #~(string-append #$initrd "/initrd"))))
 
 (define (kernel->grub-label kernel)