mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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.
This commit is contained in:
parent
fcf63cf880
commit
0276f697b3
2 changed files with 56 additions and 4 deletions
|
@ -4375,12 +4375,27 @@ This command also installs GRUB on the device specified in
|
||||||
|
|
||||||
@item vm
|
@item vm
|
||||||
@cindex virtual machine
|
@cindex virtual machine
|
||||||
|
@cindex VM
|
||||||
Build a virtual machine that contain the operating system declared in
|
Build a virtual machine that contain the operating system declared in
|
||||||
@var{file}, and return a script to run that virtual machine (VM).
|
@var{file}, and return a script to run that virtual machine (VM).
|
||||||
Arguments given to the script are passed as is to QEMU.
|
Arguments given to the script are passed as is to QEMU.
|
||||||
|
|
||||||
The VM shares its store with the host system.
|
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
|
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
|
the advantage of requiring only a very tiny root disk image since the
|
||||||
host's store can then be mounted.
|
host's store can then be mounted.
|
||||||
|
|
|
@ -264,7 +264,7 @@ (define (system->grub-entry system number time)
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define* (system-derivation-for-action os action
|
(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."
|
"Return as a monadic value the derivation for OS according to ACTION."
|
||||||
(case action
|
(case action
|
||||||
((build init reconfigure)
|
((build init reconfigure)
|
||||||
|
@ -274,7 +274,8 @@ (define* (system-derivation-for-action os action
|
||||||
((vm)
|
((vm)
|
||||||
(system-qemu-image/shared-store-script os
|
(system-qemu-image/shared-store-script os
|
||||||
#:full-boot? full-boot?
|
#:full-boot? full-boot?
|
||||||
#:disk-image-size image-size))
|
#:disk-image-size image-size
|
||||||
|
#:mappings mappings))
|
||||||
((disk-image)
|
((disk-image)
|
||||||
(system-disk-image os #:disk-image-size image-size))))
|
(system-disk-image os #:disk-image-size image-size))))
|
||||||
|
|
||||||
|
@ -298,7 +299,8 @@ (define* (maybe-build drvs
|
||||||
(define* (perform-action action os
|
(define* (perform-action action os
|
||||||
#:key grub? dry-run?
|
#:key grub? dry-run?
|
||||||
use-substitutes? device target
|
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
|
"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
|
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'
|
is the size of the image to be built, for the 'vm-image' and 'disk-image'
|
||||||
|
@ -307,7 +309,8 @@ (define* (perform-action action os
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((sys (system-derivation-for-action os action
|
((sys (system-derivation-for-action os action
|
||||||
#:image-size image-size
|
#:image-size image-size
|
||||||
#:full-boot? full-boot?))
|
#:full-boot? full-boot?
|
||||||
|
#:mappings mappings))
|
||||||
(grub (package->derivation grub))
|
(grub (package->derivation grub))
|
||||||
(grub.cfg (grub.cfg os))
|
(grub.cfg (grub.cfg os))
|
||||||
(drvs -> (if (and grub? (memq action '(init reconfigure)))
|
(drvs -> (if (and grub? (memq action '(init reconfigure)))
|
||||||
|
@ -379,6 +382,10 @@ (define (show-help)
|
||||||
--image-size=SIZE for 'vm-image', produce an image of SIZE"))
|
--image-size=SIZE for 'vm-image', produce an image of SIZE"))
|
||||||
(display (_ "
|
(display (_ "
|
||||||
--no-grub for 'init', do not install GRUB"))
|
--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 (_ "
|
(display (_ "
|
||||||
--full-boot for 'vm', make a full boot sequence"))
|
--full-boot for 'vm', make a full boot sequence"))
|
||||||
(newline)
|
(newline)
|
||||||
|
@ -389,6 +396,19 @@ (define (show-help)
|
||||||
(newline)
|
(newline)
|
||||||
(show-bug-report-information))
|
(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
|
(define %options
|
||||||
;; Specifications of the command-line options.
|
;; Specifications of the command-line options.
|
||||||
(cons* (option '(#\h "help") #f #f
|
(cons* (option '(#\h "help") #f #f
|
||||||
|
@ -408,6 +428,18 @@ (define %options
|
||||||
(option '("full-boot") #f #f
|
(option '("full-boot") #f #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'full-boot? #t 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
|
(option '(#\n "dry-run") #f #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'dry-run? #t result)))
|
(alist-cons 'dry-run? #t result)))
|
||||||
|
@ -502,6 +534,11 @@ (define (fail)
|
||||||
#:use-substitutes? (assoc-ref opts 'substitutes?)
|
#:use-substitutes? (assoc-ref opts 'substitutes?)
|
||||||
#:image-size (assoc-ref opts 'image-size)
|
#:image-size (assoc-ref opts 'image-size)
|
||||||
#:full-boot? (assoc-ref opts 'full-boot?)
|
#:full-boot? (assoc-ref opts 'full-boot?)
|
||||||
|
#:mappings (filter-map (match-lambda
|
||||||
|
(('file-system-mapping . m)
|
||||||
|
m)
|
||||||
|
(_ #f))
|
||||||
|
opts)
|
||||||
#:grub? grub?
|
#:grub? grub?
|
||||||
#:target target #:device device)
|
#:target target #:device device)
|
||||||
#:system system))))
|
#:system system))))
|
||||||
|
|
Loading…
Reference in a new issue