mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
vm: Estimate the disk size by default.
* gnu/build/vm.scm (estimated-partition-size): New procedure. * gnu/system/vm.scm (expression->derivation-in-linux-vm): Change #:disk-image-size default to 'guess. [builder]: When DISK-IMAGE-SIZE is 'guess, use 'estimated-partition-size' and compute and estimate of the image size. (qemu-image): Likewise. * guix/build/store-copy.scm (file-size, closure-size): New procedures. * guix/scripts/system.scm (%default-options): Change 'image-size' to 'guess. * doc/guix.texi (Building the Installation Image): Remove '--image-size' flag from example. (Invoking guix system): Document the image size estimate.
This commit is contained in:
parent
a2cf57e79e
commit
a8ac4f081a
5 changed files with 77 additions and 23 deletions
|
@ -7877,9 +7877,8 @@ that.
|
||||||
The installation image described above was built using the @command{guix
|
The installation image described above was built using the @command{guix
|
||||||
system} command, specifically:
|
system} command, specifically:
|
||||||
|
|
||||||
@c FIXME: 1G is too much; see <http://bugs.gnu.org/23077>.
|
|
||||||
@example
|
@example
|
||||||
guix system disk-image --image-size=1G gnu/system/install.scm
|
guix system disk-image gnu/system/install.scm
|
||||||
@end example
|
@end example
|
||||||
|
|
||||||
Have a look at @file{gnu/system/install.scm} in the source tree,
|
Have a look at @file{gnu/system/install.scm} in the source tree,
|
||||||
|
@ -16187,8 +16186,9 @@ size of the image.
|
||||||
@item vm-image
|
@item vm-image
|
||||||
@itemx disk-image
|
@itemx disk-image
|
||||||
Return a virtual machine or disk image of the operating system declared
|
Return a virtual machine or disk image of the operating system declared
|
||||||
in @var{file} that stands alone. Use the @option{--image-size} option
|
in @var{file} that stands alone. By default, @command{guix system}
|
||||||
to specify the size of the image.
|
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
|
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},
|
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,,
|
include a unit as a suffix (@pxref{Block size, size specifications,,
|
||||||
coreutils, GNU Coreutils}).
|
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}
|
@item --root=@var{file}
|
||||||
@itemx -r @var{file}
|
@itemx -r @var{file}
|
||||||
Make @var{file} a symlink to the result, and register it as a garbage
|
Make @var{file} a symlink to the result, and register it as a garbage
|
||||||
|
|
|
@ -46,6 +46,7 @@ (define-module (gnu build vm)
|
||||||
partition-flags
|
partition-flags
|
||||||
partition-initializer
|
partition-initializer
|
||||||
|
|
||||||
|
estimated-partition-size
|
||||||
root-partition-initializer
|
root-partition-initializer
|
||||||
initialize-partition-table
|
initialize-partition-table
|
||||||
initialize-hard-disk))
|
initialize-hard-disk))
|
||||||
|
@ -150,6 +151,12 @@ (define-record-type* <partition> partition make-partition
|
||||||
(flags partition-flags (default '()))
|
(flags partition-flags (default '()))
|
||||||
(initializer partition-initializer (default (const #t))))
|
(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
|
(define (fold2 proc seed1 seed2 lst) ;TODO: factorize
|
||||||
"Like `fold', but with a single list and two seeds."
|
"Like `fold', but with a single list and two seeds."
|
||||||
(let loop ((result1 seed1)
|
(let loop ((result1 seed1)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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 Christopher Allan Webber <cwebber@dustycloud.org>
|
||||||
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
|
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
|
||||||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||||
|
@ -108,8 +108,7 @@ (define* (expression->derivation-in-linux-vm name exp
|
||||||
(references-graphs #f)
|
(references-graphs #f)
|
||||||
(memory-size 256)
|
(memory-size 256)
|
||||||
(disk-image-format "qcow2")
|
(disk-image-format "qcow2")
|
||||||
(disk-image-size
|
(disk-image-size 'guess))
|
||||||
(* 100 (expt 2 20))))
|
|
||||||
"Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a
|
"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
|
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
|
store; it should put its output files in the `/xchg' directory, which is
|
||||||
|
@ -118,7 +117,8 @@ (define* (expression->derivation-in-linux-vm name exp
|
||||||
|
|
||||||
When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of type
|
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
|
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
|
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
|
pairs, as for `derivation'. The files containing the reference graphs are
|
||||||
|
@ -143,14 +143,18 @@ (define builder
|
||||||
(use-modules (guix build utils)
|
(use-modules (guix build utils)
|
||||||
(gnu build vm))
|
(gnu build vm))
|
||||||
|
|
||||||
(let ((inputs '#$(list qemu coreutils))
|
(let* ((inputs '#$(list qemu coreutils))
|
||||||
(linux (string-append #$linux "/"
|
(linux (string-append #$linux "/"
|
||||||
#$(system-linux-image-file-name)))
|
#$(system-linux-image-file-name)))
|
||||||
(initrd (string-append #$initrd "/initrd"))
|
(initrd (string-append #$initrd "/initrd"))
|
||||||
(loader #$loader)
|
(loader #$loader)
|
||||||
(graphs '#$(match references-graphs
|
(graphs '#$(match references-graphs
|
||||||
(((graph-files . _) ...) graph-files)
|
(((graph-files . _) ...) graph-files)
|
||||||
(_ #f))))
|
(_ #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)
|
(set-path-environment-variable "PATH" '("bin") inputs)
|
||||||
|
|
||||||
|
@ -160,7 +164,7 @@ (define builder
|
||||||
#:memory-size #$memory-size
|
#:memory-size #$memory-size
|
||||||
#:make-disk-image? #$make-disk-image?
|
#:make-disk-image? #$make-disk-image?
|
||||||
#:disk-image-format #$disk-image-format
|
#:disk-image-format #$disk-image-format
|
||||||
#:disk-image-size #$disk-image-size
|
#:disk-image-size size
|
||||||
#:references-graphs graphs)))))
|
#:references-graphs graphs)))))
|
||||||
|
|
||||||
(gexp->derivation name builder
|
(gexp->derivation name builder
|
||||||
|
@ -174,7 +178,7 @@ (define* (qemu-image #:key
|
||||||
(name "qemu-image")
|
(name "qemu-image")
|
||||||
(system (%current-system))
|
(system (%current-system))
|
||||||
(qemu qemu-minimal)
|
(qemu qemu-minimal)
|
||||||
(disk-image-size (* 100 (expt 2 20)))
|
(disk-image-size 'guess)
|
||||||
(disk-image-format "qcow2")
|
(disk-image-format "qcow2")
|
||||||
(file-system-type "ext4")
|
(file-system-type "ext4")
|
||||||
file-system-label
|
file-system-label
|
||||||
|
@ -201,7 +205,8 @@ (define* (qemu-image #:key
|
||||||
(guix build utils)))
|
(guix build utils)))
|
||||||
#~(begin
|
#~(begin
|
||||||
(use-modules (gnu build vm)
|
(use-modules (gnu build vm)
|
||||||
(guix build utils))
|
(guix build utils)
|
||||||
|
(srfi srfi-26))
|
||||||
|
|
||||||
(let ((inputs
|
(let ((inputs
|
||||||
'#$(append (list qemu parted e2fsprogs dosfstools)
|
'#$(append (list qemu parted e2fsprogs dosfstools)
|
||||||
|
@ -227,9 +232,14 @@ (define* (qemu-image #:key
|
||||||
#:copy-closures? #$copy-inputs?
|
#:copy-closures? #$copy-inputs?
|
||||||
#:register-closures? #$register-closures?
|
#:register-closures? #$register-closures?
|
||||||
#:system-directory #$os-drv))
|
#: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
|
(partitions (list (partition
|
||||||
(size #$(- disk-image-size
|
(size root-size)
|
||||||
(* 50 (expt 2 20))))
|
|
||||||
(label #$file-system-label)
|
(label #$file-system-label)
|
||||||
(file-system #$file-system-type)
|
(file-system #$file-system-type)
|
||||||
(flags '(boot))
|
(flags '(boot))
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -20,7 +20,9 @@ (define-module (guix build store-copy)
|
||||||
#:use-module (guix build utils)
|
#:use-module (guix build utils)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (ice-9 rdelim)
|
#:use-module (ice-9 rdelim)
|
||||||
|
#:use-module (ice-9 ftw)
|
||||||
#:export (read-reference-graph
|
#:export (read-reference-graph
|
||||||
|
closure-size
|
||||||
populate-store))
|
populate-store))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
@ -46,6 +48,37 @@ (define (read-reference-graph port)
|
||||||
(loop (read-line port)
|
(loop (read-line port)
|
||||||
result)))))
|
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)
|
(define* (populate-store reference-graphs target)
|
||||||
"Populate the store under directory TARGET with the items specified in
|
"Populate the store under directory TARGET with the items specified in
|
||||||
REFERENCE-GRAPHS, a list of reference-graph files."
|
REFERENCE-GRAPHS, a list of reference-graph files."
|
||||||
|
|
|
@ -854,7 +854,7 @@ (define %default-options
|
||||||
(build-hook? . #t)
|
(build-hook? . #t)
|
||||||
(max-silent-time . 3600)
|
(max-silent-time . 3600)
|
||||||
(verbosity . 0)
|
(verbosity . 0)
|
||||||
(image-size . ,(* 900 (expt 2 20)))
|
(image-size . guess)
|
||||||
(install-bootloader? . #t)))
|
(install-bootloader? . #t)))
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue