aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-06-30 11:41:57 +0200
committerLudovic Courtès <ludo@gnu.org>2017-06-30 11:41:57 +0200
commite0556f76954cc56b257dad33aaa94588e87695dc (patch)
tree6d6d6f4d6682256a40de4abd031175fb7440918d /gnu
parent1abc08a8f48f121cfa5a77394aa71a0441b4eb44 (diff)
parent87941d1df473511f0f75737e81a51a106132c9de (diff)
downloadguix-e0556f76954cc56b257dad33aaa94588e87695dc.tar
guix-e0556f76954cc56b257dad33aaa94588e87695dc.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu')
-rw-r--r--gnu/build/vm.scm41
-rw-r--r--gnu/packages/linux.scm16
-rw-r--r--gnu/system.scm2
-rw-r--r--gnu/system/vm.scm44
4 files changed, 60 insertions, 43 deletions
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 57619764ce..8f7fc3c9c4 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/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>
@@ -27,6 +27,7 @@
#:use-module (gnu build linux-boot)
#:use-module (gnu build install)
#:use-module (guix records)
+ #:use-module ((guix combinators) #:select (fold2))
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
@@ -46,6 +47,7 @@
partition-flags
partition-initializer
+ estimated-partition-size
root-partition-initializer
initialize-partition-table
initialize-hard-disk))
@@ -71,19 +73,23 @@
output
(qemu (qemu-command)) (memory-size 512)
linux initrd
- make-disk-image? (disk-image-size 100)
+ make-disk-image?
+ (disk-image-size (* 100 (expt 2 20)))
(disk-image-format "qcow2")
(references-graphs '()))
"Run BUILDER, a Scheme file, into a VM running LINUX with INITRD, and copy
the result to OUTPUT.
When MAKE-DISK-IMAGE? is true, OUTPUT will contain a VM image of
-DISK-IMAGE-SIZE MiB resulting from the execution of BUILDER, which may access
-it via /dev/hda.
+DISK-IMAGE-SIZE bytes resulting from the execution of BUILDER, which may
+access it via /dev/hda.
REFERENCES-GRAPHS can specify a list of reference-graph files as produced by
the #:references-graphs parameter of 'derivation'."
(when make-disk-image?
+ (format #t "creating ~a image of ~,2f MiB...~%"
+ disk-image-format (/ disk-image-size (expt 2 20)))
+ (force-output)
(unless (zero? (system* "qemu-img" "create" "-f" disk-image-format
output
(number->string disk-image-size)))
@@ -146,17 +152,11 @@ the #:references-graphs parameter of 'derivation'."
(flags partition-flags (default '()))
(initializer partition-initializer (default (const #t))))
-(define (fold2 proc seed1 seed2 lst) ;TODO: factorize
- "Like `fold', but with a single list and two seeds."
- (let loop ((result1 seed1)
- (result2 seed2)
- (lst lst))
- (if (null? lst)
- (values result1 result2)
- (call-with-values
- (lambda () (proc (car lst) result1 result2))
- (lambda (result1 result2)
- (loop result1 result2 (cdr lst)))))))
+(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* (initialize-partition-table device partitions
#:key
@@ -192,8 +192,15 @@ actual /dev name based on DEVICE."
(cons (partition-options head offset index)
result))))))
- (format #t "creating partition table with ~a partitions...\n"
- (length partitions))
+ (format #t "creating partition table with ~a partitions (~a)...\n"
+ (length partitions)
+ (string-join (map (compose (cut string-append <> " MiB")
+ number->string
+ (lambda (size)
+ (round (/ size (expt 2. 20))))
+ partition-size)
+ partitions)
+ ", "))
(unless (zero? (apply system* "parted" "--script"
device "mklabel" label-type
(options partitions offset)))
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 9031d727ef..28a060fe54 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -363,8 +363,8 @@ It has been modified to remove all non-free binary blobs.")
(define %intel-compatible-systems '("x86_64-linux" "i686-linux"))
-(define %linux-libre-version "4.11.7")
-(define %linux-libre-hash "0kliwdz4qqjz13pywhavxg19cy1mf6d1f52f6kgapc331309vad9")
+(define %linux-libre-version "4.11.8")
+(define %linux-libre-hash "1z35h6xr8gdzq31xv3dpdz6ddz4q3183fwvkmx8qd7h9bhy13aw6")
(define-public linux-libre
(make-linux-libre %linux-libre-version
@@ -373,20 +373,20 @@ It has been modified to remove all non-free binary blobs.")
#:configuration-file kernel-config))
(define-public linux-libre-4.9
- (make-linux-libre "4.9.34"
- "00jm3338kvhfj850lg3mvk680fmfw34mvwaq41lvxgb1z2xqqlz1"
+ (make-linux-libre "4.9.35"
+ "0fs90jgb01jybkclngg5asvbs1y70f2abs395qcb3lxpx7zxhy1h"
%intel-compatible-systems
#:configuration-file kernel-config))
(define-public linux-libre-4.4
- (make-linux-libre "4.4.74"
- "04x2ki3s2jsjkkk6bld0rd9rsk8qqvrfsxawxzfa26mkq6pv87r2"
+ (make-linux-libre "4.4.75"
+ "1h687flrdzlcd1ms5n2khm0mxybr8bj2jfnnm7qvy6ha2vsngb5b"
%intel-compatible-systems
#:configuration-file kernel-config))
(define-public linux-libre-4.1
- (make-linux-libre "4.1.41"
- "02mqfl899jxvrmxlh8lvcgvm3klwd8wbsdz4rr2gpchbggj4vgb2"
+ (make-linux-libre "4.1.42"
+ "1g5jhn7cm6ixn7w8ciqm6qgxv7k1jg50v6k05hsvzvrqfpaxqlbz"
%intel-compatible-systems
#:configuration-file kernel-config))
diff --git a/gnu/system.scm b/gnu/system.scm
index 31f9320023..39f8465bcb 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -490,7 +490,7 @@ explicitly appear in OS."
lsof ;for Guix's 'list-runtime-roots'
pciutils usbutils
util-linux inetutils isc-dhcp
- shadow ;for 'passwd'
+ (@ (gnu packages admin) shadow) ;for 'passwd'
;; wireless-tools is deprecated in favor of iw, but it's still what
;; many people are familiar with, so keep it around.
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 392737d078..7ac8696158 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
@@ -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))