* 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'.
;; 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
;;; 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'."
"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)
;;; 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
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:
;;;
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