From 060d62a740fc1932a3be505534feff099b59ac9f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Apr 2016 17:53:20 +0200 Subject: system: Add (gnu system mapped-devices). * gnu/system/file-systems.scm (, ): Move to... * gnu/system/mapped-devices.scm: ... here. New file. * gnu/system.scm, gnu/services/base.scm, gnu/system/linux-initrd.scm: Use it. * gnu-system.am (GNU_SYSTEM_MODULES): Add it. * gnu.scm (%public-modules): Add it. --- gnu/system.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index a4259fb61b..a52881180d 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -54,6 +54,7 @@ #:use-module (gnu system pam) #:use-module (gnu system linux-initrd) #:use-module (gnu system file-systems) + #:use-module (gnu system mapped-devices) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) -- cgit v1.2.3 From 374f14c265224048b065f2c177f80718b905201b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Apr 2016 17:59:58 +0200 Subject: system: Move 'luks-device-mapping' to (gnu system mapped-devices). * gnu/system.scm (open-luks-device, close-luks-device) (luks-device-mapping): Move to... * gnu/system/mapped-devices.scm: ... here. New file. --- gnu/system.scm | 23 +---------------------- gnu/system/mapped-devices.scm | 29 ++++++++++++++++++++++++++++- 2 files changed, 29 insertions(+), 23 deletions(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index a52881180d..b1454b262d 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -43,7 +43,6 @@ #:use-module (gnu packages texinfo) #:use-module (gnu packages compression) #:use-module (gnu packages firmware) - #:autoload (gnu packages cryptsetup) (cryptsetup) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu services base) @@ -102,9 +101,7 @@ local-host-aliases %setuid-programs %base-packages - %base-firmware - - luks-device-mapping)) + %base-firmware)) ;;; Commentary: ;;; @@ -177,24 +174,6 @@ ;;; Services. ;;; -(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'." diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm index 81afb91f86..dd8e432688 100644 --- a/gnu/system/mapped-devices.scm +++ b/gnu/system/mapped-devices.scm @@ -17,7 +17,9 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu system mapped-devices) + #:use-module (guix gexp) #:use-module (guix records) + #:autoload (gnu packages cryptsetup) (cryptsetup) #:export (mapped-device mapped-device? mapped-device-source @@ -27,7 +29,9 @@ mapped-device-kind mapped-device-kind? mapped-device-kind-open - mapped-device-kind-close)) + mapped-device-kind-close + + luks-device-mapping)) ;;; Commentary: ;;; @@ -50,4 +54,27 @@ (close mapped-device-kind-close ;source target -> gexp (default (const #~(const #f))))) + +;;; +;;; Common device mappings. +;;; + +(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))) + ;;; mapped-devices.scm ends here -- cgit v1.2.3 From 4da8c19e8337cbb908d5e77cd912791846070fb7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Apr 2016 18:26:50 +0200 Subject: mapped-devices: 'mapped-device-service' takes a . * gnu/system/mapped-devices.scm (device-mapping-service): Take a instead of 3 parameters. (device-mapping-service-type): Adjust accordingly. * gnu/system.scm (device-mapping-services): Adjust accordingly. --- gnu/system.scm | 10 +--------- gnu/system/mapped-devices.scm | 16 +++++++--------- 2 files changed, 8 insertions(+), 18 deletions(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index b1454b262d..768ca9cab2 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -233,15 +233,7 @@ from the initrd." (define (device-mapping-services os) "Return the list of device-mapping services for OS as a list." - (map (lambda (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 - (open source target) - (close source target)))) + (map device-mapping-service (operating-system-user-mapped-devices os))) (define (swap-services os) diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm index be2d6a4749..2706e255c5 100644 --- a/gnu/system/mapped-devices.scm +++ b/gnu/system/mapped-devices.scm @@ -69,21 +69,19 @@ (shepherd-service-type 'device-mapping (match-lambda - ((target open close) + (($ source target + ($ open close)) (shepherd-service (provision (list (symbol-append 'device-mapping- (string->symbol target)))) (requirement '(udev)) (documentation "Map a device node using Linux's device mapper.") - (start #~(lambda () #$open)) - (stop #~(lambda _ (not #$close))) + (start #~(lambda () #$(open source target))) + (stop #~(lambda _ (not #$(close source target)))) (respawn? #f)))))) -(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}). Evaluate @var{open}, a -gexp, to open it, and evaluate @var{close} to close it." - (service device-mapping-service-type - (list target open close))) +(define (device-mapping-service mapped-device) + "Return a service that sets up @var{mapped-device}." + (service device-mapping-service-type mapped-device)) ;;; -- cgit v1.2.3