Browse Source

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.
version-0.8.3
Ludovic Courtès 8 years ago
parent
commit
0276f697b3
  1. 15
      doc/guix.texi
  2. 45
      guix/scripts/system.scm

15
doc/guix.texi

@ -4375,12 +4375,27 @@ This command also installs GRUB on the device specified in
@item vm
@cindex virtual machine
@cindex VM
Build a virtual machine that contain the operating system declared in
@var{file}, and return a script to run that virtual machine (VM).
Arguments given to the script are passed as is to QEMU.
The VM shares its store with the host system.
Additional file systems can be shared between the host and the VM using
the @code{--share} and @code{--expose} command-line options: the former
specifies a directory to be shared with write access, while the latter
provides read-only access to the shared directory.
The example below creates a VM in which the user's home directory is
accessible read-only, and where the @file{/exchange} directory is a
read-write mapping of the host's @file{$HOME/tmp}:
@example
guix system vm my-config.scm \
--expose=$HOME --share=$HOME/tmp=/exchange
@end example
On GNU/Linux, the default is to boot directly to the kernel; this has
the advantage of requiring only a very tiny root disk image since the
host's store can then be mounted.

45
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)))
@ -379,6 +382,10 @@ Build the operating system declared in FILE according to ACTION.\n"))
--image-size=SIZE for 'vm-image', produce an image of SIZE"))
(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)
@ -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))))

Loading…
Cancel
Save