summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-11-21 00:02:26 +0100
committerLudovic Courtès <ludo@gnu.org>2014-11-21 00:02:26 +0100
commit0276f697b3dbab417dcad7ff32dfb4b9fb330ec4 (patch)
tree8902cdb6da9e43887d5db92ef6424b16bb05b7f0 /guix
parentfcf63cf880cf260601f4bda763e80e5ddd527d62 (diff)
guix system: Add '--share' and '--expose' options for 'vm'.
* guix/scripts/system.scm (system-derivation-for-action): Add #:mappings parameter. Pass it to 'system-qemu-image/shared-store-script'. (perform-action): Likewise. (show-help): Document --share and --expose. (specification->file-system-mapping): New procedure. (%options): Add --share and --expose. (guix-system): Pass #:mapping to 'perform-action'. * doc/guix.texi (Invoking guix system): Document it.
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/system.scm45
1 files changed, 41 insertions, 4 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 92364fda27..398a5a371b 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -264,7 +264,7 @@ it atomically, and then run OS's activation script."
;;;
(define* (system-derivation-for-action os action
- #:key image-size full-boot?)
+ #:key image-size full-boot? mappings)
"Return as a monadic value the derivation for OS according to ACTION."
(case action
((build init reconfigure)
@@ -274,7 +274,8 @@ it atomically, and then run OS's activation script."
((vm)
(system-qemu-image/shared-store-script os
#:full-boot? full-boot?
- #:disk-image-size image-size))
+ #:disk-image-size image-size
+ #:mappings mappings))
((disk-image)
(system-disk-image os #:disk-image-size image-size))))
@@ -298,7 +299,8 @@ true."
(define* (perform-action action os
#:key grub? dry-run?
use-substitutes? device target
- image-size full-boot?)
+ image-size full-boot?
+ (mappings '()))
"Perform ACTION for OS. GRUB? specifies whether to install GRUB; DEVICE is
the target devices for GRUB; TARGET is the target root directory; IMAGE-SIZE
is the size of the image to be built, for the 'vm-image' and 'disk-image'
@@ -307,7 +309,8 @@ boot directly to the kernel or to the bootloader."
(mlet* %store-monad
((sys (system-derivation-for-action os action
#:image-size image-size
- #:full-boot? full-boot?))
+ #:full-boot? full-boot?
+ #:mappings mappings))
(grub (package->derivation grub))
(grub.cfg (grub.cfg os))
(drvs -> (if (and grub? (memq action '(init reconfigure)))
@@ -380,6 +383,10 @@ Build the operating system declared in FILE according to ACTION.\n"))
(display (_ "
--no-grub for 'init', do not install GRUB"))
(display (_ "
+ --share=SPEC for 'vm', share host file system according to SPEC"))
+ (display (_ "
+ --expose=SPEC for 'vm', expose host file system according to SPEC"))
+ (display (_ "
--full-boot for 'vm', make a full boot sequence"))
(newline)
(display (_ "
@@ -389,6 +396,19 @@ Build the operating system declared in FILE according to ACTION.\n"))
(newline)
(show-bug-report-information))
+(define (specification->file-system-mapping spec writable?)
+ "Read the SPEC and return the corresponding <file-system-mapping>."
+ (let ((index (string-index spec #\=)))
+ (if index
+ (file-system-mapping
+ (source (substring spec 0 index))
+ (target (substring spec (+ 1 index)))
+ (writable? writable?))
+ (file-system-mapping
+ (source spec)
+ (target spec)
+ (writable? writable?)))))
+
(define %options
;; Specifications of the command-line options.
(cons* (option '(#\h "help") #f #f
@@ -408,6 +428,18 @@ Build the operating system declared in FILE according to ACTION.\n"))
(option '("full-boot") #f #f
(lambda (opt name arg result)
(alist-cons 'full-boot? #t result)))
+
+ (option '("share") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'file-system-mapping
+ (specification->file-system-mapping arg #t)
+ result)))
+ (option '("expose") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'file-system-mapping
+ (specification->file-system-mapping arg #f)
+ result)))
+
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
(alist-cons 'dry-run? #t result)))
@@ -502,6 +534,11 @@ Build the operating system declared in FILE according to ACTION.\n"))
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:image-size (assoc-ref opts 'image-size)
#:full-boot? (assoc-ref opts 'full-boot?)
+ #:mappings (filter-map (match-lambda
+ (('file-system-mapping . m)
+ m)
+ (_ #f))
+ opts)
#:grub? grub?
#:target target #:device device)
#:system system))))