diff options
| -rw-r--r-- | gnu/services/base.scm | 11 | ||||
| -rw-r--r-- | gnu/system.scm | 24 | ||||
| -rw-r--r-- | gnu/system/file-systems.scm | 17 |
3 files changed, 39 insertions, 13 deletions
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 <http://www.gnu.org/licenses/>. (define-module (gnu system file-systems) + #:use-module (guix gexp) #:use-module (guix records) #:export (<file-system> 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)) ;<mapped-device-kind> + +(define-record-type* <mapped-device-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 |