diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index bfe5f52af4..f2de85f410 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -600,19 +600,18 @@ extra rules from the packages listed in @var{rules}."
;; called. Thus, make sure it is not respawned.
(respawn? #f)))))
-(define (device-mapping-service target command)
+(define (device-mapping-service target open close)
"Return a service that maps device @var{target}, a string such as
-@code{\"home\"} (meaning @code{/dev/mapper/home}), by executing @var{command},
-a gexp."
+@code{\"home\"} (meaning @code{/dev/mapper/home}). Evaluate @var{open}, a
+gexp, to open it, and evaluate @var{close} to close it."
(with-monad %store-monad
(return (service
(provision (list (symbol-append 'device-mapping-
(string->symbol target))))
(requirement '(udev))
(documentation "Map a device node using Linux's device mapper.")
- (start #~(lambda ()
- #$command))
- (stop #~(const #f))
+ (start #~(lambda () #$open))
+ (stop #~(lambda _ (not #$close)))
(respawn? #f)))))
(define %base-services
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)
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 90e2b0c796..ed9d70587f 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -17,6 +17,7 @@
;;; along with GNU Guix. If not, see .
(define-module (gnu system file-systems)
+ #:use-module (guix gexp)
#:use-module (guix records)
#:export (
file-system
@@ -43,7 +44,12 @@
mapped-device?
mapped-device-source
mapped-device-target
- mapped-device-command))
+ mapped-device-type
+
+ mapped-device-kind
+ mapped-device-kind?
+ mapped-device-kind-open
+ mapped-device-kind-close))
;;; Commentary:
;;;
@@ -145,6 +151,13 @@
mapped-device?
(source mapped-device-source) ;string
(target mapped-device-target) ;string
- (command mapped-device-command)) ;source target -> gexp
+ (type mapped-device-type)) ;
+
+(define-record-type* mapped-device-kind
+ make-mapped-device-kind
+ mapped-device-kind?
+ (open mapped-device-kind-open) ;source target -> gexp
+ (close mapped-device-kind-close ;source target -> gexp
+ (default (const #~(const #f)))))
;;; file-systems.scm ends here