M doc/guix.texi => doc/guix.texi +8 -4
@@ 7877,9 7877,8 @@ that.
The installation image described above was built using the @command{guix
system} command, specifically:
-@c FIXME: 1G is too much; see <http://bugs.gnu.org/23077>.
@example
-guix system disk-image --image-size=1G gnu/system/install.scm
+guix system disk-image gnu/system/install.scm
@end example
Have a look at @file{gnu/system/install.scm} in the source tree,
@@ 16187,8 16186,9 @@ size of the image.
@item vm-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.
+in @var{file} that stands alone. By default, @command{guix system}
+estimates the size of the image needed to store the system, but you can
+use the @option{--image-size} option to specify a value.
When using @code{vm-image}, the returned image is in qcow2 format, which
the QEMU emulator can efficiently use. @xref{Running GuixSD in a VM},
@@ 16251,6 16251,10 @@ of the given @var{size}. @var{size} may be a number of bytes, or it may
include a unit as a suffix (@pxref{Block size, size specifications,,
coreutils, GNU Coreutils}).
+When this option is omitted, @command{guix system} computes an estimate
+of the image size as a function of the size of the system declared in
+@var{file}.
+
@item --root=@var{file}
@itemx -r @var{file}
Make @var{file} a symlink to the result, and register it as a garbage
M gnu/build/vm.scm => gnu/build/vm.scm +7 -0
@@ 46,6 46,7 @@
partition-flags
partition-initializer
+ estimated-partition-size
root-partition-initializer
initialize-partition-table
initialize-hard-disk))
@@ 150,6 151,12 @@ the #:references-graphs parameter of 'derivation'."
(flags partition-flags (default '()))
(initializer partition-initializer (default (const #t))))
+(define (estimated-partition-size graphs)
+ "Return the estimated size of a partition that can store the store items
+given by GRAPHS, a list of file names produced by #:references-graphs."
+ ;; Simply add a 20% overhead.
+ (round (* 1.2 (closure-size graphs))))
+
(define (fold2 proc seed1 seed2 lst) ;TODO: factorize
"Like `fold', but with a single list and two seeds."
(let loop ((result1 seed1)
M gnu/system/vm.scm => gnu/system/vm.scm +27 -17
@@ 1,5 1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@@ 108,8 108,7 @@
(references-graphs #f)
(memory-size 256)
(disk-image-format "qcow2")
- (disk-image-size
- (* 100 (expt 2 20))))
+ (disk-image-size 'guess))
"Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a
derivation). In the virtual machine, EXP has access to all its inputs from the
store; it should put its output files in the `/xchg' directory, which is
@@ 118,7 117,8 @@ runs with MEMORY-SIZE MiB of memory.
When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of type
DISK-IMAGE-FORMAT (e.g., 'qcow2' or 'raw'), of DISK-IMAGE-SIZE bytes and
-return it.
+return it. When DISK-IMAGE-SIZE is 'guess, estimate the image size based
+based on the size of the closure of REFERENCES-GRAPHS.
When REFERENCES-GRAPHS is true, it must be a list of file name/store path
pairs, as for `derivation'. The files containing the reference graphs are
@@ 143,14 143,18 @@ made available under the /xchg CIFS share."
(use-modules (guix build utils)
(gnu build vm))
- (let ((inputs '#$(list qemu coreutils))
- (linux (string-append #$linux "/"
- #$(system-linux-image-file-name)))
- (initrd (string-append #$initrd "/initrd"))
- (loader #$loader)
- (graphs '#$(match references-graphs
- (((graph-files . _) ...) graph-files)
- (_ #f))))
+ (let* ((inputs '#$(list qemu coreutils))
+ (linux (string-append #$linux "/"
+ #$(system-linux-image-file-name)))
+ (initrd (string-append #$initrd "/initrd"))
+ (loader #$loader)
+ (graphs '#$(match references-graphs
+ (((graph-files . _) ...) graph-files)
+ (_ #f)))
+ (size #$(if (eq? 'guess disk-image-size)
+ #~(+ (* 70 (expt 2 20)) ;ESP
+ (estimated-partition-size graphs))
+ disk-image-size)))
(set-path-environment-variable "PATH" '("bin") inputs)
@@ 160,7 164,7 @@ made available under the /xchg CIFS share."
#:memory-size #$memory-size
#:make-disk-image? #$make-disk-image?
#:disk-image-format #$disk-image-format
- #:disk-image-size #$disk-image-size
+ #:disk-image-size size
#:references-graphs graphs)))))
(gexp->derivation name builder
@@ 174,7 178,7 @@ made available under the /xchg CIFS share."
(name "qemu-image")
(system (%current-system))
(qemu qemu-minimal)
- (disk-image-size (* 100 (expt 2 20)))
+ (disk-image-size 'guess)
(disk-image-format "qcow2")
(file-system-type "ext4")
file-system-label
@@ 201,7 205,8 @@ the image."
(guix build utils)))
#~(begin
(use-modules (gnu build vm)
- (guix build utils))
+ (guix build utils)
+ (srfi srfi-26))
(let ((inputs
'#$(append (list qemu parted e2fsprogs dosfstools)
@@ 227,9 232,14 @@ the image."
#:copy-closures? #$copy-inputs?
#:register-closures? #$register-closures?
#:system-directory #$os-drv))
+ (root-size #$(if (eq? 'guess disk-image-size)
+ #~(estimated-partition-size
+ (map (cut string-append "/xchg/" <>)
+ graphs))
+ (- disk-image-size
+ (* 50 (expt 2 20)))))
(partitions (list (partition
- (size #$(- disk-image-size
- (* 50 (expt 2 20))))
+ (size root-size)
(label #$file-system-label)
(file-system #$file-system-type)
(flags '(boot))
M guix/build/store-copy.scm => guix/build/store-copy.scm +34 -1
@@ 1,5 1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ 20,7 20,9 @@
#:use-module (guix build utils)
#:use-module (srfi srfi-1)
#:use-module (ice-9 rdelim)
+ #:use-module (ice-9 ftw)
#:export (read-reference-graph
+ closure-size
populate-store))
;;; Commentary:
@@ 46,6 48,37 @@ The data at PORT is the format produced by #:references-graphs."
(loop (read-line port)
result)))))
+(define (file-size file)
+ "Return the size of bytes of FILE, entering it if FILE is a directory."
+ (file-system-fold (const #t)
+ (lambda (file stat result) ;leaf
+ (+ (stat:size stat) result))
+ (lambda (directory stat result) ;down
+ (+ (stat:size stat) result))
+ (lambda (directory stat result) ;up
+ result)
+ (lambda (file stat result) ;skip
+ result)
+ (lambda (file stat errno result)
+ (format (current-error-port)
+ "file-size: ~a: ~a~%" file
+ (strerror errno))
+ result)
+ 0
+ file
+ lstat))
+
+(define (closure-size reference-graphs)
+ "Return an estimate of the size of the closure described by
+REFERENCE-GRAPHS, a list of reference-graph files."
+ (define (graph-from-file file)
+ (call-with-input-file file read-reference-graph))
+
+ (define items
+ (delete-duplicates (append-map graph-from-file reference-graphs)))
+
+ (reduce + 0 (map file-size items)))
+
(define* (populate-store reference-graphs target)
"Populate the store under directory TARGET with the items specified in
REFERENCE-GRAPHS, a list of reference-graph files."
M guix/scripts/system.scm => guix/scripts/system.scm +1 -1
@@ 854,7 854,7 @@ Some ACTIONS support additional ARGS.\n"))
(build-hook? . #t)
(max-silent-time . 3600)
(verbosity . 0)
- (image-size . ,(* 900 (expt 2 20)))
+ (image-size . guess)
(install-bootloader? . #t)))