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.
This commit is contained in:
Ludovic Courtès 2016-04-17 17:59:58 +02:00
parent 060d62a740
commit 374f14c265
2 changed files with 29 additions and 23 deletions

View File

@ -43,7 +43,6 @@
#:use-module (gnu packages texinfo) #:use-module (gnu packages texinfo)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages firmware) #:use-module (gnu packages firmware)
#:autoload (gnu packages cryptsetup) (cryptsetup)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services shepherd) #:use-module (gnu services shepherd)
#:use-module (gnu services base) #:use-module (gnu services base)
@ -102,9 +101,7 @@
local-host-aliases local-host-aliases
%setuid-programs %setuid-programs
%base-packages %base-packages
%base-firmware %base-firmware))
luks-device-mapping))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -177,24 +174,6 @@
;;; Services. ;;; 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) (define (other-file-system-services os)
"Return file system services for the file systems of OS that are not marked "Return file system services for the file systems of OS that are not marked
as 'needed-for-boot'." as 'needed-for-boot'."

View File

@ -17,7 +17,9 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system mapped-devices) (define-module (gnu system mapped-devices)
#:use-module (guix gexp)
#:use-module (guix records) #:use-module (guix records)
#:autoload (gnu packages cryptsetup) (cryptsetup)
#:export (mapped-device #:export (mapped-device
mapped-device? mapped-device?
mapped-device-source mapped-device-source
@ -27,7 +29,9 @@
mapped-device-kind mapped-device-kind
mapped-device-kind? mapped-device-kind?
mapped-device-kind-open mapped-device-kind-open
mapped-device-kind-close)) mapped-device-kind-close
luks-device-mapping))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -50,4 +54,27 @@
(close mapped-device-kind-close ;source target -> gexp (close mapped-device-kind-close ;source target -> gexp
(default (const #~(const #f))))) (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 ;;; mapped-devices.scm ends here