diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-09-18 19:18:39 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-09-18 19:18:39 +0200 |
| commit | 722554a306be645026d75893b77863769dcd861d (patch) | |
| tree | 4b2e16ebb8524103708c48681f10dc976080e250 /gnu/system.scm | |
| parent | cb823dd279b77566f2974b210fbd58a7c53a2b0a (diff) | |
| download | gnu-guix-722554a306be645026d75893b77863769dcd861d.tar gnu-guix-722554a306be645026d75893b77863769dcd861d.tar.gz | |
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.scm | 24 |
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) |