From fb729425dcd80b8ef34c075867d2f204bc4d55cb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 22 May 2014 23:22:15 +0200
Subject: [PATCH] guix system: Add 'disk-image' action.

* guix/scripts/system.scm (show-help): Add 'disk-image'.
  (guix-system)[parse-options]: Support 'disk-image' action.
  [option-arguments]: Likewise.
  Handle the 'disk-image' action.
* doc/guix.texi (Invoking guix system): Document 'disk-image'.
---
 doc/guix.texi           | 20 +++++++++++++++++---
 guix/scripts/system.scm | 12 +++++++++---
 2 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index edb1dceeab..ddb0763495 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3236,9 +3236,23 @@ Build a virtual machine that contain the operating system declared in
 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.
+@itemx disk-image
+Return a virtual machine or disk 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.
+
+When using @code{vm-image}, the returned image is in qcow2 format, which
+the QEMU emulator can efficiently use.
+
+When using @code{disk-image}, a raw disk image is produced; it can be
+copied as is to a USB stick, for instance.  Assuming @code{/dev/sdc} is
+the device corresponding to a USB stick, one can copy the image on it
+using the following command:
+
+@example
+# dd if=$(guix system disk-image my-os.scm) of=/dev/sdc
+@end example
+
 @end table
 
 @var{options} can contain any of the common build options provided by
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index af48c57b54..345d8c3e5f 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -129,6 +129,8 @@ (define (show-help)
   (display (_ "\
   - 'vm-image', build a freestanding virtual machine image\n"))
   (display (_ "\
+  - 'disk-image', build a disk image, suitable for a USB stick\n"))
+  (display (_ "\
   - 'init', initialize a root file system to run GNU.\n"))
 
   (show-build-options-help)
@@ -191,7 +193,7 @@ (define (parse-options)
                       (alist-cons 'argument arg result)
                       (let ((action (string->symbol arg)))
                         (case action
-                          ((build vm vm-image init)
+                          ((build vm vm-image disk-image init)
                            (alist-cons 'action action result))
                           (else (leave (_ "~a: unknown action~%")
                                        action))))))
@@ -214,7 +216,7 @@ (define (fail)
                action))
 
       (case action
-        ((build vm vm-image)
+        ((build vm vm-image disk-image)
          (unless (= count 1)
            (fail)))
         ((init)
@@ -238,7 +240,11 @@ (define (fail)
                           (system-qemu-image os
                                              #:disk-image-size size)))
                        ((vm)
-                        (system-qemu-image/shared-store-script os))))
+                        (system-qemu-image/shared-store-script os))
+                       ((disk-image)
+                        (let ((size (assoc-ref opts 'image-size)))
+                          (system-disk-image os
+                                             #:disk-image-size size)))))
            (store    (open-connection))
            (dry?     (assoc-ref opts 'dry-run?))
            (drv      (run-with-store store mdrv))