summaryrefslogtreecommitdiff
path: root/gnu/system.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-09-18 19:18:39 +0200
committerLudovic Courtès <ludo@gnu.org>2014-09-18 19:18:39 +0200
commit722554a306be645026d75893b77863769dcd861d (patch)
tree4b2e16ebb8524103708c48681f10dc976080e250 /gnu/system.scm
parentcb823dd279b77566f2974b210fbd58a7c53a2b0a (diff)
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'.
Diffstat (limited to 'gnu/system.scm')
-rw-r--r--gnu/system.scm24
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)