guix system: Add 'vm-image' action and '--image-size' option.
* guix/scripts/system.scm (%options): Add --image-size. (%default-options): Add 'image-size'. (guix-system)[parse-options]: Handle the 'vm-image' action. Honor them. (show-help): Update accordingly. * doc/guix.texi (Invoking guix system): Add 'vm-image'.
This commit is contained in:
parent
1d6243cf70
commit
2e7b5cea8c
@ -2982,7 +2982,8 @@ guix system @var{options}@dots{} @var{action} @var{file}
|
||||
|
||||
@var{file} must be the name of a file containing an
|
||||
@code{operating-system} declaration. @var{action} specifies how the
|
||||
operating system is instantiate. Currently only one value is supported:
|
||||
operating system is instantiate. Currently the following values are
|
||||
supported:
|
||||
|
||||
@table @code
|
||||
@item vm
|
||||
@ -2991,6 +2992,11 @@ Build a virtual machine that contain the operating system declared in
|
||||
@var{file}, and return a script to run that virtual machine (VM).
|
||||
|
||||
The VM shares its store with the host system.
|
||||
|
||||
@item vm-image
|
||||
Return a virtual machine image of the operating system declared in
|
||||
@var{file} that stands alone. Use the @option{--image-size} option to
|
||||
specify the size of the image.
|
||||
@end table
|
||||
|
||||
@var{options} can contain any of the common build options provided by
|
||||
|
@ -71,9 +71,12 @@
|
||||
(define (show-help)
|
||||
(display (_ "Usage: guix system [OPTION] ACTION FILE
|
||||
Build the operating system declared in FILE according to ACTION.\n"))
|
||||
(display (_ "Currently the only valid value for ACTION is 'vm', which builds
|
||||
a virtual machine of the given operating system.\n"))
|
||||
(display (_ "Currently the only valid values for ACTION are 'vm', which builds
|
||||
a virtual machine of the given operating system that shares the host's store,
|
||||
and 'vm-image', which builds a virtual machine image that stands alone.\n"))
|
||||
(show-build-options-help)
|
||||
(display (_ "
|
||||
--image-size=SIZE for 'vm-image', produce an image of SIZE"))
|
||||
(newline)
|
||||
(display (_ "
|
||||
-h, --help display this help and exit"))
|
||||
@ -91,6 +94,10 @@ a virtual machine of the given operating system.\n"))
|
||||
(option '(#\V "version") #f #f
|
||||
(lambda args
|
||||
(show-version-and-exit "guix system")))
|
||||
(option '("image-size") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'image-size (size->number arg)
|
||||
result)))
|
||||
(option '(#\n "dry-run") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'dry-run? #t result)))
|
||||
@ -102,7 +109,8 @@ a virtual machine of the given operating system.\n"))
|
||||
(substitutes? . #t)
|
||||
(build-hook? . #t)
|
||||
(max-silent-time . 3600)
|
||||
(verbosity . 0)))
|
||||
(verbosity . 0)
|
||||
(image-size . ,(* 900 (expt 2 20)))))
|
||||
|
||||
|
||||
;;;
|
||||
@ -123,21 +131,31 @@ a virtual machine of the given operating system.\n"))
|
||||
(alist-cons 'argument arg result)))
|
||||
(let ((action (string->symbol arg)))
|
||||
(case action
|
||||
((vm) (alist-cons 'action action result))
|
||||
((vm)
|
||||
(alist-cons 'action action result))
|
||||
((vm-image)
|
||||
(alist-cons 'action action result))
|
||||
(else (leave (_ "~a: unknown action~%")
|
||||
action))))))
|
||||
%default-options))
|
||||
|
||||
(with-error-handling
|
||||
(let* ((opts (parse-options))
|
||||
(file (assoc-ref opts 'argument))
|
||||
(os (if file
|
||||
(read-operating-system file)
|
||||
(leave (_ "no configuration file specified~%"))))
|
||||
(mdrv (system-qemu-image/shared-store-script os))
|
||||
(store (open-connection))
|
||||
(dry? (assoc-ref opts 'dry-run?))
|
||||
(drv (run-with-store store mdrv)))
|
||||
(let* ((opts (parse-options))
|
||||
(file (assoc-ref opts 'argument))
|
||||
(action (assoc-ref opts 'action))
|
||||
(os (if file
|
||||
(read-operating-system file)
|
||||
(leave (_ "no configuration file specified~%"))))
|
||||
(mdrv (case action
|
||||
((vm-image)
|
||||
(let ((size (assoc-ref opts 'image-size)))
|
||||
(system-qemu-image os
|
||||
#:disk-image-size size)))
|
||||
((vm)
|
||||
(system-qemu-image/shared-store-script os))))
|
||||
(store (open-connection))
|
||||
(dry? (assoc-ref opts 'dry-run?))
|
||||
(drv (run-with-store store mdrv)))
|
||||
(set-build-options-from-command-line store opts)
|
||||
(show-what-to-build store (list drv)
|
||||
#:dry-run? dry?
|
||||
|
Loading…
Reference in New Issue
Block a user