summaryrefslogtreecommitdiff
path: root/guix/scripts/system.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-04-09 01:20:19 +0200
committerLudovic Courtès <ludo@gnu.org>2014-04-09 01:20:19 +0200
commit2e7b5cea8cc5e50e8c4832e96ce7b40b4f99906f (patch)
tree4d8274405a2b137de29679f42d3dea78afecfa6e /guix/scripts/system.scm
parent1d6243cf70269acdaf32f1ad61beba241f130484 (diff)
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'.
Diffstat (limited to 'guix/scripts/system.scm')
-rw-r--r--guix/scripts/system.scm44
1 files changed, 31 insertions, 13 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 823713eada..582027244c 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -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?