Merge branch 'master' into core-updates

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))