system: Define 'device-mapping-kind', and add a 'close' procedure.

* gnu/system/file-systems.scm (<mapped-device-type>): New record type.
  (<mapped-device>)[command]: Remove field.
  [type]: New field.
* gnu/services/base.scm (device-mapping-service): Rename 'command'
  parameter to 'open'.  Add 'close' parameter and honor it.
* gnu/system.scm (luks-device-mapping): Rename to...
  (open-luks-device): ... this.
  (close-luks-device): New procedure.
  (luks-device-mapping): New variable.
  (device-mapping-services): Get the type of MD, and pass its 'open' and
  'close' fields to 'device-mapping-service'.

1 files changed, 19 insertions, 5 deletions

diff --git a/gnu/system.scm b/gnu/system.scm
index db7b7e7a2f..6f0469a763 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -160,13 +160,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'."
@@ -207,11 +218,14 @@ as 'needed-for-boot'."
   "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))))
+                                             (open source target)
+                                             (close source target))))
                  (operating-system-mapped-devices os))))
 
 (define (essential-services os)