nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
Ludovic Courtès 2014-04-09 01:20:19 +02:00
parent 1d6243cf70
commit 2e7b5cea8c
2 changed files with 38 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
doc/guix.texi
View File

@ -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

28
guix/scripts/system.scm
View File

@ -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,7 +131,10 @@ 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))
@ -131,10 +142,17 @@ a virtual machine of the given operating system.\n"))
(with-error-handling
(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 (system-qemu-image/shared-store-script os))
(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)))