Merge branch 'master' into core-updates

21 files changed, 1081 insertions, 229 deletions

diff --git a/gnu/packages/algebra.scm b/gnu/packages/algebra.scm
index 3a447d8591..6c294c814a 100644
--- a/gnu/packages/algebra.scm
+++ b/gnu/packages/algebra.scm
@@ -78,43 +78,17 @@ solve the shortest vector problem.")
    (license lgpl2.1+)
    (home-page "http://perso.ens-lyon.fr/damien.stehle/fplll/")))
 
-(define-public gsl
-  (package
-    (name "gsl")
-    (version "1.15")
-    (source
-     (origin
-      (method url-fetch)
-      (uri (string-append "mirror://gnu/gsl/gsl-"
-                          version ".tar.gz"))
-      (sha256
-       (base32
-        "18qf6jzz1r3mzb5qynywv4xx3z9g61hgkbpkdrhbgqh2g7jhgfc5"))))
-    (build-system gnu-build-system)
-    (home-page "http://www.gnu.org/software/gsl/")
-    (synopsis "Numerical library for C and C++")
-    (description
-     "The GNU Scientific Library (GSL) is a numerical library for C
-and C++ programmers.  It is free software under the GNU General
-Public License.
-
-The library provides a wide range of mathematical routines such
-as random number generators, special functions and least-squares
-fitting.  There are over 1000 functions in total with an
-extensive test suite.")
-    (license gpl3+)))
-
 (define-public pari-gp
   (package
    (name "pari-gp")
-   (version "2.5.3")
+   (version "2.5.4")
    (source (origin
             (method url-fetch)
             (uri (string-append
                   "http://pari.math.u-bordeaux.fr/pub/pari/unix/pari-"
                   version ".tar.gz"))
             (sha256 (base32
-                     "0zsjccnnv00kwj2gk3ww2v530kjin1rgj8p8hbl4pwcnwc7m68gl"))))
+                     "0gpsj5n8d1gyl7nq2y915sscs3d334ryrv8qgjdwqf3cr95f2dwz"))))
    (build-system gnu-build-system)
    (inputs `(("gmp" ,gmp)
              ("perl" ,perl)
diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index 86723a9591..a1d4c7fc67 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -184,9 +184,10 @@ cd $out
 $out/bin/guile --version~%"
                                                           mkdir xz guile tar)
                                                   (list mkdir xz guile tar))))
-                         (derivation store name system
-                                     bash `(,builder) '()
-                                     `((,bash) (,builder)))))))))
+                         (derivation store name
+                                     bash `(,builder)
+                                     #:system system
+                                     #:inputs `((,bash) (,builder)))))))))
    (package
      (name "guile-bootstrap")
      (version "2.0")
diff --git a/gnu/packages/compression.scm b/gnu/packages/compression.scm
index 9528cf3199..83ef7a86d8 100644
--- a/gnu/packages/compression.scm
+++ b/gnu/packages/compression.scm
@@ -189,6 +189,7 @@ than gzip and 15 % smaller output than bzip2.")
        (base32
         "0wryshs446s7cclrbjykyj766znhcpnr7s3cxy33ybfn6vwfcygz"))))
     (build-system gnu-build-system)
+    (arguments '(#:configure-flags '("--enable-shared")))
     (home-page "http://www.oberhumer.com/opensource/lzo")
     (synopsis
      "A data compresion library suitable for real-time data de-/compression")
diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm
index 15031179ff..fee834f9f9 100644
--- a/gnu/packages/glib.scm
+++ b/gnu/packages/glib.scm
@@ -185,3 +185,62 @@ The intltool collection can be used to do these things:
     Merge back the translations from .po files into .xml, .desktop and
     oaf files. This merge step will happen at build resp. installation time.")
     (license license:gpl2+)))
+
+(define-public itstool
+  (package
+    (name "itstool")
+    (version "1.2.0")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "http://files.itstool.org/itstool/itstool-"
+                                 version ".tar.bz2"))
+             (sha256
+              (base32
+               "1akq75aflihm3y7js8biy7b5mw2g11vl8yq90gydnwlwp0zxdzj6"))))
+    (build-system gnu-build-system)
+    (home-page "http://www.itstool.org")
+    (synopsis "Tool to translate XML documents with PO files")
+    (description
+     "ITS Tool allows you to translate your XML documents with PO files, using
+rules from the W3C Internationalization Tag Set (ITS) to determine what to
+translate and how to separate it into PO file messages.
+
+PO files are the standard translation format for GNU and other Unix-like
+systems.  They present translatable information as discrete messages, allowing
+each message to be translated independently.  In contrast to whole-page
+translation, translating with a message-based format like PO means you can
+easily track changes to the source document down to the paragraph.  When new
+strings are added or existing strings are modified, you only need to update the
+corresponding messages.
+
+ITS Tool is designed to make XML documents translatable through PO files by
+applying standard ITS rules, as well as extension rules specific to ITS Tool.
+ITS also provides an industry standard way for authors to override translation
+information in their documents, such as whether a particular element should be
+translated.")
+    (license license:gpl3+)))
+
+(define-public dbus-glib
+  (package
+    (name "dbus-glib")
+    (version "0.100.2")
+    (source (origin
+             (method url-fetch)
+             (uri
+              (string-append "http://dbus.freedesktop.org/releases/dbus-glib/dbus-glib-"
+                             version ".tar.gz"))
+             (sha256
+              (base32
+               "1ibav91yg70f2l3l18cr0hf4mna1h9d4mrg0c60w4l8zjbd45fx5"))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("dbus" ,dbus)
+       ("expat" ,expat)
+       ("glib" ,glib)
+       ("pkg-config" ,pkg-config)))
+    (home-page "http://dbus.freedesktop.org/doc/dbus-glib/")
+    (synopsis "D-Bus GLib bindings")
+    (description
+     "GLib bindings for D-Bus.  The package is obsolete and superseded
+by GDBus included in Glib.")
+    (license license:gpl2)))                     ; or Academic Free License 2.1
diff --git a/gnu/packages/grub.scm b/gnu/packages/grub.scm
index 8c981bf88d..71c4fad781 100644
--- a/gnu/packages/grub.scm
+++ b/gnu/packages/grub.scm
@@ -19,6 +19,9 @@
 (define-module (gnu packages grub)
   #:use-module (guix download)
   #:use-module (guix packages)
+  #:use-module (guix records)
+  #:use-module (guix store)
+  #:use-module (guix derivations)
   #:use-module ((guix licenses) #:select (gpl3+))
   #:use-module (guix build-system gnu)
   #:use-module (gnu packages)
@@ -30,7 +33,11 @@
   #:use-module (gnu packages qemu)
   #:use-module (gnu packages ncurses)
   #:use-module (gnu packages cdrom)
-  #:use-module (srfi srfi-1))
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:export (menu-entry
+            menu-entry?
+            grub-configuration-file))
 
 (define qemu-for-tests
   ;; Newer QEMU versions, such as 1.5.1, no longer support the 'shutdown'
@@ -110,3 +117,56 @@ computer starts.  It is responsible for loading and transferring control to
 the operating system kernel software (such as the Hurd or the Linux).  The
 kernel, in turn, initializes the rest of the operating system (e.g., GNU).")
     (license gpl3+)))
+
+
+;;;
+;;; Configuration.
+;;;
+
+(define-record-type* <menu-entry>
+  menu-entry make-menu-entry
+  menu-entry?
+  (label           menu-entry-label)
+  (linux           menu-entry-linux)
+  (linux-arguments menu-entry-linux-arguments
+                   (default '()))
+  (initrd          menu-entry-initrd))
+
+(define* (grub-configuration-file store entries
+                                  #:key (default-entry 1) (timeout 5)
+                                  (system (%current-system)))
+  "Return the GRUB configuration file in STORE for ENTRIES, a list of
+<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT."
+  (define prologue
+    (format #f "
+set default=~a
+set timeout=~a
+search.file ~a~%"
+            default-entry timeout
+            (any (match-lambda
+                  (($ <menu-entry> _ linux)
+                   (let* ((drv (package-derivation store linux system))
+                          (out (derivation-path->output-path drv)))
+                     (string-append out "/bzImage"))))
+                 entries)))
+
+  (define entry->text
+    (match-lambda
+     (($ <menu-entry> label linux arguments initrd)
+      (let ((linux-drv  (package-derivation store linux system))
+            (initrd-drv (package-derivation store initrd system)))
+        ;; XXX: Assume that INITRD is a directory containing an 'initrd' file.
+        (format #f "menuentry ~s {
+  linux ~a/bzImage ~a
+  initrd ~a/initrd
+}~%"
+                label
+                (derivation-path->output-path linux-drv)
+                (string-join arguments)
+                (derivation-path->output-path initrd-drv))))))
+
+  (add-text-to-store store "grub.cfg"
+                     (string-append prologue
+                                    (string-concatenate
+                                     (map entry->text entries)))
+                     '()))
diff --git a/gnu/packages/gtk.scm b/gnu/packages/gtk.scm
index 102cb8ea2f..742cbf172e 100644
--- a/gnu/packages/gtk.scm
+++ b/gnu/packages/gtk.scm
@@ -60,14 +60,14 @@ tools have full access to view and control running applications.")
 (define-public cairo
   (package
    (name "cairo")
-   (version "1.12.14")
+   (version "1.12.16")
    (source (origin
             (method url-fetch)
             (uri (string-append "http://cairographics.org/releases/cairo-"
                                 version ".tar.xz"))
             (sha256
              (base32
-              "04xcykglff58ygs0dkrmmnqljmpjwp2qgwcz8sijqkdpz7ix3l4n"))))
+              "0inqwsylqkrzcjivdirkjx5nhdgxbdc62fq284c3xppinfg9a195"))))
    (build-system gnu-build-system)
    (propagated-inputs
     `(("fontconfig" ,fontconfig)
@@ -110,14 +110,14 @@ affine transformation (scale, rotation, shear, etc.)")
 (define-public harfbuzz
   (package
    (name "harfbuzz")
-   (version "0.9.19")
+   (version "0.9.20")
    (source (origin
             (method url-fetch)
             (uri (string-append "http://www.freedesktop.org/software/harfbuzz/release/harfbuzz-"
                                 version ".tar.bz2"))
             (sha256
              (base32
-              "0d9g02m5n28lp1bfkl8wxblfmfd43yr1ny68x2fsvxj71l30znnj"))))
+              "0rxwvd8j4vcadlhx4a7la33clzggxziblx1k43ccbw5w7yh4yf43"))))
    (build-system gnu-build-system)
    (inputs
     `(("cairo" ,cairo)
diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index 7d97adbe99..c580e0c324 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -298,4 +298,38 @@ flexibility in specifying when jobs should be run.  Mcron was written by Dale
 Mellor.")
     (license gpl3+)))
 
+(define-public guile-lib
+  (package
+    (name "guile-lib")
+    (version "0.2.2")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "mirror://savannah/guile-lib/guile-lib-"
+                                 version ".tar.gz"))
+             (sha256
+              (base32
+               "1f9n2b5b5r75lzjinyk6zp6g20g60msa0jpfrk5hhg4j8cy0ih4b"))))
+    (build-system gnu-build-system)
+    (arguments
+     '(#:phases (alist-cons-before
+                 'configure 'patch-module-dir
+                 (lambda _
+                   (substitute* "src/Makefile.in"
+                     (("^moddir[[:blank:]]*=[[:blank:]]*([[:graph:]]+)" _ rhs)
+                      (string-append "moddir = " rhs "/2.0\n"))))
+                 %standard-phases)))
+    (inputs `(("guile" ,guile-2.0)))
+    (home-page "http://www.nongnu.org/guile-lib/")
+    (synopsis "Collection of useful Guile Scheme modules")
+    (description
+     "guile-lib is intended as an accumulation place for pure-scheme Guile
+modules, allowing for people to cooperate integrating their generic Guile
+modules into a coherent library.  Think \"a down-scaled, limited-scope CPAN
+for Guile\".")
+
+    ;; The whole is under GPLv3+, but some modules are under laxer
+    ;; distribution terms such as LGPL and public domain.  See `COPYING' for
+    ;; details.
+    (license gpl3+)))
+
 ;;; guile.scm ends here
diff --git a/gnu/packages/imagemagick.scm b/gnu/packages/imagemagick.scm
index e408b13fa3..98cd51fee3 100644
--- a/gnu/packages/imagemagick.scm
+++ b/gnu/packages/imagemagick.scm
@@ -37,14 +37,14 @@
 (define-public imagemagick
   (package
     (name "imagemagick")
-    (version "6.8.6-0")
+    (version "6.8.6-9")
     (source (origin
              (method url-fetch)
              (uri (string-append "mirror://imagemagick/ImageMagick-"
                                  version ".tar.xz"))
              (sha256
               (base32
-               "1qmwpnq2mcxjnp0rjyb2g7v87lhmll19imx3iys6kplh8amrmqnv"))))
+               "1bpj8676mph5cvyjsdgf27i6yg2iw9iskk5c69mvpxkyawgjw1vg"))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases (alist-cons-before
diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm
index 348e411d07..6dd2a10e53 100644
--- a/gnu/packages/linux-initrd.scm
+++ b/gnu/packages/linux-initrd.scm
@@ -19,10 +19,14 @@
 (define-module (gnu packages linux-initrd)
   #:use-module (guix utils)
   #:use-module (guix licenses)
+  #:use-module (guix build-system)
+  #:use-module ((guix derivations)
+                #:select (imported-modules compiled-modules %guile-for-build))
   #:use-module (gnu packages)
   #:use-module (gnu packages cpio)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages linux)
+  #:use-module (gnu packages guile)
   #:use-module ((gnu packages make-bootstrap)
                 #:select (%guile-static-stripped))
   #:use-module (guix packages)
@@ -38,6 +42,49 @@
 ;;; Code:
 
 
+(define-syntax-rule (raw-build-system (store system name inputs) body ...)
+  "Lift BODY to a package build system."
+  ;; TODO: Generalize.
+  (build-system
+   (name "raw")
+   (description "Raw build system")
+   (build (lambda* (store name source inputs #:key system #:allow-other-keys)
+            (parameterize ((%guile-for-build (package-derivation store
+                                                                 guile-2.0)))
+              body ...)))))
+
+(define (module-package modules)
+  "Return a package that contains all of MODULES, a list of Guile module
+names."
+  (package
+    (name "guile-modules")
+    (version "0")
+    (source #f)
+    (build-system (raw-build-system (store system name inputs)
+                    (imported-modules store modules
+                                      #:name name
+                                      #:system system)))
+    (synopsis "Set of Guile modules")
+    (description synopsis)
+    (license gpl3+)
+    (home-page "http://www.gnu.org/software/guix/")))
+
+(define (compiled-module-package modules)
+  "Return a package that contains the .go files corresponding to MODULES, a
+list of Guile module names."
+  (package
+    (name "guile-compiled-modules")
+    (version "0")
+    (source #f)
+    (build-system (raw-build-system (store system name inputs)
+                    (compiled-modules store modules
+                                      #:name name
+                                      #:system system)))
+    (synopsis "Set of compiled Guile modules")
+    (description synopsis)
+    (license gpl3+)
+    (home-page "http://www.gnu.org/software/guix/")))
+
 (define* (expression->initrd exp
                              #:key
                              (guile %guile-static-stripped)
@@ -45,12 +92,13 @@
                              (gzip gzip)
                              (name "guile-initrd")
                              (system (%current-system))
+                             (modules '())
                              (linux #f)
                              (linux-modules '()))
   "Return a package that contains a Linux initrd (a gzipped cpio archive)
 containing GUILE and that evaluates EXP upon booting.  LINUX-MODULES is a list
-of `.ko' file names to be copied from LINUX into the initrd."
-  ;; TODO: Add a `modules' parameter.
+of `.ko' file names to be copied from LINUX into the initrd.  MODULES is a
+list of Guile module names to be embedded in the initrd."
 
   ;; General Linux overview in `Documentation/early-userspace/README' and
   ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
@@ -67,12 +115,22 @@ of `.ko' file names to be copied from LINUX into the initrd."
                     (rnrs bytevectors)
                     ((system foreign) #:select (sizeof)))
 
-       (let ((guile (assoc-ref %build-inputs "guile"))
-             (cpio  (string-append (assoc-ref %build-inputs "cpio")
-                                   "/bin/cpio"))
-             (gzip  (string-append (assoc-ref %build-inputs "gzip")
-                                   "/bin/gzip"))
-             (out   (assoc-ref %outputs "out")))
+       (let ((guile   (assoc-ref %build-inputs "guile"))
+             (cpio    (string-append (assoc-ref %build-inputs "cpio")
+                                     "/bin/cpio"))
+             (gzip    (string-append (assoc-ref %build-inputs "gzip")
+                                     "/bin/gzip"))
+             (modules (assoc-ref %build-inputs "modules"))
+             (gos     (assoc-ref %build-inputs "modules/compiled"))
+             (scm-dir (string-append "share/guile/" (effective-version)))
+             (go-dir  (format #f ".cache/guile/ccache/~a-~a-~a-~a"
+                              (effective-version)
+                              (if (eq? (native-endianness) (endianness little))
+                                  "LE"
+                                  "BE")
+                              (sizeof '*)
+                              (effective-version)))
+             (out     (assoc-ref %outputs "out")))
          (mkdir out)
          (mkdir "contents")
          (with-directory-excursion "contents"
@@ -84,19 +142,23 @@ of `.ko' file names to be copied from LINUX into the initrd."
            (chmod "init" #o555)
            (chmod "bin/guile" #o555)
 
+           ;; Copy Guile modules.
+           (chmod scm-dir #o777)
+           (copy-recursively modules scm-dir
+                             #:follow-symlinks? #t)
+           (copy-recursively gos (string-append "lib/guile/"
+                                                (effective-version) "/ccache")
+                             #:follow-symlinks? #t)
+
            ;; Compile `init'.
-           (let ((go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a"
-                                 (effective-version)
-                                 (if (eq? (native-endianness) (endianness little))
-                                     "LE"
-                                     "BE")
-                                 (sizeof '*)
-                                 (effective-version))))
-             (mkdir-p go-dir)
-             (compile-file "init"
-                           #:opts %auto-compilation-options
-                           #:output-file (string-append go-dir "/init.go")))
+           (mkdir-p go-dir)
+           (set! %load-path (cons modules %load-path))
+           (set! %load-compiled-path (cons gos %load-compiled-path))
+           (compile-file "init"
+                         #:opts %auto-compilation-options
+                         #:output-file (string-append go-dir "/init.go"))
 
+           ;; Copy Linux modules.
            (let* ((linux      (assoc-ref %build-inputs "linux"))
                   (module-dir (and linux
                                    (string-append linux "/lib/modules"))))
@@ -161,6 +223,8 @@ of `.ko' file names to be copied from LINUX into the initrd."
       (inputs `(("guile" ,guile)
                 ("cpio" ,cpio)
                 ("gzip" ,gzip)
+                ("modules" ,(module-package modules))
+                ("modules/compiled" ,(compiled-module-package modules))
                 ,@(if linux
                       `(("linux" ,linux))
                       '())))
@@ -174,26 +238,18 @@ the Linux kernel.")
 (define-public qemu-initrd
   (expression->initrd
    '(begin
-      (use-modules (rnrs io ports)
-                   (srfi srfi-1)
+      (use-modules (srfi srfi-1)
                    (srfi srfi-26)
                    (ice-9 match)
-                   ((system foreign) #:select (string->pointer))
-                   ((system base compile) #:select (compile-file)))
+                   ((system base compile) #:select (compile-file))
+                   (guix build utils)
+                   (guix build linux-initrd))
 
-      (display "Welcome, this is GNU/Guile!\n")
+      (display "Welcome, this is GNU's early boot Guile.\n")
       (display "Use '--repl' for an initrd REPL.\n\n")
 
-      (mkdir "/proc")
-      (mount "none" "/proc" "proc")
-
-      (mkdir "/sys")
-      (mount "none" "/sys" "sysfs")
-
-      (let* ((command (string-trim-both
-                       (call-with-input-file "/proc/cmdline"
-                         get-string-all)))
-             (args    (string-split command char-set:blank))
+      (mount-essential-file-systems)
+      (let* ((args    (linux-command-line))
              (option  (lambda (opt)
                         (let ((opt (string-append opt "=")))
                           (and=> (find (cut string-prefix? opt <>)
@@ -206,34 +262,16 @@ the Linux kernel.")
         (when (member "--repl" args)
           ((@ (system repl repl) start-repl)))
 
-        (let ((slurp (lambda (module)
-                       (call-with-input-file
-                           (string-append "/modules/" module)
-                         get-bytevector-all))))
-          (display "loading CIFS and companion modules...\n")
-          (for-each (compose load-linux-module slurp)
-                    (list "md4.ko" "ecb.ko" "cifs.ko")))
-
-        ;; See net/slirp.c for default QEMU networking values.
-        (display "configuring network...\n")
-        (let* ((sock    (socket AF_INET SOCK_STREAM 0))
-               (address (make-socket-address AF_INET
-                                             (inet-pton AF_INET
-                                                        "10.0.2.10")
-                                             0))
-               (flags   (network-interface-flags sock "eth0")))
-          (set-network-interface-address sock "eth0" address)
-          (set-network-interface-flags sock "eth0"
-                                       (logior flags IFF_UP))
-          (if (logand (network-interface-flags sock "eth0") IFF_UP)
-              (display "network interface is up\n")
-              (display "network interface is DOWN\n"))
-
-          (mkdir "/etc")
-          (call-with-output-file "/etc/resolv.conf"
-            (lambda (p)
-              (display "nameserver 10.0.2.3\n" p)))
-          (sleep 1))
+        (display "loading CIFS and companion modules...\n")
+        (for-each (compose load-linux-module*
+                           (cut string-append "/modules/" <>))
+                  (list "md4.ko" "ecb.ko" "cifs.ko"))
+
+        (unless (configure-qemu-networking)
+          (display "network interface is DOWN\n"))
+
+        ;; Make /dev nodes.
+        (make-essential-device-nodes)
 
         ;; Prepare the real root file system under /root.
         (unless (file-exists? "/root")
@@ -241,27 +279,31 @@ the Linux kernel.")
         (if root
             (mount root "/root" "ext3")
             (mount "none" "/root" "tmpfs"))
-        (mkdir "/root/proc")
-        (mount "none" "/root/proc" "proc")
-        (mkdir "/root/sys")
-        (mount "none" "/root/sys" "sysfs")
+        (mount-essential-file-systems #:root "/root")
+
         (mkdir "/root/xchg")
-        (mkdir "/root/nix")
-        (mkdir "/root/nix/store")
+        (mkdir-p "/root/nix/store")
 
-        (mkdir "/root/dev")
-        (let ((makedev (lambda (major minor)
-                         (+ (* major 256) minor))))
-          (mknod "/root/dev/null" 'char-special #o666 (makedev 1 3))
-          (mknod "/root/dev/zero" 'char-special #o666 (makedev 1 5)))
+        (unless (file-exists? "/root/dev")
+          (mkdir "/root/dev")
+          (make-essential-device-nodes #:root "/root"))
 
         ;; Mount the host's store and exchange directory.
-        (display "mounting QEMU's SMB shares...\n")
-        (let ((server "10.0.2.4"))
-          (mount (string-append "//" server "/store") "/root/nix/store" "cifs" 0
-                 (string->pointer "guest,sec=none"))
-          (mount (string-append "//" server "/xchg") "/root/xchg" "cifs" 0
-                 (string->pointer "guest,sec=none")))
+        (mount-qemu-smb-share "/store" "/root/nix/store")
+        (mount-qemu-smb-share "/xchg" "/root/xchg")
+
+        ;; Copy the directories that contain .scm and .go files so that the
+        ;; child process in the chroot can load modules (we would bind-mount
+        ;; them but for some reason that fails with EINVAL -- XXX).
+        (mkdir "/root/share")
+        (mkdir "/root/lib")
+        (mount "none" "/root/share" "tmpfs")
+        (mount "none" "/root/lib" "tmpfs")
+        (copy-recursively "/share" "/root/share"
+                          #:log (%make-void-port "w"))
+        (copy-recursively "/lib" "/root/lib"
+                          #:log (%make-void-port "w"))
+
 
         (if to-load
             (begin
@@ -272,7 +314,10 @@ the Linux kernel.")
               (match (primitive-fork)
                 (0
                  (chroot "/root")
-                 (load-compiled "/loader.go"))
+                 (load-compiled "/loader.go")
+
+                 ;; TODO: Remove /lib, /share, and /loader.go.
+                 )
                 (pid
                  (format #t "boot file loaded under PID ~a~%" pid)
                  (let ((status (waitpid pid)))
@@ -282,7 +327,75 @@ the Linux kernel.")
               (display "entering a warm and cozy REPL\n")
               ((@ (system repl repl) start-repl))))))
    #:name "qemu-initrd"
+   #:modules '((guix build utils)
+               (guix build linux-initrd))
    #:linux linux-libre
    #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko")))
 
+(define-public gnu-system-initrd
+  ;; Initrd for the GNU system itself, with nothing QEMU-specific.
+  (expression->initrd
+   '(begin
+      (use-modules (srfi srfi-1)
+                   (srfi srfi-26)
+                   (ice-9 match)
+                   (guix build utils)
+                   (guix build linux-initrd))
+
+      (display "Welcome, this is GNU's early boot Guile.\n")
+      (display "Use '--repl' for an initrd REPL.\n\n")
+
+      (mount-essential-file-systems)
+      (let* ((args    (linux-command-line))
+             (option  (lambda (opt)
+                        (let ((opt (string-append opt "=")))
+                          (and=> (find (cut string-prefix? opt <>)
+                                       args)
+                                 (lambda (arg)
+                                   (substring arg (+ 1 (string-index arg #\=))))))))
+             (to-load (option "--load"))
+             (root    (option "--root")))
+
+        (when (member "--repl" args)
+          ((@ (system repl repl) start-repl)))
+
+        ;; Make /dev nodes.
+        (make-essential-device-nodes)
+
+        ;; Prepare the real root file system under /root.
+        (unless (file-exists? "/root")
+          (mkdir "/root"))
+        (if root
+            ;; Assume ROOT has a usable /dev tree.
+            (mount root "/root" "ext3")
+            (begin
+              (mount "none" "/root" "tmpfs")
+              (make-essential-device-nodes #:root "/root")))
+
+        (mount-essential-file-systems #:root "/root")
+
+        ;; XXX: We don't copy our fellow Guile modules to /root (see
+        ;; 'qemu-initrd'), so if TO-LOAD tries to load a module (which can
+        ;; happen if it throws, to display the exception!), then we're
+        ;; screwed.  Hopefully TO-LOAD is a simple expression that just does
+        ;; '(execlp ...)'.
+
+        (if to-load
+            (begin
+              (format #t "loading '~a'...\n" to-load)
+              (chroot "/root")
+              (primitive-load to-load)
+              (format (current-error-port)
+                      "boot program '~a' terminated, rebooting~%")
+              (sleep 2)
+              (reboot))
+            (begin
+              (display "no init file passed via '--exec'\n")
+              (display "entering a warm and cozy REPL\n")
+              ((@ (system repl repl) start-repl))))))
+   #:name "qemu-system-initrd"
+   #:modules '((guix build linux-initrd)
+               (guix build utils))
+   #:linux linux-libre))
+
 ;;; linux-initrd.scm ends here
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index e434de477e..b5ed92e198 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -29,6 +29,7 @@
   #:use-module (gnu packages bdb)
   #:use-module (gnu packages perl)
   #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages algebra)
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system gnu))
@@ -146,7 +147,7 @@
     (license gpl2+)))
 
 (define-public linux-libre
-  (let* ((version* "3.3.8")
+  (let* ((version* "3.11")
          (build-phase
           '(lambda* (#:key system #:allow-other-keys #:rest args)
              (let ((arch (car (string-split system #\-))))
@@ -192,9 +193,10 @@
              (uri (linux-libre-urls version))
              (sha256
               (base32
-               "0jkfh0z1s6izvdnc3njm39dhzp1cg8i06jv06izwqz9w9qsprvnl"))))
+               "1vlk04xkvyy1kc9zz556md173rn1qzlnvhz7c9sljv4bpk3mdspl"))))
     (build-system gnu-build-system)
     (native-inputs `(("perl" ,perl)
+                     ("bc" ,bc)
                      ("module-init-tools" ,module-init-tools)))
     (arguments
      `(#:modules ((guix build gnu-build-system)
diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm
index 6f33c07e58..ce270bd5c1 100644
--- a/gnu/packages/make-bootstrap.scm
+++ b/gnu/packages/make-bootstrap.scm
@@ -127,7 +127,10 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
                       ;; cross-compiling).
                       (inputs (match (assoc "perl" (package-inputs coreutils))
                                 (#f '())
-                                (x  (list x))))))
+                                (x  (list x))))
+
+                      ;; Remove the `debug' output.
+                      (outputs '("out"))))
         (bzip2 (package (inherit bzip2)
                  (arguments
                   (substitute-keyword-arguments (package-arguments bzip2)
diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm
index 7b900225b5..75354122b5 100644
--- a/gnu/packages/maths.scm
+++ b/gnu/packages/maths.scm
@@ -23,7 +23,6 @@
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
-  #:use-module (gnu packages algebra)
   #:use-module (gnu packages compression)
   #:use-module ((gnu packages gettext)
                 #:renamer (symbol-prefix-proc 'gnu:))
@@ -67,6 +66,45 @@ the standard data file.")
    (license license:gpl3+)
    (home-page "http://www.gnu.org/software/units/")))
 
+(define-public gsl
+  (package
+    (name "gsl")
+    (version "1.15")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "mirror://gnu/gsl/gsl-"
+                          version ".tar.gz"))
+      (sha256
+       (base32
+        "18qf6jzz1r3mzb5qynywv4xx3z9g61hgkbpkdrhbgqh2g7jhgfc5"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:phases
+        (alist-replace
+         'configure
+         (lambda* (#:key target system outputs #:allow-other-keys #:rest args)
+           (let ((configure (assoc-ref %standard-phases 'configure)))
+             ;; disable numerically unstable test on i686, see thread at
+             ;; http://lists.gnu.org/archive/html/bug-gsl/2011-11/msg00019.html
+             (if (string=? (or target system) "i686-linux")
+                 (substitute* "ode-initval2/Makefile.in"
+                   (("TESTS = \\$\\(check_PROGRAMS\\)") "TESTS =")))
+             (apply configure args)))
+         %standard-phases)))
+    (home-page "http://www.gnu.org/software/gsl/")
+    (synopsis "Numerical library for C and C++")
+    (description
+     "The GNU Scientific Library (GSL) is a numerical library for C
+and C++ programmers.  It is free software under the GNU General
+Public License.
+
+The library provides a wide range of mathematical routines such
+as random number generators, special functions and least-squares
+fitting.  There are over 1000 functions in total with an
+extensive test suite.")
+    (license license:gpl3+)))
+
 (define-public pspp
   (package
     (name "pspp")
diff --git a/gnu/packages/patches/hop-bigloo-4.0b.patch b/gnu/packages/patches/hop-bigloo-4.0b.patch
new file mode 100644
index 0000000000..312bfdd117
--- /dev/null
+++ b/gnu/packages/patches/hop-bigloo-4.0b.patch
@@ -0,0 +1,122 @@
+Bigloo 4.0b removes `xml-attribute-encode', which leads to a build failure
+in Hop.
+
+This patch allows Hop to be compiled with Bigloo 4.0b.
+
+
+changeset:   3327:3515f7f1aef2
+branch:      2.4.x
+user:        Manuel Serrano <Manuel.Serrano@inria.fr>
+date:        Wed Jul 31 12:41:10 2013 +0200
+summary:     Fix serialization bug
+
+diff -r 7244c4d30ad4 -r 3515f7f1aef2 runtime/js_comp.scm
+--- a/runtime/js_comp.scm	Fri Jul 19 08:28:13 2013 +0200
++++ b/runtime/js_comp.scm	Wed Jul 31 12:41:10 2013 +0200
+@@ -143,10 +143,17 @@
+       (display "{ " op)
+       (display-seq fields op
+ 	 (lambda (f op)
++	    (let ((iv (class-field-info f)))
+ 	    (display "'" op)
+ 	    (display (class-field-name f) op)
+ 	    (display "': " op)
+-	    (compile ((class-field-accessor f) obj) op)))
++	       (cond
++		  ((and (pair? iv) (memq :client iv))
++		   =>
++		   (lambda (x)
++		      (compile (when (pair? (cdr x)) (cadr x)) op)))
++		  (else 
++		   (compile ((class-field-accessor f) obj) op))))))
+       (display "}" op))
+    
+    (let ((klass (object-class obj)))
+diff -r 7244c4d30ad4 -r 3515f7f1aef2 runtime/xml.scm
+--- a/runtime/xml.scm	Fri Jul 19 08:28:13 2013 +0200
++++ b/runtime/xml.scm	Wed Jul 31 12:41:10 2013 +0200
+@@ -55,6 +55,7 @@
+ 	    (generic xml-write-attribute ::obj ::obj ::output-port ::xml-backend)
+ 	    (generic xml-write-expression ::obj ::output-port)
+ 	    (xml-write-attributes ::pair-nil ::output-port ::xml-backend)
++	    (xml-attribute-encode obj)
+ 
+ 	    (xml->string ::obj ::xml-backend)
+ 	    
+@@ -613,6 +614,52 @@
+ 	 (display ">" p))))
+ 
+ ;*---------------------------------------------------------------------*/
++;*    xml-attribute-encode ...                                         */
++;*---------------------------------------------------------------------*/
++(define (xml-attribute-encode obj)
++   (if (not (string? obj))
++       obj
++       (let ((ol (string-length obj)))
++	  (define (count str ol)
++	     (let loop ((i 0)
++			(j 0))
++		(if (=fx i ol)
++		    j
++		    (let ((c (string-ref str i)))
++		       ;; attribute values should escape &#...
++		       (if (or (char=? c #\') (char=? c #\&))
++			   (loop (+fx i 1) (+fx j 5))
++			   (loop (+fx i 1) (+fx j 1)))))))
++	  (define (encode str ol nl)
++	     (if (=fx nl ol)
++		 obj
++		 (let ((nstr (make-string nl)))
++		    (let loop ((i 0)
++			       (j 0))
++		       (if (=fx j nl)
++			   nstr
++			   (let ((c (string-ref str i)))
++			      (case c
++				 ((#\')
++				  (string-set! nstr j #\&)
++				  (string-set! nstr (+fx j 1) #\#)
++				  (string-set! nstr (+fx j 2) #\3)
++				  (string-set! nstr (+fx j 3) #\9)
++				  (string-set! nstr (+fx j 4) #\;)
++				  (loop (+fx i 1) (+fx j 5)))
++				 ((#\&)
++				  (string-set! nstr j #\&)
++				  (string-set! nstr (+fx j 1) #\#)
++				  (string-set! nstr (+fx j 2) #\3)
++				  (string-set! nstr (+fx j 3) #\8)
++				  (string-set! nstr (+fx j 4) #\;)
++				  (loop (+fx i 1) (+fx j 5)))
++				 (else
++				  (string-set! nstr j c)
++				  (loop (+fx i 1) (+fx j 1))))))))))
++	  (encode obj ol (count obj ol)))))
++
++;*---------------------------------------------------------------------*/
+ ;*    xml-write-attributes ...                                         */
+ ;*---------------------------------------------------------------------*/
+ (define (xml-write-attributes attr p backend)
+diff -r 7244c4d30ad4 -r 3515f7f1aef2 share/hop-serialize.js
+--- a/share/hop-serialize.js	Fri Jul 19 08:28:13 2013 +0200
++++ b/share/hop-serialize.js	Wed Jul 31 12:41:10 2013 +0200
+@@ -942,7 +942,7 @@
+ 	 case 0x2e /* . */: return null;
+ 	 case 0x3c /* < */: return read_cnst();
+          case 0x22 /* " */: return read_string( s );
+-         case 0x25 /* " */: return decodeURIComponent( read_string( s ) );
++         case 0x25 /* % */: return decodeURIComponent( read_string( s ) );
+          case 0x55 /* U */: return read_string( s );
+ 	 case 0x5b /* [ */: return read_vector( read_size( s ) );
+ 	 case 0x28 /* ( */: return read_list( read_size( s ) );
+diff -r 7244c4d30ad4 -r 3515f7f1aef2 src/main.scm
+--- a/src/main.scm	Fri Jul 19 08:28:13 2013 +0200
++++ b/src/main.scm	Wed Jul 31 12:41:10 2013 +0200
+@@ -59,8 +59,6 @@
+    (for-each register-srfi! (cons 'hop-server (hop-srfis)))
+    ;; set the library load path
+    (bigloo-library-path-set! (hop-library-path))
+-   ;; define the Hop macros
+-   (hop-install-expanders!)
+    ;; setup the hop readers
+    (bigloo-load-reader-set! hop-read)
+    (bigloo-load-module-set!
diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm
index c9893d9385..493068adde 100644
--- a/gnu/packages/python.scm
+++ b/gnu/packages/python.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,7 +34,7 @@
 (define-public python
   (package
     (name "python")
-    (version "2.7.4")
+    (version "2.7.5")
     (source
      (origin
       (method url-fetch)
@@ -41,10 +42,52 @@
                           version "/Python-" version ".tar.xz"))
       (sha256
        (base32
-        "0bdn4dylm92n2dsvqvjfyask9jbz88aan5hi4lgkawkxs2v6wqmn"))))
+        "1c8xan2dlsqfq8q82r3mhl72v3knq3qyn71fjq89xikx2smlqg7k"))))
     (build-system gnu-build-system)
     (arguments
-     `(#:tests? #f ; XXX: some tests fail
+     `(#:tests? #f
+;;       258 tests OK.
+;;       103 tests failed:
+;;          test_bz2 test_distutils test_file test_file2k test_popen2
+;;          test_shutil test_signal test_site test_slice test_smtplib
+;;          test_smtpnet test_socket test_socketserver test_softspace
+;;          test_sort test_sqlite test_ssl test_startfile test_str
+;;          test_strftime test_string test_stringprep test_strop test_strptime
+;;          test_strtod test_struct test_structmembers test_structseq
+;;          test_subprocess test_sunaudiodev test_sundry test_symtable
+;;          test_syntax test_sys test_sys_setprofile test_sys_settrace
+;;          test_sysconfig test_tarfile test_tcl test_telnetlib test_tempfile
+;;          test_textwrap test_thread test_threaded_import
+;;          test_threadedtempfile test_threading test_threading_local
+;;          test_threadsignals test_time test_timeout test_tk test_tokenize
+;;          test_tools test_trace test_traceback test_transformer
+;;          test_ttk_guionly test_ttk_textonly test_tuple test_typechecks
+;;          test_ucn test_unary test_undocumented_details test_unicode
+;;          test_unicode_file test_unicodedata test_univnewlines
+;;          test_univnewlines2k test_unpack test_urllib test_urllib2
+;;          test_urllib2_localnet test_urllib2net test_urllibnet test_urlparse
+;;          test_userdict test_userlist test_userstring test_uu test_uuid
+;;          test_wait3 test_wait4 test_warnings test_wave test_weakref
+;;          test_weakset test_whichdb test_winreg test_winsound test_with
+;;          test_wsgiref test_xdrlib test_xml_etree test_xml_etree_c
+;;          test_xmllib test_xmlrpc test_xpickle test_xrange test_zipfile
+;;          test_zipfile64 test_zipimport test_zipimport_support test_zlib
+;;       31 tests skipped:
+;;          test_aepack test_al test_applesingle test_ascii_formatd test_bsddb
+;;          test_bsddb185 test_bsddb3 test_cd test_cl test_codecmaps_cn
+;;          test_codecmaps_hk test_codecmaps_jp test_codecmaps_kr
+;;          test_codecmaps_tw test_ctypes test_curses test_dl test_gdb test_gl
+;;          test_imageop test_imgfile test_ioctl test_kqueue
+;;          test_linuxaudiodev test_macos test_macostools test_msilib
+;;          test_multiprocessing test_ossaudiodev test_pep277
+;;          test_scriptpackages
+;;       7 skips unexpected on linux2:
+;;          test_ascii_formatd test_bsddb test_bsddb3 test_ctypes test_gdb
+;;          test_ioctl test_multiprocessing
+;;    One of the typical errors:
+;;    test_unicode
+;;    test test_unicode crashed -- <type 'exceptions.OSError'>: [Errno 2] No such file or directory
+       #:test-target "test"
        #:configure-flags
         (let ((bz2 (assoc-ref %build-inputs "bzip2"))
               (gdbm (assoc-ref %build-inputs "gdbm"))
@@ -108,6 +151,22 @@ packages; exception-based error handling; and very high level dynamic
 data types.")
     (license psfl)))
 
+(define-public python-3
+  (package (inherit python)
+    (version "3.3.2")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "http://www.python.org/ftp/python/"
+                          version "/Python-" version ".tar.xz"))
+      (sha256
+       (base32
+        "0hsbwqjnhr85a2w252c8d3yj8d9i5sy8s6a6cfk6zqqhp3234nvl"))))
+    (native-search-paths
+     (list (search-path-specification
+            (variable "PYTHONPATH")
+            (directories '("lib/python3.3/site-packages")))))))
+
 (define-public pytz
   (package
     (name "pytz")
diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm
index eb339d7236..43853fa08c 100644
--- a/gnu/packages/scheme.scm
+++ b/gnu/packages/scheme.scm
@@ -251,6 +251,7 @@ between Scheme and C# programs.")
                                         "\\.so$")))))
          %standard-phases))
        #:tests? #f                                ; no test suite
+       #:patches (list (assoc-ref %build-inputs "patch/bigloo-4.0b"))
        #:modules ((guix build gnu-build-system)
                   (guix build utils)
                   (ice-9 popen)
@@ -259,7 +260,10 @@ between Scheme and C# programs.")
                   (srfi srfi-1))))
     (inputs `(("bigloo" ,bigloo)
               ("which" ,which)
-              ("patchelf" ,patchelf)))
+              ("patchelf" ,patchelf)
+
+              ("patch/bigloo-4.0b"
+               ,(search-patch "hop-bigloo-4.0b.patch"))))
     (home-page "http://hop.inria.fr/")
     (synopsis "A multi-tier programming language for the Web 2.0")
     (description
diff --git a/gnu/packages/system.scm b/gnu/packages/system.scm
index e326e498c5..7c733f9575 100644
--- a/gnu/packages/system.scm
+++ b/gnu/packages/system.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,11 +21,55 @@
   #:use-module (guix licenses)
   #:use-module (guix packages)
   #:use-module (guix download)
+  #:use-module (guix build-system cmake)
   #:use-module (guix build-system gnu)
   #:use-module (gnu packages)
   #:use-module (gnu packages ncurses)
   #:use-module (gnu packages linux))
 
+(define-public dfc
+  (package
+   (name "dfc")
+   (version "3.0.3")
+   (source
+    (origin
+     (method url-fetch)
+      (uri (string-append
+            "http://projects.gw-computing.net/attachments/download/78/dfc-"
+            version ".tar.gz"))
+      (sha256
+       (base32
+        "1b4hfqv23l87cb37fxwzfk2sgspkyxpr3ig2hsd23hr6mm982j7z"))))
+   (build-system cmake-build-system)
+   (arguments '(#:tests? #f)) ; There are no tests.
+   (home-page "http://projects.gw-computing.net/projects/dfc")
+   (synopsis "Display file system space usage using graphs and colors")
+   (description
+    "dfc (df color) is a modern version of df.  It uses colors, draws pretty
+graphs and can export its output to different formats.")
+   (license bsd-3)))
+
+(define-public htop
+  (package
+   (name "htop")
+   (version "1.0.2")
+   (source (origin
+            (method url-fetch)
+            (uri (string-append "mirror://sourceforge/htop/"
+                  version "/htop-" version ".tar.gz"))
+            (sha256
+             (base32
+              "18fqrhvnm7h4c3939av8lpiwrwxbyw6hcly0jvq0vkjf0ixnaq7f"))))
+   (build-system gnu-build-system)
+   (inputs
+    `(("ncurses" ,ncurses)))
+   (home-page "http://htop.sourceforge.net/")
+   (synopsis "Interactive process viewer")
+   (description
+    "This is htop, an interactive process viewer.  It is a text-mode
+application (for console or X terminals) and requires ncurses.")
+   (license gpl2)))
+
 (define-public pies
   (package
     (name "pies")
@@ -141,3 +186,53 @@ login, passwd, su, groupadd, and useradd.")
     ;; The `vipw' program is GPLv2+.
     ;; libmisc/salt.c is public domain.
     (license bsd-3)))
+
+(define-public mingetty
+  (package
+    (name "mingetty")
+    (version "1.08")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "mirror://sourceforge/mingetty/mingetty-"
+                                 version ".tar.gz"))
+             (sha256
+              (base32
+               "05yxrp44ky2kg6qknk1ih0kvwkgbn9fbz77r3vci7agslh5wjm8g"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:phases (alist-replace 'configure
+                               (lambda* (#:key inputs outputs
+                                         #:allow-other-keys)
+                                 (let* ((out    (assoc-ref outputs "out"))
+                                        (man8   (string-append
+                                                 out "/share/man/man8"))
+                                        (sbin   (string-append out "/sbin"))
+                                        (shadow (assoc-ref inputs "shadow"))
+                                        (login  (string-append shadow
+                                                               "/bin/login")))
+                                   (substitute* "Makefile"
+                                     (("^SBINDIR.*")
+                                      (string-append "SBINDIR = " out
+                                                     "/sbin\n"))
+                                     (("^MANDIR.*")
+                                      (string-append "MANDIR = " out
+                                                     "/share/man/man8\n")))
+
+                                   ;; Pick the right 'login' by default.
+                                   (substitute* "mingetty.c"
+                                     (("\"/bin/login\"")
+                                      (string-append "\"" login "\"")))
+
+                                   (mkdir-p sbin)
+                                   (mkdir-p man8)))
+                               %standard-phases)
+       #:tests? #f))                              ; no tests
+    (inputs `(("shadow" ,shadow)))
+
+    (home-page "http://sourceforge.net/projects/mingetty")
+    (synopsis "Getty for the text console")
+    (description
+     "Small console getty that is started on the Linux text console,
+asks for a login name and then transfers over to 'login'.  It is extended to
+allow automatic login and starting any app.")
+    (license gpl2+)))
diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm
index 5059dcd5e1..14404f0bfe 100644
--- a/gnu/packages/version-control.scm
+++ b/gnu/packages/version-control.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,7 +20,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages version-control)
-  #:use-module ((guix licenses) #:select (asl2.0 gpl1+ gpl2+ gpl3+))
+  #:use-module ((guix licenses) #:select (asl2.0 gpl1+ gpl2 gpl2+ gpl3+))
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
@@ -28,11 +29,14 @@
   #:use-module ((gnu packages gettext)
                 #:renamer (symbol-prefix-proc 'guix:))
   #:use-module (gnu packages apr)
+  #:use-module (gnu packages curl)
   #:use-module (gnu packages nano)
+  #:use-module (gnu packages openssl)
   #:use-module (gnu packages perl)
   #:use-module (gnu packages python)
   #:use-module (gnu packages sqlite)
   #:use-module (gnu packages system)
+  #:use-module (gnu packages xml)
   #:use-module (gnu packages emacs)
   #:use-module (gnu packages compression))
 
@@ -64,6 +68,48 @@ organize their workspace in whichever way they want.  It is possible to work
 from a command line or use a GUI application.")
     (license gpl2+)))
 
+(define-public git
+  (package
+   (name "git")
+   (version "1.8.4")
+   (source (origin
+            (method url-fetch)
+            (uri (string-append "http://git-core.googlecode.com/files/git-"
+                                version ".tar.gz"))
+            (sha256
+             (base32
+              "156bwqqgaw65rsvbb4wih5jfg94bxyf6p16mdwf0ky3f4ln55s2i"))))
+   (build-system gnu-build-system)
+   (inputs
+    `(("curl" ,curl)
+      ("expat" ,expat)
+      ("gettext" ,guix:gettext)
+      ("openssl" ,openssl)
+      ("perl" ,perl)
+      ("python" ,python) ; CAVEAT: incompatible with python-3 according to INSTALL
+      ("zlib" ,zlib)))
+   (arguments
+    `(#:make-flags `("V=1") ; more verbose compilation
+      #:test-target "test"
+      #:tests? #f ; FIXME: Many tests are failing
+      #:phases
+       (alist-replace
+        'configure
+        (lambda* (#:key #:allow-other-keys #:rest args)
+          (let ((configure (assoc-ref %standard-phases 'configure)))
+            (and (apply configure args)
+                 (substitute* "Makefile"
+                   (("/bin/sh") (which "sh"))
+                   (("/usr/bin/perl") (which "perl"))
+                   (("/usr/bin/python") (which "python"))))))
+         %standard-phases)))
+   (synopsis "Distributed version control system")
+   (description
+    "Git is a free distributed version control system designed to handle
+everything from small to very large projects with speed and efficiency.")
+   (license gpl2)
+   (home-page "http://git-scm.com/")))
+
 (define-public subversion
   (package
     (name "subversion")
diff --git a/gnu/packages/xml.scm b/gnu/packages/xml.scm
index 6edff473da..2f9d64b81a 100644
--- a/gnu/packages/xml.scm
+++ b/gnu/packages/xml.scm
@@ -28,7 +28,8 @@
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
-  #:use-module (guix build-system perl))
+  #:use-module (guix build-system perl)
+  #:use-module (gnu packages linux))
 
 (define-public expat
   (package
@@ -138,3 +139,27 @@ then passed on to the Expat object on each parse call.  They can also be given
 as extra arguments to the parse methods, in which case they override options
 given at XML::Parser creation time.")
     (home-page "http://search.cpan.org/~toddr/XML-Parser-2.41/Parser.pm")))
+
+(define-public xmlto
+  (package
+    (name "xmlto")
+    (version "0.0.25")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append
+            "https://fedorahosted.org/releases/x/m/xmlto/xmlto-"
+            version ".tar.bz2"))
+      (sha256
+       (base32
+        "0dp5nxq491gymq806za0dk4hngfmq65ysrqbn0ypajqbbl6vf71n"))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("util-linux" ,util-linux)))
+    (home-page "http://cyberelk.net/tim/software/xmlto/")
+    (synopsis "Front-end to an XSL toolchain")
+    (description
+     "Xmlto is a front-end to an XSL toolchain.  It chooses an appropriate
+stylesheet for the conversion you want and applies it using an external
+XSL-T processor.  It also performs any necessary post-processing.")
+    (license license:gpl2+)))
diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm
index 5f07401e98..98f104b0b6 100644
--- a/gnu/packages/xorg.scm
+++ b/gnu/packages/xorg.scm
@@ -100,7 +100,7 @@ rasterisation.")
 (define-public libdrm
   (package
     (name "libdrm")
-    (version "2.4.42")
+    (version "2.4.46")
     (source
       (origin
         (method url-fetch)
@@ -110,7 +110,7 @@ rasterisation.")
                ".tar.bz2"))
         (sha256
           (base32
-            "1qbnpi64hyqzd650hj6jki1d50pzypdhj3rw9m3whwbqly110rz0"))))
+            "1wah4qmrrcv0gnx65lhrlxb6gprxch92wy8lhxv6102fml6k5krk"))))
     (build-system gnu-build-system)
     (inputs
       `(("libpciaccess" ,libpciaccess)
@@ -4139,9 +4139,9 @@ tracking.")
 (define-public mesa
   (package
     (name "mesa")
-    ;; In newer versions (9.0.5 and 9.1 tested), "make" results in an
+    ;; In newer versions (9.0.5, 9.1 and 9.2 tested), "make" results in an
     ;; infinite configure loop, see
-    ;; https://bugs.freedesktop.org/show_bug.cgi?id=61527
+    ;; https://bugs.freedesktop.org/show_bug.cgi?id=58812
     (version "8.0.5")
     (source
       (origin
diff --git a/gnu/packages/yasm.scm b/gnu/packages/yasm.scm
new file mode 100644
index 0000000000..51cd3ed0a5
--- /dev/null
+++ b/gnu/packages/yasm.scm
@@ -0,0 +1,55 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages yasm)
+  #:use-module (gnu packages)
+  #:use-module ((guix licenses)
+                #:renamer (symbol-prefix-proc 'license:))
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages python)
+  #:use-module (gnu packages xml))
+
+(define-public yasm
+  (package
+    (name "yasm")
+    (version "1.2.0")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "http://www.tortall.net/projects/yasm/releases/yasm-"
+                          version ".tar.gz"))
+      (sha256
+       (base32
+        "0cfg7ji3ia2in628w42wrfvw2ixmmm4rghwmv2k202mraysgm3vn"))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("python" ,python)
+       ("xmlto" ,xmlto)))
+    (home-page "http://yasm.tortall.net/")
+    (synopsis "Rewrite of the NASM assembler")
+    (description
+     "Yasm is a complete rewrite of the NASM assembler.
+
+Yasm currently supports the x86 and AMD64 instruction sets, accepts NASM
+and GAS assembler syntaxes, outputs binary, ELF32, ELF64, 32 and 64-bit
+Mach-O, RDOFF2, COFF, Win32, and Win64 object formats, and generates source
+debugging information in STABS, DWARF 2, and CodeView 8 formats.")
+    (license (license:bsd-style "file://COPYING"
+                                "See COPYING in the distribution."))))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index bc5677963d..73543896ef 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -17,10 +17,15 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu system vm)
+  #:use-module (guix config)
   #:use-module (guix store)
   #:use-module (guix derivations)
   #:use-module (guix packages)
-  #:use-module ((gnu packages base) #:select (%final-inputs guile-final))
+  #:use-module ((gnu packages base) #:select (%final-inputs
+                                              guile-final
+                                              coreutils))
+  #:use-module (gnu packages guile)
+  #:use-module (gnu packages bash)
   #:use-module (gnu packages qemu)
   #:use-module (gnu packages parted)
   #:use-module (gnu packages grub)
@@ -28,6 +33,9 @@
   #:use-module (gnu packages linux-initrd)
   #:use-module ((gnu packages make-bootstrap)
                 #:select (%guile-static-stripped))
+  #:use-module ((gnu packages system)
+                #:select (mingetty))
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:export (expression->derivation-in-linux-vm
@@ -40,8 +48,10 @@
 ;;;
 ;;; Code:
 
-(define* (expression->derivation-in-linux-vm store name system exp inputs
+(define* (expression->derivation-in-linux-vm store name exp
                                              #:key
+                                             (system (%current-system))
+                                             (inputs '())
                                              (linux linux-libre)
                                              (initrd qemu-initrd)
                                              (qemu qemu/smb-shares)
@@ -51,6 +61,7 @@
                                               (%guile-for-build))
 
                                              (make-disk-image? #f)
+                                             (references-graphs #f)
                                              (disk-image-size
                                               (* 100 (expt 2 20))))
   "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD.  In the
@@ -59,13 +70,19 @@ its output files in the `/xchg' directory, which is copied to the derivation's
 output when the VM terminates.
 
 When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of
-DISK-IMAGE-SIZE bytes and return it."
+DISK-IMAGE-SIZE bytes and return it.
+
+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
+made available under the /xchg CIFS share."
   (define input-alist
     (map (match-lambda
-          ((input package)
+          ((input (? package? package))
            `(,input . ,(package-output store package "out" system)))
-          ((input package sub-drv)
-           `(,input . ,(package-output store package sub-drv system))))
+          ((input (? package? package) sub-drv)
+           `(,input . ,(package-output store package sub-drv system)))
+          ((input (and (? string?) (? store-path?) file))
+           `(,input . ,file)))
          inputs))
 
   (define exp*
@@ -75,8 +92,10 @@ DISK-IMAGE-SIZE bytes and return it."
 
   (define builder
     ;; Code that launches the VM that evaluates EXP.
-    `(begin
-       (use-modules (guix build utils))
+    `(let ()
+       (use-modules (guix build utils)
+                    (srfi srfi-1)
+                    (ice-9 rdelim))
 
        (let ((out     (assoc-ref %outputs "out"))
              (cu      (string-append (assoc-ref %build-inputs "coreutils")
@@ -102,6 +121,17 @@ DISK-IMAGE-SIZE bytes and return it."
               '(begin))
 
          (mkdir "xchg")
+
+         ;; Copy the reference-graph files under xchg/ so EXP can access it.
+         (begin
+           ,@(match references-graphs
+               (((graph-files . _) ...)
+                (map (lambda (file)
+                       `(copy-file ,file
+                                   ,(string-append "xchg/" file)))
+                     graph-files))
+               (#f '())))
+
          (and (zero?
                (system* qemu "-nographic" "-no-reboot"
                         "-net" "nic,model=e1000"
@@ -132,101 +162,168 @@ DISK-IMAGE-SIZE bytes and return it."
                                     ("coreutils" ,(->drv coreutils))
                                     ("builder" ,user-builder)
                                     ,@(map (match-lambda
-                                            ((name package sub-drv ...)
+                                            ((name (? package? package)
+                                                   sub-drv ...)
                                              `(,name ,(->drv package)
-                                                     ,@sub-drv)))
+                                                     ,@sub-drv))
+                                            ((name (? string? file))
+                                             `(,name ,file)))
                                            inputs))
                                   #:env-vars env-vars
-                                  #:modules `((guix build utils)
-                                              ,@modules)
-                                  #:guile-for-build guile-for-build)))
+                                  #:modules (delete-duplicates
+                                             `((guix build utils)
+                                               ,@modules))
+                                  #:guile-for-build guile-for-build
+                                  #:references-graphs references-graphs)))
 
 (define* (qemu-image store #:key
                      (name "qemu-image")
                      (system (%current-system))
                      (disk-image-size (* 100 (expt 2 20)))
-                     (linux linux-libre)
-                     (initrd qemu-initrd)
-                     (inputs '()))
-  "Return a bootable, stand-alone QEMU image."
+                     grub-configuration
+                     (populate #f)
+                     (inputs '())
+                     (inputs-to-copy '()))
+  "Return a bootable, stand-alone QEMU image.  The returned image is a full
+disk image, with a GRUB installation that uses GRUB-CONFIGURATION as its
+configuration file.
+
+INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied
+into the image being built.
+
+When POPULATE is true, it must be the store file name of a Guile script to run
+in the disk image partition once it has been populated with INPUTS-TO-COPY.
+It can be used to provide additional files, such as /etc files."
+  (define input->name+derivation
+    (match-lambda
+     ((name (? package? package))
+      `(,name . ,(derivation-path->output-path
+                  (package-derivation store package system))))
+     ((name (? package? package) sub-drv)
+      `(,name . ,(derivation-path->output-path
+                  (package-derivation store package system)
+                  sub-drv)))
+     ((input (and (? string?) (? store-path?) file))
+      `(,input . ,file))))
+
   (expression->derivation-in-linux-vm
-   store "qemu-image" system
-   `(let ((parted  (string-append (assoc-ref %build-inputs "parted")
-                                  "/sbin/parted"))
-          (mkfs    (string-append (assoc-ref %build-inputs "e2fsprogs")
-                                  "/sbin/mkfs.ext3"))
-          (grub    (string-append (assoc-ref %build-inputs "grub")
-                                  "/sbin/grub-install"))
-          (umount  (string-append (assoc-ref %build-inputs "util-linux")
-                                  "/bin/umount")) ; XXX: add to Guile
-          (initrd  (string-append (assoc-ref %build-inputs "initrd")
-                                  "/initrd"))
-          (linux   (string-append (assoc-ref %build-inputs "linux")
-                                  "/bzImage"))
-          (makedev (lambda (major minor)
-                     (+ (* major 256) minor))))
-
-      ;; GRUB is full of shell scripts.
-      (setenv "PATH"
-              (string-append (dirname grub) ":"
-                             (assoc-ref %build-inputs "coreutils") "/bin:"
-                             (assoc-ref %build-inputs "findutils") "/bin:"
-                             (assoc-ref %build-inputs "sed") "/bin:"
-                             (assoc-ref %build-inputs "grep") "/bin:"
-                             (assoc-ref %build-inputs "gawk") "/bin"))
-
-      (display "creating partition table...\n")
-      (mknod "/dev/vda" 'block-special #o644 (makedev 8 0))
-      (and (zero? (system* parted "/dev/vda" "mklabel" "msdos"
-                           "mkpart" "primary" "ext2" "1MiB"
-                           ,(format #f "~aB"
-                                    (- disk-image-size
-                                       (* 5 (expt 2 20))))))
-           (begin
-             (display "creating ext3 partition...\n")
-             (mknod "/dev/vda1" 'block-special #o644 (makedev 8 1))
-             (and (zero? (system* mkfs "-F" "/dev/vda1"))
-                  (begin
-                    (display "mounting partition...\n")
-                    (mkdir "/fs")
-                    (mount "/dev/vda1" "/fs" "ext3")
-                    (mkdir "/fs/boot")
-                    (mkdir "/fs/boot/grub")
-                    (copy-file linux "/fs/boot/bzImage")
-                    (copy-file initrd "/fs/boot/initrd")
-                    (call-with-output-file "/fs/boot/grub/grub.cfg"
-                      (lambda (p)
-                        (display "
-set default=1
-set timeout=5
-search.file /boot/bzImage
-
-menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
-  linux /boot/bzImage --repl
-  initrd /boot/initrd
-}" p)))
-                    (and (zero?
-                          (system* grub "--no-floppy"
-                                   "--boot-directory" "/fs/boot"
-                                   "/dev/vda"))
-                         (zero?
-                          (system* umount "/fs"))
-                         (reboot)))))))
-   `(("parted" ,parted)
-     ("grub" ,grub)
-     ("e2fsprogs" ,e2fsprogs)
-     ("linux" ,linux-libre)
-     ("initrd" ,qemu-initrd)
-
-     ;; For shell scripts.
-     ("sed" ,(car (assoc-ref %final-inputs "sed")))
-     ("grep" ,(car (assoc-ref %final-inputs "grep")))
-     ("coreutils" ,(car (assoc-ref %final-inputs "coreutils")))
-     ("findutils" ,(car (assoc-ref %final-inputs "findutils")))
-     ("gawk" ,(car (assoc-ref %final-inputs "gawk")))
-     ("util-linux" ,util-linux))
+   store "qemu-image"
+   `(let ()
+      (use-modules (ice-9 rdelim)
+                   (srfi srfi-1)
+                   (guix build utils)
+                   (guix build linux-initrd))
+
+      (let ((parted  (string-append (assoc-ref %build-inputs "parted")
+                                    "/sbin/parted"))
+            (mkfs    (string-append (assoc-ref %build-inputs "e2fsprogs")
+                                    "/sbin/mkfs.ext3"))
+            (grub    (string-append (assoc-ref %build-inputs "grub")
+                                    "/sbin/grub-install"))
+            (umount  (string-append (assoc-ref %build-inputs "util-linux")
+                                    "/bin/umount")) ; XXX: add to Guile
+            (grub.cfg (assoc-ref %build-inputs "grub.cfg")))
+
+        (define (read-reference-graph port)
+          ;; Return a list of store paths from the reference graph at PORT.
+          ;; The data at PORT is the format produced by #:references-graphs.
+          (let loop ((line   (read-line port))
+                     (result '()))
+            (cond ((eof-object? line)
+                   (delete-duplicates result))
+                  ((string-prefix? "/" line)
+                   (loop (read-line port)
+                         (cons line result)))
+                  (else
+                   (loop (read-line port)
+                         result)))))
+
+        (define (things-to-copy)
+          ;; Return the list of store files to copy to the image.
+          (define (graph-from-file file)
+            (call-with-input-file file
+              read-reference-graph))
+
+          ,(match inputs-to-copy
+             (((graph-files . _) ...)
+              `(let* ((graph-files ',(map (cut string-append "/xchg/" <>)
+                                          graph-files))
+                      (paths       (append-map graph-from-file graph-files)))
+                 (delete-duplicates paths)))
+             (#f ''())))
+
+        ;; GRUB is full of shell scripts.
+        (setenv "PATH"
+                (string-append (dirname grub) ":"
+                               (assoc-ref %build-inputs "coreutils") "/bin:"
+                               (assoc-ref %build-inputs "findutils") "/bin:"
+                               (assoc-ref %build-inputs "sed") "/bin:"
+                               (assoc-ref %build-inputs "grep") "/bin:"
+                               (assoc-ref %build-inputs "gawk") "/bin"))
+
+        (display "creating partition table...\n")
+        (and (zero? (system* parted "/dev/vda" "mklabel" "msdos"
+                             "mkpart" "primary" "ext2" "1MiB"
+                             ,(format #f "~aB"
+                                      (- disk-image-size
+                                         (* 5 (expt 2 20))))))
+             (begin
+               (display "creating ext3 partition...\n")
+               (and (zero? (system* mkfs "-F" "/dev/vda1"))
+                    (begin
+                      (display "mounting partition...\n")
+                      (mkdir "/fs")
+                      (mount "/dev/vda1" "/fs" "ext3")
+                      (mkdir-p "/fs/boot/grub")
+                      (symlink grub.cfg "/fs/boot/grub/grub.cfg")
+
+                      ;; Populate the image's store.
+                      (mkdir-p (string-append "/fs" ,%store-directory))
+                      (for-each (lambda (thing)
+                                  (copy-recursively thing
+                                                    (string-append "/fs"
+                                                                   thing)))
+                                (cons grub.cfg (things-to-copy)))
+
+                      ;; Populate /dev.
+                      (make-essential-device-nodes #:root "/fs")
+
+                      (and=> (assoc-ref %build-inputs "populate")
+                             (lambda (populate)
+                               (chdir "/fs")
+                               (primitive-load populate)
+                               (chdir "/")))
+
+                      (and (zero?
+                            (system* grub "--no-floppy"
+                                     "--boot-directory" "/fs/boot"
+                                     "/dev/vda"))
+                           (zero? (system* umount "/fs"))
+                           (reboot))))))))
+   #:system system
+   #:inputs `(("parted" ,parted)
+              ("grub" ,grub)
+              ("e2fsprogs" ,e2fsprogs)
+              ("grub.cfg" ,grub-configuration)
+
+              ;; For shell scripts.
+              ("sed" ,(car (assoc-ref %final-inputs "sed")))
+              ("grep" ,(car (assoc-ref %final-inputs "grep")))
+              ("coreutils" ,(car (assoc-ref %final-inputs "coreutils")))
+              ("findutils" ,(car (assoc-ref %final-inputs "findutils")))
+              ("gawk" ,(car (assoc-ref %final-inputs "gawk")))
+              ("util-linux" ,util-linux)
+
+              ,@(if populate
+                    `(("populate" ,populate))
+                    '())
+
+              ,@inputs-to-copy)
    #:make-disk-image? #t
-   #:disk-image-size disk-image-size))
+   #:disk-image-size disk-image-size
+   #:references-graphs (map input->name+derivation inputs-to-copy)
+   #:modules '((guix build utils)
+               (guix build linux-initrd))))
 
 
 ;;;
@@ -241,16 +338,32 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
       (lambda ()
         (parameterize ((%guile-for-build (package-derivation store guile-final)))
           (expression->derivation-in-linux-vm
-           store "vm-test" (%current-system)
+           store "vm-test"
            '(begin
               (display "hello from boot!\n")
               (call-with-output-file "/xchg/hello"
                 (lambda (p)
-                  (display "world" p))))
-           '())))
+                  (display "world" p)))))))
       (lambda ()
         (close-connection store)))))
 
+(define (/etc/shadow store accounts)
+  "Return a /etc/shadow file for ACCOUNTS."
+  (define contents
+    (let loop ((accounts accounts)
+               (result   '()))
+      (match accounts
+        (((name uid gid comment home-dir shell) rest ...)
+         (loop rest
+               (cons (string-append name "::" (number->string uid)
+                                    ":" (number->string gid)
+                                    comment ":" home-dir ":" shell)
+                     result)))
+        (()
+         (string-concatenate-reverse result)))))
+
+  (add-text-to-store store "shadow" contents '()))
+
 (define (example2)
   (let ((store #f))
     (dynamic-wind
@@ -258,7 +371,55 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
         (set! store (open-connection)))
       (lambda ()
         (parameterize ((%guile-for-build (package-derivation store guile-final)))
-          (qemu-image store #:disk-image-size (* 30 (expt 2 20)))))
+          (let* ((bash-drv  (package-derivation store bash))
+                 (bash-file (string-append (derivation-path->output-path bash-drv)
+                                           "/bin/bash"))
+                 (passwd    (/etc/shadow store
+                                         `(("root" 0 0 "System administrator" "/"
+                                            ,bash-file))))
+                 (populate
+                  (add-text-to-store store "populate-qemu-image"
+                                     (object->string
+                                      `(begin
+                                         (mkdir-p "etc")
+                                         (symlink ,(substring passwd 1)
+                                                  "etc/shadow")))
+                                     (list passwd)))
+                 (out   (derivation-path->output-path
+                         (package-derivation store mingetty)))
+                 (getty (string-append out "/sbin/mingetty"))
+                 (boot  (add-text-to-store store "boot"
+                                           (object->string
+                                            `(begin
+                                               ;; Become the session leader,
+                                               ;; so that mingetty can do
+                                               ;; 'TIOCSCTTY'.
+                                               (setsid)
+
+                                               ;; Directly into mingetty.
+                                               (execl ,getty "mingetty"
+                                                      "--noclear" "tty1")))
+                                           (list out)))
+                 (entries  (list (menu-entry
+                                  (label "Boot-to-Guile! (GNU System technology preview)")
+                                  (linux linux-libre)
+                                  (linux-arguments `("--root=/dev/vda1"
+                                                     ,(string-append "--load=" boot)))
+                                  (initrd gnu-system-initrd))))
+                 (grub.cfg (grub-configuration-file store entries)))
+           (qemu-image store
+                       #:grub-configuration grub.cfg
+                       #:populate populate
+                       #:disk-image-size (* 400 (expt 2 20))
+                       #:inputs-to-copy `(("boot" ,boot)
+                                          ("linux" ,linux-libre)
+                                          ("initrd" ,gnu-system-initrd)
+                                          ("coreutils" ,coreutils)
+                                          ("bash" ,bash)
+                                          ("guile" ,guile-2.0)
+                                          ("mingetty" ,mingetty)
+
+                                          ("shadow" ,passwd))))))
       (lambda ()
         (close-connection store)))))