From: ludo@gnu.org (Ludovic Courtès)
To: Leo Famulari <leo@famulari.name>
Cc: 27401@debbugs.gnu.org
Subject: [bug#27401] Guessing the disk image size in 'guix system'
Date: Mon, 26 Jun 2017 13:51:13 +0200 [thread overview]
Message-ID: <87vanj55n2.fsf_-_@gnu.org> (raw)
In-Reply-To: <20170623211328.GA31313@jasmine.lan> (Leo Famulari's message of "Fri, 23 Jun 2017 17:13:28 -0400")
[-- Attachment #1: Type: text/plain, Size: 614 bytes --]
Hello!
Leo Famulari <leo@famulari.name> skribis:
> On Tue, Jun 20, 2017 at 08:03:17PM +0200, Jan Nieuwenhuizen wrote:
[...]
>> > I didn't come up with a better solution for the problem of not knowing
>> > the storage size in advance. What do you think?
>>
>> Yes, I think you made the right choice.
>
> Okay. I'd like to clarify and say that I think we could do something
> more sophisticated, but I'm not sure what we would do :)
We can do “guix size $(guix system build foo.scm)” and add 10% or so to
that.
Maybe something like this mostly-untested patch would work?
Ludo’.
[-- Attachment #2: Type: text/x-patch, Size: 7861 bytes --]
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 392737d07..15cc0d993 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -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
@@ -138,19 +137,24 @@ made available under the /xchg CIFS share."
(define builder
;; Code that launches the VM that evaluates EXP.
(with-imported-modules (source-module-closure '((guix build utils)
+ (guix build store-copy)
(gnu build vm)))
#~(begin
(use-modules (guix build utils)
+ (guix build store-copy)
(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)
+ #~(round (* 1.1 (closure-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
@@ -198,10 +202,13 @@ the image."
(expression->derivation-in-linux-vm
name
(with-imported-modules (source-module-closure '((gnu build vm)
+ (guix build store-copy)
(guix build utils)))
#~(begin
(use-modules (gnu build vm)
- (guix build utils))
+ (guix build store-copy)
+ (guix build utils)
+ (srfi srfi-26))
(let ((inputs
'#$(append (list qemu parted e2fsprogs dosfstools)
@@ -227,9 +234,14 @@ the image."
#:copy-closures? #$copy-inputs?
#:register-closures? #$register-closures?
#:system-directory #$os-drv))
+ (root-size #$(if (eq? 'guess disk-image-size)
+ #~(closure-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))
diff --git a/guix/build/store-copy.scm b/guix/build/store-copy.scm
index a296bdf78..fe2eb6f69 100644
--- a/guix/build/store-copy.scm
+++ b/guix/build/store-copy.scm
@@ -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."
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 35675cc01..7e20b10da 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -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)))
\f
next prev parent reply other threads:[~2017-06-26 11:52 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-06-17 5:14 [bug#27401] [PATCH] doc: Suggest a QEMU image size large enough for the system examples Leo Famulari
2017-06-17 12:20 ` Marius Bakke
2017-06-19 17:55 ` Jan Nieuwenhuizen
2017-06-19 21:48 ` Leo Famulari
2017-06-20 18:03 ` Jan Nieuwenhuizen
2017-06-23 21:13 ` Leo Famulari
2017-06-26 11:51 ` Ludovic Courtès [this message]
2017-06-29 22:30 ` [bug#27401] Guessing the disk image size in 'guix system' Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87vanj55n2.fsf_-_@gnu.org \
--to=ludo@gnu.org \
--cc=27401@debbugs.gnu.org \
--cc=leo@famulari.name \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.