Merge branch 'master' into core-updates

Conflicts:
	gnu-system.am

17 files changed, 875 insertions, 270 deletions

diff --git a/guix/build/download.scm b/guix/build/download.scm
index ac2086d96e..f9715e10f7 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -201,6 +201,12 @@ which is not available during bootstrap."
         (string>? (micro-version) "7")
         (string>? (version) "2.0.7")))
 
+  (define headers
+    ;; Some web sites, such as http://dist.schmorp.de, would block you if
+    ;; there's no 'User-Agent' header, presumably on the assumption that
+    ;; you're a spammer.  So work around that.
+    '((User-Agent . "GNU Guile")))
+
   (let*-values (((connection)
                  (open-connection-for-uri uri))
                 ((resp bv-or-port)
@@ -210,11 +216,14 @@ which is not available during bootstrap."
                  ;; version.  So keep this compatibility hack for now.
                  (if post-2.0.7?
                      (http-get uri #:port connection #:decode-body? #f
-                               #:streaming? #t)
+                               #:streaming? #t
+                               #:headers headers)
                      (if (module-defined? (resolve-interface '(web client))
                                           'http-get*)
-                         (http-get* uri #:port connection #:decode-body? #f)
-                         (http-get uri #:port connection #:decode-body? #f))))
+                         (http-get* uri #:port connection #:decode-body? #f
+                                    #:headers headers)
+                         (http-get uri #:port connection #:decode-body? #f
+                                   #:extra-headers headers))))
                 ((code)
                  (response-code resp))
                 ((size)
diff --git a/guix/build/git.scm b/guix/build/git.scm
new file mode 100644
index 0000000000..4245594c38
--- /dev/null
+++ b/guix/build/git.scm
@@ -0,0 +1,45 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 (guix build git)
+  #:use-module (guix build utils)
+  #:export (git-fetch))
+
+;;; Commentary:
+;;;
+;;; This is the build-side support code of (guix git-download).  It allows a
+;;; Git repository to be cloned and checked out at a specific commit.
+;;;
+;;; Code:
+
+(define* (git-fetch url commit directory
+                    #:key (git-command "git"))
+  "Fetch COMMIT from URL into DIRECTORY.  COMMIT must be a valid Git commit
+identifier.  Return #t on success, #f otherwise."
+  (and (zero? (system* git-command "clone" url directory))
+       (with-directory-excursion directory
+         (system* git-command "tag" "-l")
+         (and (zero? (system* git-command "checkout" commit))
+              (begin
+                ;; The contents of '.git' vary as a function of the current
+                ;; status of the Git repo.  Since we want a fixed output, this
+                ;; directory needs to be taken out.
+                (delete-file-recursively ".git")
+                #t)))))
+
+;;; git.scm ends here
diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm
index ae18a16e11..80ce679496 100644
--- a/guix/build/linux-initrd.scm
+++ b/guix/build/linux-initrd.scm
@@ -19,14 +19,23 @@
 (define-module (guix build linux-initrd)
   #:use-module (rnrs io ports)
   #:use-module (system foreign)
+  #:autoload   (system repl repl) (start-repl)
+  #:autoload   (system base compile) (compile-file)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 ftw)
+  #:use-module (guix build utils)
   #:export (mount-essential-file-systems
             linux-command-line
             make-essential-device-nodes
             configure-qemu-networking
             mount-qemu-smb-share
+            mount-qemu-9p
             bind-mount
             load-linux-module*
-            device-number))
+            device-number
+            boot-system))
 
 ;;; Commentary:
 ;;;
@@ -74,10 +83,26 @@
   (unless (file-exists? (scope "dev"))
     (mkdir (scope "dev")))
 
-  ;; Make the device nodes for QEMU's hard disk and partitions.
-  (mknod (scope "dev/vda") 'block-special #o644 (device-number 8 0))
-  (mknod (scope "dev/vda1") 'block-special #o644 (device-number 8 1))
-  (mknod (scope "dev/vda2") 'block-special #o644 (device-number 8 2))
+  ;; Make the device nodes for SCSI disks.
+  (mknod (scope "dev/sda") 'block-special #o644 (device-number 8 0))
+  (mknod (scope "dev/sda1") 'block-special #o644 (device-number 8 1))
+  (mknod (scope "dev/sda2") 'block-special #o644 (device-number 8 2))
+
+  ;; The virtio (para-virtualized) block devices, as supported by QEMU/KVM.
+  (mknod (scope "dev/vda") 'block-special #o644 (device-number 252 0))
+  (mknod (scope "dev/vda1") 'block-special #o644 (device-number 252 1))
+  (mknod (scope "dev/vda2") 'block-special #o644 (device-number 252 2))
+
+  ;; Memory (used by Xorg's VESA driver.)
+  (mknod (scope "dev/mem") 'char-special #o640 (device-number 1 1))
+  (mknod (scope "dev/kmem") 'char-special #o640 (device-number 1 2))
+
+  ;; Inputs (used by Xorg.)
+  (unless (file-exists? (scope "dev/input"))
+    (mkdir (scope "dev/input")))
+  (mknod (scope "dev/input/mice") 'char-special #o640 (device-number 13 63))
+  (mknod (scope "dev/input/mouse0") 'char-special #o640 (device-number 13 32))
+  (mknod (scope "dev/input/event0") 'char-special #o640 (device-number 13 64))
 
   ;; TTYs.
   (mknod (scope "dev/tty") 'char-special #o600
@@ -133,6 +158,17 @@ Vanilla QEMU's `-smb' option just exports a /qemu share, whereas our
     (mount (string-append "//" server share) mount-point "cifs" 0
            (string->pointer "guest,sec=none"))))
 
+(define (mount-qemu-9p source mount-point)
+  "Mount QEMU's 9p file system from SOURCE at MOUNT-POINT.
+
+This uses the 'virtio' transport, which requires the various virtio Linux
+modules to be loaded."
+
+  (format #t "mounting QEMU's 9p share '~a'...\n" source)
+  (let ((server "10.0.2.4"))
+    (mount source mount-point "9p" 0
+           (string->pointer "trans=virtio"))))
+
 (define (bind-mount source target)
   "Bind-mount SOURCE at TARGET."
   (define MS_BIND 4096)                           ; from libc's <sys/mount.h>
@@ -151,4 +187,155 @@ Vanilla QEMU's `-smb' option just exports a /qemu share, whereas our
 the last argument of `mknod'."
   (+ (* major 256) minor))
 
+(define* (boot-system #:key
+                      (linux-modules '())
+                      qemu-guest-networking?
+                      guile-modules-in-chroot?
+                      volatile-root?
+                      (mounts '()))
+  "This procedure is meant to be called from an initrd.  Boot a system by
+first loading LINUX-MODULES, then setting up QEMU guest networking if
+QEMU-GUEST-NETWORKING? is true, mounting the file systems specified in MOUNTS,
+and finally booting into the new root if any.  The initrd supports kernel
+command-line options '--load', '--root', and '--repl'.
+
+MOUNTS must be a list of elements of the form:
+
+  (FILE-SYSTEM-TYPE SOURCE TARGET)
+
+When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in
+the new root.
+
+When VOLATILE-ROOT? is true, the root file system is writable but any changes
+to it are lost."
+  (define (resolve file)
+    ;; If FILE is a symlink to an absolute file name, resolve it as if we were
+    ;; under /root.
+    (let ((st (lstat file)))
+      (if (eq? 'symlink (stat:type st))
+          (let ((target (readlink file)))
+            (resolve (string-append "/root" target)))
+          file)))
+
+  (define MS_RDONLY 1)
+
+  (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)
+      (start-repl))
+
+    (display "loading kernel modules...\n")
+    (for-each (compose load-linux-module*
+                       (cut string-append "/modules/" <>))
+              linux-modules)
+
+    (when qemu-guest-networking?
+      (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")
+      (mkdir "/root"))
+    (if root
+        (catch #t
+          (lambda ()
+            (if volatile-root?
+                (begin
+                  ;; XXX: For lack of a union file system...
+                  (mkdir-p "/real-root")
+                  (mount root "/real-root" "ext3" MS_RDONLY)
+                  (mount "none" "/root" "tmpfs")
+
+                  ;; XXX: 'copy-recursively' cannot deal with device nodes, so
+                  ;; explicitly avoid /dev.
+                  (for-each (lambda (file)
+                              (unless (string=? "dev" file)
+                                (copy-recursively (string-append "/real-root/"
+                                                                 file)
+                                                  (string-append "/root/"
+                                                                 file)
+                                                  #:log (%make-void-port
+                                                         "w"))))
+                            (scandir "/real-root"
+                                     (lambda (file)
+                                       (not (member file '("." ".."))))))
+
+                  ;; TODO: Unmount /real-root.
+                  )
+                (mount root "/root" "ext3")))
+          (lambda args
+            (format (current-error-port) "exception while mounting '~a': ~s~%"
+                    root args)
+            (start-repl)))
+        (mount "none" "/root" "tmpfs"))
+
+    (mount-essential-file-systems #:root "/root")
+
+    (unless (file-exists? "/root/dev")
+      (mkdir "/root/dev")
+      (make-essential-device-nodes #:root "/root"))
+
+    ;; Mount the specified file systems.
+    (for-each (match-lambda
+               (('cifs source target)
+                (let ((target (string-append "/root/" target)))
+                  (mkdir-p target)
+                  (mount-qemu-smb-share source target)))
+               (('9p source target)
+                (let ((target (string-append "/root/" target)))
+                  (mkdir-p target)
+                  (mount-qemu-9p source target))))
+              mounts)
+
+    (when guile-modules-in-chroot?
+      ;; 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-p "/root/share")
+      (mkdir-p "/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
+          (format #t "loading '~a'...\n" to-load)
+          (chdir "/root")
+          (chroot "/root")
+          ;; TODO: Remove /lib, /share, and /loader.go.
+          (catch #t
+            (lambda ()
+              (primitive-load to-load))
+            (lambda args
+              (format (current-error-port) "'~a' raised an exception: ~s~%"
+                      to-load args)
+              (start-repl)))
+          (format (current-error-port)
+                  "boot program '~a' terminated, rebooting~%"
+                  to-load)
+          (sleep 2)
+          (reboot))
+        (begin
+          (display "no boot file passed via '--load'\n")
+          (display "entering a warm and cozy REPL\n")
+          (start-repl)))))
+
 ;;; linux-initrd.scm ends here
diff --git a/guix/build/union.scm b/guix/build/union.scm
index 1b09da45c7..6e2b296d81 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -103,21 +103,26 @@ single leaf."
       (leaf leaf))))
 
 (define (file=? file1 file2)
-  "Return #t if the contents of FILE1 and FILE2 are identical, #f otherwise."
-  (and (= (stat:size (stat file1)) (stat:size (stat file2)))
-       (call-with-input-file file1
-         (lambda (port1)
-           (call-with-input-file file2
-             (lambda (port2)
-               (define len 8192)
-               (define buf1 (make-bytevector len))
-               (define buf2 (make-bytevector len))
-               (let loop ()
-                 (let ((n1 (get-bytevector-n! port1 buf1 0 len))
-                       (n2 (get-bytevector-n! port2 buf2 0 len)))
-                   (and (equal? n1 n2)
-                        (or (eof-object? n1)
-                            (loop)))))))))))
+  "Return #t if FILE1 and FILE2 are regular files and their contents are
+identical, #f otherwise."
+  (let ((st1 (stat file1))
+        (st2 (stat file2)))
+    (and (eq? (stat:type st1) 'regular)
+         (eq? (stat:type st2) 'regular)
+         (= (stat:size st1) (stat:size st2))
+         (call-with-input-file file1
+           (lambda (port1)
+             (call-with-input-file file2
+               (lambda (port2)
+                 (define len 8192)
+                 (define buf1 (make-bytevector len))
+                 (define buf2 (make-bytevector len))
+                 (let loop ()
+                   (let ((n1 (get-bytevector-n! port1 buf1 0 len))
+                         (n2 (get-bytevector-n! port2 buf2 0 len)))
+                     (and (equal? n1 n2)
+                          (or (eof-object? n1)
+                              (loop))))))))))))
 
 (define* (union-build output directories
                       #:key (log-port (current-error-port)))
diff --git a/guix/derivations.scm b/guix/derivations.scm
index ae68bb1194..b47ab93759 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -47,6 +47,7 @@
             derivation-output-path
             derivation-output-hash-algo
             derivation-output-hash
+            derivation-output-recursive?
 
             <derivation-input>
             derivation-input?
@@ -91,11 +92,12 @@
   (file-name derivation-file-name))               ; the .drv file name
 
 (define-record-type <derivation-output>
-  (make-derivation-output path hash-algo hash)
+  (make-derivation-output path hash-algo hash recursive?)
   derivation-output?
   (path       derivation-output-path)             ; store path
   (hash-algo  derivation-output-hash-algo)        ; symbol | #f
-  (hash       derivation-output-hash))            ; bytevector | #f
+  (hash       derivation-output-hash)             ; bytevector | #f
+  (recursive? derivation-output-recursive?))      ; Boolean
 
 (define-record-type <derivation-input>
   (make-derivation-input path sub-derivations)
@@ -241,14 +243,19 @@ that second value is the empty list."
                   (match output
                     ((name path "" "")
                      (alist-cons name
-                                 (make-derivation-output path #f #f)
+                                 (make-derivation-output path #f #f #f)
                                  result))
                     ((name path hash-algo hash)
                      ;; fixed-output
-                     (let ((algo (string->symbol hash-algo))
-                           (hash (base16-string->bytevector hash)))
+                     (let* ((rec? (string-prefix? "r:" hash-algo))
+                            (algo (string->symbol
+                                   (if rec?
+                                       (string-drop hash-algo 2)
+                                       hash-algo)))
+                            (hash (base16-string->bytevector hash)))
                        (alist-cons name
-                                   (make-derivation-output path algo hash)
+                                   (make-derivation-output path algo
+                                                           hash rec?)
                                    result)))))
                 '()
                 x))
@@ -368,9 +375,12 @@ that form."
 
   (define (write-output output port)
     (match output
-     ((name . ($ <derivation-output> path hash-algo hash))
+     ((name . ($ <derivation-output> path hash-algo hash recursive?))
       (write-tuple (list name path
-                         (or (and=> hash-algo symbol->string) "")
+                         (if hash-algo
+                             (string-append (if recursive? "r:" "")
+                                            (symbol->string hash-algo))
+                             "")
                          (or (and=> hash bytevector->base16-string)
                              ""))
                    write
@@ -476,11 +486,14 @@ in SIZE bytes."
     "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
     (match drv
       (($ <derivation> ((_ . ($ <derivation-output> path
-                                (? symbol? hash-algo) (? bytevector? hash)))))
+                                (? symbol? hash-algo) (? bytevector? hash)
+                                (? boolean? recursive?)))))
        ;; A fixed-output derivation.
        (sha256
         (string->utf8
-         (string-append "fixed:out:" (symbol->string hash-algo)
+         (string-append "fixed:out:"
+                        (if recursive? "r:" "")
+                        (symbol->string hash-algo)
                         ":" (bytevector->base16-string hash)
                         ":" path))))
       (($ <derivation> outputs inputs sources
@@ -527,17 +540,33 @@ the derivation called NAME with hash HASH."
                   name
                   (string-append name "-" output))))
 
+(define (fixed-output-path output hash-algo hash recursive? name)
+  "Return an output path for the fixed output OUTPUT defined by HASH of type
+HASH-ALGO, of the derivation NAME.  RECURSIVE? has the same meaning as for
+'add-to-store'."
+  (if (and recursive? (eq? hash-algo 'sha256))
+      (store-path "source" hash name)
+      (let ((tag (string-append "fixed:" output ":"
+                                (if recursive? "r:" "")
+                                (symbol->string hash-algo) ":"
+                                (bytevector->base16-string hash) ":")))
+        (store-path (string-append "output:" output)
+                    (sha256 (string->utf8 tag))
+                    name))))
+
 (define* (derivation store name builder args
                      #:key
                      (system (%current-system)) (env-vars '())
                      (inputs '()) (outputs '("out"))
-                     hash hash-algo hash-mode
+                     hash hash-algo recursive?
                      references-graphs
                      local-build?)
   "Build a derivation with the given arguments, and return the resulting
-<derivation> object.  When HASH, HASH-ALGO, and HASH-MODE are given, a
+<derivation> object.  When HASH and HASH-ALGO are given, a
 fixed-output derivation is created---i.e., one whose result is known in
-advance, such as a file download.
+advance, such as a file download.  If, in addition, RECURSIVE? is true, then
+that fixed output may be an executable file or a directory and HASH must be
+the hash of an archive containing this output.
 
 When REFERENCES-GRAPHS is true, it must be a list of file name/store path
 pairs.  In that case, the reference graph of each store path is exported in
@@ -555,12 +584,16 @@ derivations where the costs of data transfers would outweigh the benefits."
        (let* ((drv-hash (derivation-hash drv))
               (outputs  (map (match-lambda
                               ((output-name . ($ <derivation-output>
-                                                 _ algo hash))
-                               (let ((path (output-path output-name
-                                                        drv-hash name)))
+                                                 _ algo hash rec?))
+                               (let ((path (if hash
+                                               (fixed-output-path output-name
+                                                                  algo hash
+                                                                  rec? name)
+                                               (output-path output-name
+                                                            drv-hash name))))
                                  (cons output-name
                                        (make-derivation-output path algo
-                                                               hash)))))
+                                                               hash rec?)))))
                              outputs)))
          (make-derivation outputs inputs sources system builder args
                           (map (match-lambda
@@ -618,7 +651,8 @@ derivations where the costs of data transfers would outweigh the benefits."
   (let* ((outputs    (map (lambda (name)
                             ;; Return outputs with an empty path.
                             (cons name
-                                  (make-derivation-output "" hash-algo hash)))
+                                  (make-derivation-output "" hash-algo
+                                                          hash recursive?)))
                           outputs))
          (inputs     (map (match-lambda
                            (((? derivation? drv))
@@ -911,7 +945,7 @@ they can refer to each other."
                                        (system (%current-system))
                                        (inputs '())
                                        (outputs '("out"))
-                                       hash hash-algo
+                                       hash hash-algo recursive?
                                        (env-vars '())
                                        (modules '())
                                        guile-for-build
@@ -1058,6 +1092,7 @@ LOCAL-BUILD?."
                                env-vars)
 
                 #:hash hash #:hash-algo hash-algo
+                #:recursive? recursive?
                 #:outputs outputs
                 #:references-graphs references-graphs
                 #:local-build? local-build?)))
diff --git a/guix/download.scm b/guix/download.scm
index 8a3e9fd06a..2cc8a4a5b8 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -108,7 +108,10 @@
        "ftp://gd.tuwien.ac.at/pub/infosys/servers/http/apache/dist/"
        "http://apache.belnet.be/"
        "http://mirrors.ircam.fr/pub/apache/"
-       "http://apache-mirror.rbc.ru/pub/apache/")
+       "http://apache-mirror.rbc.ru/pub/apache/"
+
+       ;; As a last resort, try the archive.
+       "http://archive.apache.org/dist/")
       (xorg               ; from http://www.x.org/wiki/Releases/Download
        "http://www.x.org/releases/" ; main mirrors
        "ftp://mirror.csclub.uwaterloo.ca/x.org/" ; North America
diff --git a/guix/git-download.scm b/guix/git-download.scm
new file mode 100644
index 0000000000..472bf756ce
--- /dev/null
+++ b/guix/git-download.scm
@@ -0,0 +1,89 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 (guix git-download)
+  #:use-module (guix records)
+  #:use-module (guix derivations)
+  #:use-module (guix packages)
+  #:use-module (ice-9 match)
+  #:export (git-reference
+            git-reference?
+            git-reference-url
+            git-reference-commit
+
+            git-fetch))
+
+;;; Commentary:
+;;;
+;;; An <origin> method that fetches a specific commit from a Git repository.
+;;; The repository URL and commit hash are specified with a <git-reference>
+;;; object.
+;;;
+;;; Code:
+
+(define-record-type* <git-reference>
+  git-reference make-git-reference
+  git-reference?
+  (url    git-reference-url)
+  (commit git-reference-commit))
+
+(define* (git-fetch store ref hash-algo hash
+                    #:optional name
+                    #:key (system (%current-system)) guile git)
+  "Return a fixed-output derivation in STORE that fetches REF, a
+<git-reference> object.  The output is expected to have recursive hash HASH of
+type HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if
+#f."
+  (define guile-for-build
+    (match guile
+      ((? package?)
+       (package-derivation store guile system))
+      (#f                                         ; the default
+       (let* ((distro (resolve-interface '(gnu packages base)))
+              (guile  (module-ref distro 'guile-final)))
+         (package-derivation store guile system)))))
+
+  (define git-for-build
+    (match git
+      ((? package?)
+       (package-derivation store git system))
+      (#f                                         ; the default
+       (let* ((distro (resolve-interface '(gnu packages version-control)))
+              (git    (module-ref distro 'git)))
+         (package-derivation store git system)))))
+
+  (let* ((command (string-append (derivation->output-path git-for-build)
+                                 "/bin/git"))
+         (builder `(begin
+                     (use-modules (guix build git))
+                     (git-fetch ',(git-reference-url ref)
+                                ',(git-reference-commit ref)
+                                %output
+                                #:git-command ',command))))
+    (build-expression->derivation store (or name "git-checkout") builder
+                                  #:system system
+                                  #:local-build? #t
+                                  #:inputs `(("git" ,git-for-build))
+                                  #:hash-algo hash-algo
+                                  #:hash hash
+                                  #:recursive? #t
+                                  #:modules '((guix build git)
+                                              (guix build utils))
+                                  #:guile-for-build guile-for-build)))
+
+;;; git-download.scm ends here
diff --git a/guix/monads.scm b/guix/monads.scm
index 410fdbecb2..db8b645402 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +23,7 @@
   #:use-module ((system syntax)
                 #:select (syntax-local-binding))
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:export (;; Monads.
@@ -53,11 +54,14 @@
             store-lift
             run-with-store
             text-file
+            text-file*
             package-file
             package->derivation
             built-derivations
             derivation-expression
-            lower-inputs))
+            lower-inputs)
+  #:replace (imported-modules
+             compiled-modules))
 
 ;;; Commentary:
 ;;;
@@ -303,14 +307,63 @@ in the store monad."
 
 (define* (text-file name text)
   "Return as a monadic value the absolute file name in the store of the file
-containing TEXT."
+containing TEXT, a string."
   (lambda (store)
     (add-text-to-store store name text '())))
 
+(define* (text-file* name #:rest text)
+  "Return as a monadic value a derivation that builds a text file containing
+all of TEXT.  TEXT may list, in addition to strings, packages, derivations,
+and store file names; the resulting store file holds references to all these."
+  (define inputs
+    ;; Transform packages and derivations from TEXT into a valid input list.
+    (filter-map (match-lambda
+                 ((? package? p) `("x" ,p))
+                 ((? derivation? d) `("x" ,d))
+                 ((x ...) `("x" ,@x))
+                 ((? string? s)
+                  (and (direct-store-path? s) `("x" ,s)))
+                 (x x))
+                text))
+
+  (define (computed-text text inputs)
+    ;; Using the lowered INPUTS, return TEXT with derivations replaced with
+    ;; their output file name.
+    (define (real-string? s)
+      (and (string? s) (not (direct-store-path? s))))
+
+    (let loop ((inputs inputs)
+               (text   text)
+               (result '()))
+      (match text
+        (()
+         (string-concatenate-reverse result))
+        (((? real-string? head) rest ...)
+         (loop inputs rest (cons head result)))
+        ((_ rest ...)
+         (match inputs
+           (((_ (? derivation? drv) sub-drv ...) inputs ...)
+            (loop inputs rest
+                  (cons (apply derivation->output-path drv
+                               sub-drv)
+                        result)))
+           (((_ file) inputs ...)
+            ;; FILE is the result of 'add-text-to-store' or so.
+            (loop inputs rest (cons file result))))))))
+
+  (define (builder inputs)
+    `(call-with-output-file (assoc-ref %outputs "out")
+       (lambda (port)
+         (display ,(computed-text text inputs) port))))
+
+  (mlet %store-monad ((inputs (lower-inputs inputs)))
+    (derivation-expression name (builder inputs)
+                           #:inputs inputs)))
+
 (define* (package-file package
                        #:optional file
                        #:key (system (%current-system)) (output "out"))
-  "Return as a monadic value in the absolute file name of FILE within the
+  "Return as a monadic value the absolute file name of FILE within the
 OUTPUT directory of PACKAGE.  When FILE is omitted, return the name of the
 OUTPUT directory of PACKAGE."
   (lambda (store)
@@ -342,6 +395,12 @@ input list as a monadic value."
 (define package->derivation
   (store-lift package-derivation))
 
+(define imported-modules
+  (store-lift (@ (guix derivations) imported-modules)))
+
+(define compiled-modules
+  (store-lift (@ (guix derivations) compiled-modules)))
+
 (define built-derivations
   (store-lift build-derivations))
 
diff --git a/guix/nar.scm b/guix/nar.scm
index 4bc2deb229..5bf174554c 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -112,7 +112,8 @@
   (write-long-long size p)
   (call-with-binary-input-file file
     ;; Use `sendfile' when available (Guile 2.0.8+).
-    (if (compile-time-value (defined? 'sendfile))
+    (if (and (compile-time-value (defined? 'sendfile))
+             (file-port? p))
         (cut sendfile p <> size 0)
         (cut dump <> p size)))
   (write-padding size p))
@@ -176,8 +177,13 @@ sub-directories of FILE as needed."
         ((directory)
          (write-string "type" p)
          (write-string "directory" p)
-         (let ((entries (remove (cut member <> '("." ".."))
-                                (scandir f))))
+         (let* ((select? (negate (cut member <> '("." ".."))))
+
+                ;; 'scandir' defaults to 'string-locale<?' to sort files, but
+                ;; this happens to be case-insensitive (at least in 'en_US'
+                ;; locale on libc 2.18.)  Conversely, we want files to be
+                ;; sorted in a case-sensitive fashion.
+                (entries (scandir f select? string<?)))
            (for-each (lambda (e)
                        (let ((f (string-append f "/" e)))
                          (write-string "entry" p)
@@ -194,8 +200,8 @@ sub-directories of FILE as needed."
          (write-string "target" p)
          (write-string (readlink f) p))
         (else
-         (raise (condition (&message (message "ENOSYS"))
-                           (&nar-error)))))
+         (raise (condition (&message (message "unsupported file type"))
+                           (&nar-error (file f) (port port))))))
       (write-string ")" p))))
 
 (define (restore-file port file)
diff --git a/guix/packages.scm b/guix/packages.scm
index daf431f5e4..d345900f79 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -106,7 +106,7 @@
   origin make-origin
   origin?
   (uri       origin-uri)                          ; string
-  (method    origin-method)                       ; symbol
+  (method    origin-method)                       ; procedure
   (sha256    origin-sha256)                       ; bytevector
   (file-name origin-file-name (default #f))       ; optional file name
   (patches   origin-patches (default '()))        ; list of file names
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 32690c6b45..4788468584 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -71,17 +71,10 @@ Export/import one or more packages from/to the store.\n"))
   -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
   (display (_ "
       --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
-  (display (_ "
-  -n, --dry-run          do not build the derivations"))
-  (display (_ "
-      --fallback         fall back to building when the substituter fails"))
-  (display (_ "
-      --no-substitutes   build instead of resorting to pre-built substitutes"))
-  (display (_ "
-      --max-silent-time=SECONDS
-                         mark the build as failed after SECONDS of silence"))
-  (display (_ "
-  -c, --cores=N          allow the use of up to N CPU cores for the build"))
+
+  (newline)
+  (show-build-options-help)
+
   (newline)
   (display (_ "
   -h, --help             display this help and exit"))
@@ -92,81 +85,60 @@ Export/import one or more packages from/to the store.\n"))
 
 (define %options
   ;; Specifications of the command-line options.
-  (list (option '(#\h "help") #f #f
-                (lambda args
-                  (show-help)
-                  (exit 0)))
-        (option '(#\V "version") #f #f
-                (lambda args
-                  (show-version-and-exit "guix build")))
+  (cons* (option '(#\h "help") #f #f
+                 (lambda args
+                   (show-help)
+                   (exit 0)))
+         (option '(#\V "version") #f #f
+                 (lambda args
+                   (show-version-and-exit "guix build")))
 
-        (option '("export") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'export #t result)))
-        (option '("import") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'import #t result)))
-        (option '("missing") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'missing #t result)))
-        (option '("generate-key") #f #t
-                (lambda (opt name arg result)
-                  (catch 'gcry-error
-                    (lambda ()
-                      (let ((params
-                             (string->canonical-sexp
-                              (or arg "(genkey (rsa (nbits 4:4096)))"))))
-                        (alist-cons 'generate-key params result)))
-                    (lambda args
-                      (leave (_ "invalid key generation parameters: ~s~%")
-                             arg)))))
-        (option '("authorize") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'authorize #t result)))
+         (option '("export") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'export #t result)))
+         (option '("import") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'import #t result)))
+         (option '("missing") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'missing #t result)))
+         (option '("generate-key") #f #t
+                 (lambda (opt name arg result)
+                   (catch 'gcry-error
+                     (lambda ()
+                       (let ((params
+                              (string->canonical-sexp
+                               (or arg "(genkey (rsa (nbits 4:4096)))"))))
+                         (alist-cons 'generate-key params result)))
+                     (lambda args
+                       (leave (_ "invalid key generation parameters: ~s~%")
+                              arg)))))
+         (option '("authorize") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'authorize #t result)))
 
-        (option '(#\S "source") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'source? #t result)))
-        (option '(#\s "system") #t #f
-                (lambda (opt name arg result)
-                  (alist-cons 'system arg
-                              (alist-delete 'system result eq?))))
-        (option '("target") #t #f
-                (lambda (opt name arg result)
-                  (alist-cons 'target arg
-                              (alist-delete 'target result eq?))))
-        (option '(#\e "expression") #t #f
-                (lambda (opt name arg result)
-                  (alist-cons 'expression arg result)))
-        (option '(#\c "cores") #t #f
-                (lambda (opt name arg result)
-                  (let ((c (false-if-exception (string->number arg))))
-                    (if c
-                        (alist-cons 'cores c result)
-                        (leave (_ "~a: not a number~%") arg)))))
-        (option '(#\n "dry-run") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'dry-run? #t result)))
-        (option '("fallback") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'fallback? #t
-                              (alist-delete 'fallback? result))))
-        (option '("no-substitutes") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'substitutes? #f
-                              (alist-delete 'substitutes? result))))
-        (option '("max-silent-time") #t #f
-                (lambda (opt name arg result)
-                  (alist-cons 'max-silent-time (string->number* arg)
-                              result)))
-        (option '(#\r "root") #t #f
-                (lambda (opt name arg result)
-                  (alist-cons 'gc-root arg result)))
-        (option '("verbosity") #t #f
-                (lambda (opt name arg result)
-                  (let ((level (string->number arg)))
-                    (alist-cons 'verbosity level
-                                (alist-delete 'verbosity result)))))))
+         (option '(#\S "source") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'source? #t result)))
+         (option '(#\s "system") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'system arg
+                               (alist-delete 'system result eq?))))
+         (option '("target") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'target arg
+                               (alist-delete 'target result eq?))))
+         (option '(#\e "expression") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'expression arg result)))
+         (option '(#\n "dry-run") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'dry-run? #t result)))
+         (option '(#\r "root") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'gc-root arg result)))
+
+         %standard-build-options))
 
 (define (options->derivations+files store opts)
   "Given OPTS, the result of 'args-fold', return a list of derivations to
@@ -219,16 +191,11 @@ build and a list of store files to transfer."
 resulting archive to the standard output port."
   (let-values (((drv files)
                 (options->derivations+files store opts)))
+    (set-build-options-from-command-line store opts)
     (show-what-to-build store drv
                         #:use-substitutes? (assoc-ref opts 'substitutes?)
                         #:dry-run? (assoc-ref opts 'dry-run?))
 
-    (set-build-options store
-                       #:build-cores (or (assoc-ref opts 'cores) 0)
-                       #:fallback? (assoc-ref opts 'fallback?)
-                       #:use-substitutes? (assoc-ref opts 'substitutes?)
-                       #:max-silent-time (assoc-ref opts 'max-silent-time))
-
     (if (or (assoc-ref opts 'dry-run?)
             (build-derivations store drv))
         (export-paths store files (current-output-port))
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 7cb3710853..4a00505022 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -34,6 +34,11 @@
   #:use-module (srfi srfi-37)
   #:autoload   (gnu packages) (find-best-packages-by-name)
   #:export (derivation-from-expression
+
+            %standard-build-options
+            set-build-options-from-command-line
+            show-build-options-help
+
             guix-build))
 
 (define (derivation-from-expression store str package-derivation
@@ -101,30 +106,13 @@ present, return the preferred newest version."
 
 
 ;;;
-;;; Command-line options.
+;;; Standard command-line build options.
 ;;;
 
-(define %default-options
-  ;; Alist of default option values.
-  `((system . ,(%current-system))
-    (substitutes? . #t)
-    (build-hook? . #t)
-    (max-silent-time . 3600)
-    (verbosity . 0)))
-
-(define (show-help)
-  (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
-Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
-  (display (_ "
-  -e, --expression=EXPR  build the package or derivation EXPR evaluates to"))
-  (display (_ "
-  -S, --source           build the packages' source derivations"))
-  (display (_ "
-  -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
-  (display (_ "
-      --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
-  (display (_ "
-  -d, --derivations      return the derivation paths of the given packages"))
+(define (show-build-options-help)
+  "Display on the current output port help about the standard command-line
+options handled by 'set-build-options-from-command-line', and listed in
+'%standard-build-options'."
   (display (_ "
   -K, --keep-failed      keep build tree of failed builds"))
   (display (_ "
@@ -139,61 +127,28 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
       --max-silent-time=SECONDS
                          mark the build as failed after SECONDS of silence"))
   (display (_ "
-  -c, --cores=N          allow the use of up to N CPU cores for the build"))
-  (display (_ "
-  -r, --root=FILE        make FILE a symlink to the result, and register it
-                         as a garbage collector root"))
-  (display (_ "
       --verbosity=LEVEL  use the given verbosity LEVEL"))
   (display (_ "
-      --log-file         return the log file names for the given derivations"))
-  (newline)
-  (display (_ "
-  -h, --help             display this help and exit"))
-  (display (_ "
-  -V, --version          display version information and exit"))
-  (newline)
-  (show-bug-report-information))
+  -c, --cores=N          allow the use of up to N CPU cores for the build")))
 
-(define %options
-  ;; Specifications of the command-line options.
-  (list (option '(#\h "help") #f #f
-                (lambda args
-                  (show-help)
-                  (exit 0)))
-        (option '(#\V "version") #f #f
-                (lambda args
-                  (show-version-and-exit "guix build")))
+(define (set-build-options-from-command-line store opts)
+  "Given OPTS, an alist as returned by 'args-fold' given
+'%standard-build-options', set the corresponding build options on STORE."
+  ;; TODO: Add more options.
+  (set-build-options store
+                     #:keep-failed? (assoc-ref opts 'keep-failed?)
+                     #:build-cores (or (assoc-ref opts 'cores) 0)
+                     #:fallback? (assoc-ref opts 'fallback?)
+                     #:use-substitutes? (assoc-ref opts 'substitutes?)
+                     #:use-build-hook? (assoc-ref opts 'build-hook?)
+                     #:max-silent-time (assoc-ref opts 'max-silent-time)
+                     #:verbosity (assoc-ref opts 'verbosity)))
 
-        (option '(#\S "source") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'source? #t result)))
-        (option '(#\s "system") #t #f
-                (lambda (opt name arg result)
-                  (alist-cons 'system arg
-                              (alist-delete 'system result eq?))))
-        (option '("target") #t #f
-                (lambda (opt name arg result)
-                  (alist-cons 'target arg
-                              (alist-delete 'target result eq?))))
-        (option '(#\d "derivations") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'derivations-only? #t result)))
-        (option '(#\e "expression") #t #f
-                (lambda (opt name arg result)
-                  (alist-cons 'expression arg result)))
-        (option '(#\K "keep-failed") #f #f
+(define %standard-build-options
+  ;; List of standard command-line options for tools that build something.
+  (list (option '(#\K "keep-failed") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'keep-failed? #t result)))
-        (option '(#\c "cores") #t #f
-                (lambda (opt name arg result)
-                  (let ((c (false-if-exception (string->number arg))))
-                    (if c
-                        (alist-cons 'cores c result)
-                        (leave (_ "~a: not a number~%") arg)))))
-        (option '(#\n "dry-run") #f #f
-                (lambda (opt name arg result)
-                  (alist-cons 'dry-run? #t result)))
         (option '("fallback") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'fallback? #t
@@ -210,17 +165,97 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                 (lambda (opt name arg result)
                   (alist-cons 'max-silent-time (string->number* arg)
                               result)))
-        (option '(#\r "root") #t #f
-                (lambda (opt name arg result)
-                  (alist-cons 'gc-root arg result)))
         (option '("verbosity") #t #f
                 (lambda (opt name arg result)
                   (let ((level (string->number arg)))
                     (alist-cons 'verbosity level
                                 (alist-delete 'verbosity result)))))
-        (option '("log-file") #f #f
+        (option '(#\c "cores") #t #f
                 (lambda (opt name arg result)
-                  (alist-cons 'log-file? #t result)))))
+                  (let ((c (false-if-exception (string->number arg))))
+                    (if c
+                        (alist-cons 'cores c result)
+                        (leave (_ "~a: not a number~%") arg)))))))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  ;; Alist of default option values.
+  `((system . ,(%current-system))
+    (substitutes? . #t)
+    (build-hook? . #t)
+    (max-silent-time . 3600)
+    (verbosity . 0)))
+
+(define (show-help)
+  (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
+Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
+  (display (_ "
+  -e, --expression=EXPR  build the package or derivation EXPR evaluates to"))
+  (display (_ "
+  -S, --source           build the packages' source derivations"))
+  (display (_ "
+  -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
+  (display (_ "
+      --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
+  (display (_ "
+  -d, --derivations      return the derivation paths of the given packages"))
+  (display (_ "
+  -r, --root=FILE        make FILE a symlink to the result, and register it
+                         as a garbage collector root"))
+  (display (_ "
+      --log-file         return the log file names for the given derivations"))
+  (newline)
+  (show-build-options-help)
+  (newline)
+  (display (_ "
+  -h, --help             display this help and exit"))
+  (display (_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specifications of the command-line options.
+  (cons* (option '(#\h "help") #f #f
+                 (lambda args
+                   (show-help)
+                   (exit 0)))
+         (option '(#\V "version") #f #f
+                 (lambda args
+                   (show-version-and-exit "guix build")))
+
+         (option '(#\S "source") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'source? #t result)))
+         (option '(#\s "system") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'system arg
+                               (alist-delete 'system result eq?))))
+         (option '("target") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'target arg
+                               (alist-delete 'target result eq?))))
+         (option '(#\d "derivations") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'derivations-only? #t result)))
+         (option '(#\e "expression") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'expression arg result)))
+         (option '(#\n "dry-run") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'dry-run? #t result)))
+         (option '(#\r "root") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'gc-root arg result)))
+         (option '("log-file") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'log-file? #t result)))
+
+         %standard-build-options))
 
 (define (options->derivations store opts)
   "Given OPTS, the result of 'args-fold', return a list of derivations to
@@ -279,21 +314,12 @@ build."
                                  (_ #f))
                                 opts)))
 
+        (set-build-options-from-command-line store opts)
         (unless (assoc-ref opts 'log-file?)
           (show-what-to-build store drv
                               #:use-substitutes? (assoc-ref opts 'substitutes?)
                               #:dry-run? (assoc-ref opts 'dry-run?)))
 
-        ;; TODO: Add more options.
-        (set-build-options store
-                           #:keep-failed? (assoc-ref opts 'keep-failed?)
-                           #:build-cores (or (assoc-ref opts 'cores) 0)
-                           #:fallback? (assoc-ref opts 'fallback?)
-                           #:use-substitutes? (assoc-ref opts 'substitutes?)
-                           #:use-build-hook? (assoc-ref opts 'build-hook?)
-                           #:max-silent-time (assoc-ref opts 'max-silent-time)
-                           #:verbosity (assoc-ref opts 'verbosity))
-
         (cond ((assoc-ref opts 'log-file?)
                (for-each (lambda (file)
                            (let ((log (log-file store file)))
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index ca3928b8e3..ea8c2ada6b 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -20,12 +20,14 @@
 (define-module (guix scripts hash)
   #:use-module (guix base32)
   #:use-module (guix hash)
+  #:use-module (guix nar)
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (rnrs io ports)
   #:use-module (rnrs files)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:export (guix-hash))
@@ -43,10 +45,12 @@
   (display (_ "Usage: guix hash [OPTION] FILE
 Return the cryptographic hash of FILE.
 
-Supported formats: 'nix-base32' (default), 'base32', and 'base16'
-('hex' and 'hexadecimal' can be used as well).\n"))
+Supported formats: 'nix-base32' (default), 'base32', and 'base16' ('hex'
+and 'hexadecimal' can be used as well).\n"))
   (format #t (_ "
   -f, --format=FMT       write the hash in the given format"))
+  (format #t (_ "
+  -r, --recursive        compute the hash on FILE recursively"))
   (newline)
   (display (_ "
   -h, --help             display this help and exit"))
@@ -73,6 +77,9 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
 
                   (alist-cons 'format fmt-proc
                               (alist-delete 'format result))))
+        (option '(#\r "recursive") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'recursive? #t result)))
 
         (option '(#\h "help") #f #f
                 (lambda args
@@ -99,11 +106,6 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
                   (alist-cons 'argument arg result))
                 %default-options))
 
-  (define (eof->null x)
-    (if (eof-object? x)
-        #vu8()
-        x))
-
   (let* ((opts (parse-options))
          (args (filter-map (match-lambda
                             (('argument . value)
@@ -112,13 +114,22 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
                            (reverse opts)))
          (fmt  (assq-ref opts 'format)))
 
+    (define (file-hash file)
+      ;; Compute the hash of FILE.
+      ;; Catch and gracefully report possible '&nar-error' conditions.
+      (with-error-handling
+        (if (assoc-ref opts 'recursive?)
+            (let-values (((port get-hash) (open-sha256-port)))
+              (write-file file port)
+              (flush-output-port port)
+              (get-hash))
+            (call-with-input-file file port-sha256))))
+
     (match args
       ((file)
        (catch 'system-error
          (lambda ()
-           (format #t "~a~%"
-                   (call-with-input-file file
-                     (compose fmt sha256 eof->null get-bytevector-all))))
+           (format #t "~a~%" (fmt (file-hash file))))
          (lambda args
            (leave (_ "~a~%")
                   (strerror (system-error-errno args))))))
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index d919ede3c7..00a145e5e9 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -108,7 +108,7 @@ determined."
       (save-module-excursion
        (lambda ()
          (set-current-module %user-module)
-         (primitive-load %machine-file))))
+         (primitive-load file))))
     (lambda args
       (match args
         (('system-error . _)
@@ -117,10 +117,10 @@ determined."
            (if (= ENOENT err)
                '()
                (leave (_ "failed to open machine file '~a': ~a~%")
-                      %machine-file (strerror err)))))
+                      file (strerror err)))))
         (_
          (leave (_ "failed to load machine file '~a': ~s~%")
-                %machine-file args))))))
+                file args))))))
 
 (define (open-ssh-gateway machine)
   "Initiate an SSH connection gateway to MACHINE, and return the PID of the
@@ -170,9 +170,9 @@ running lsh gateway upon success, or #f on failure."
 
 (define* (offload drv machine
                   #:key print-build-trace? (max-silent-time 3600)
-                  (build-timeout 7200))
+                  (build-timeout 7200) (log-port (current-output-port)))
   "Perform DRV on MACHINE, assuming DRV and its prerequisites are available
-there.  Return a read pipe from where to read the build log."
+there, and write the build log to LOG-PORT.  Return the exit status."
   (format (current-error-port) "offloading '~a' to '~a'...~%"
           (derivation-file-name drv) (build-machine-name machine))
   (format (current-error-port) "@ build-remote ~a ~a~%"
@@ -185,7 +185,13 @@ there.  Return a read pipe from where to read the build log."
                              ,(format #f "--max-silent-time=~a"
                                       max-silent-time)
                              ,(derivation-file-name drv)))))
-    pipe))
+    (let loop ((line (read-line pipe)))
+      (unless (eof-object? line)
+        (display line log-port)
+        (newline log-port)
+        (loop (read-line pipe))))
+
+    (close-pipe pipe)))
 
 (define (send-files files machine)
   "Send the subset of FILES that's missing to MACHINE's store.  Return #t on
@@ -291,20 +297,25 @@ success, #f otherwise."
                  (outputs (string-tokenize (read-line))))
              (when (send-files (cons (derivation-file-name drv) inputs)
                                machine)
-               (let ((log (offload drv machine
-                                   #:print-build-trace? print-build-trace?
-                                   #:max-silent-time max-silent-time
-                                   #:build-timeout build-timeout)))
-                 (let loop ((line (read-line log)))
-                   (if (eof-object? line)
-                       (close-pipe log)
-                       (begin
-                         (display line) (newline)
-                         (loop (read-line log))))))
-               (retrieve-files outputs machine)))
-           (format (current-error-port) "done with offloaded '~a'~%"
-                   (derivation-file-name drv))
-           (kill pid SIGTERM))
+               (let ((status (offload drv machine
+                                      #:print-build-trace? print-build-trace?
+                                      #:max-silent-time max-silent-time
+                                      #:build-timeout build-timeout)))
+                 (kill pid SIGTERM)
+                 (if (zero? status)
+                     (begin
+                       (retrieve-files outputs machine)
+                       (format (current-error-port)
+                               "done with offloaded '~a'~%"
+                               (derivation-file-name drv)))
+                     (begin
+                       (format (current-error-port)
+                               "derivation '~a' offloaded to '~a' failed \
+with exit code ~a~%"
+                               (derivation-file-name drv)
+                               (build-machine-name machine)
+                               (status:exit-val status))
+                       (primitive-exit (status:exit-val status))))))))
           (#f
            (display "# decline\n")))
         (display "# decline\n"))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
new file mode 100644
index 0000000000..7799ccbc47
--- /dev/null
+++ b/guix/scripts/system.scm
@@ -0,0 +1,148 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 (guix scripts system)
+  #:use-module (guix ui)
+  #:use-module (guix store)
+  #:use-module (guix derivations)
+  #:use-module (guix packages)
+  #:use-module (guix utils)
+  #:use-module (guix monads)
+  #:use-module (guix scripts build)
+  #:use-module (gnu system vm)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 match)
+  #:export (guix-system))
+
+(define %user-module
+  ;; Module in which the machine description file is loaded.
+  (let ((module (make-fresh-user-module)))
+    (for-each (lambda (iface)
+                (module-use! module (resolve-interface iface)))
+              '((gnu system)
+                (gnu services)
+                (gnu system shadow)))
+    module))
+
+(define (read-operating-system file)
+  "Read the operating-system declaration from FILE and return it."
+  ;; TODO: Factorize.
+  (catch #t
+    (lambda ()
+      ;; Avoid ABI incompatibility with the <operating-system> record.
+      (set! %fresh-auto-compile #t)
+
+      (save-module-excursion
+       (lambda ()
+         (set-current-module %user-module)
+         (primitive-load file))))
+    (lambda args
+      (match args
+        (('system-error . _)
+         (let ((err (system-error-errno args)))
+           (leave (_ "failed to open operating system file '~a': ~a~%")
+                  file (strerror err))))
+        (_
+         (leave (_ "failed to load machine file '~a': ~s~%")
+                file args))))))
+
+
+;;;
+;;; Options.
+;;;
+
+(define (show-help)
+  (display (_ "Usage: guix system [OPTION] ACTION FILE
+Build the operating system declared in FILE according to ACTION.\n"))
+  (display (_ "Currently the only valid value for ACTION is 'vm', which builds
+a virtual machine of the given operating system.\n"))
+  (show-build-options-help)
+  (newline)
+  (display (_ "
+  -h, --help             display this help and exit"))
+  (display (_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specifications of the command-line options.
+  (cons* (option '(#\h "help") #f #f
+                 (lambda args
+                   (show-help)
+                   (exit 0)))
+         (option '(#\V "version") #f #f
+                 (lambda args
+                   (show-version-and-exit "guix system")))
+         (option '(#\n "dry-run") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'dry-run? #t result)))
+         %standard-build-options))
+
+(define %default-options
+  ;; Alist of default option values.
+  `((system . ,(%current-system))
+    (substitutes? . #t)
+    (build-hook? . #t)
+    (max-silent-time . 3600)
+    (verbosity . 0)))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-system . args)
+  (define (parse-options)
+    ;; Return the alist of option values.
+    (args-fold* args %options
+                (lambda (opt name arg result)
+                  (leave (_ "~A: unrecognized option~%") name))
+                (lambda (arg result)
+                  (if (assoc-ref result 'action)
+                      (let ((previous (assoc-ref result 'argument)))
+                        (if previous
+                            (leave (_ "~a: extraneous argument~%") previous)
+                            (alist-cons 'argument arg result)))
+                      (let ((action (string->symbol arg)))
+                        (case action
+                          ((vm) (alist-cons 'action action result))
+                          (else (leave (_ "~a: unknown action~%")
+                                       action))))))
+                %default-options))
+
+  (with-error-handling
+    (let* ((opts  (parse-options))
+           (file  (assoc-ref opts 'argument))
+           (os    (if file
+                      (read-operating-system file)
+                      (leave (_ "no configuration file specified~%"))))
+           (mdrv  (system-qemu-image/shared-store-script os))
+           (store (open-connection))
+           (dry?  (assoc-ref opts 'dry-run?))
+           (drv   (run-with-store store mdrv)))
+      (set-build-options-from-command-line store opts)
+      (show-what-to-build store (list drv)
+                          #:dry-run? dry?
+                          #:use-substitutes? (assoc-ref opts 'substitutes?))
+
+      (unless dry?
+        (build-derivations store (list drv))
+        (display (derivation->output-path drv))
+        (newline)))))
diff --git a/guix/store.scm b/guix/store.scm
index eca0de7d97..8e88c5f86d 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -100,8 +100,8 @@
 
 (define %protocol-version #x10c)
 
-(define %worker-magic-1 #x6e697863)
-(define %worker-magic-2 #x6478696f)
+(define %worker-magic-1 #x6e697863)               ; "nixc"
+(define %worker-magic-2 #x6478696f)               ; "dxio"
 
 (define (protocol-major magic)
   (logand magic #xff00))
@@ -732,10 +732,10 @@ is raised if the set of paths read from PORT is not signed (as per
     (= 1 (read-int s))))
 
 (define* (export-paths server paths port #:key (sign? #t))
-  "Export the store paths listed in PATHS to PORT, signing them if SIGN?
-is true."
+  "Export the store paths listed in PATHS to PORT, in topological order,
+signing them if SIGN? is true."
   (let ((s (nix-server-socket server)))
-    (let loop ((paths paths))
+    (let loop ((paths (topologically-sorted server paths)))
       (match paths
         (()
          (write-int 0 port))
diff --git a/guix/ui.scm b/guix/ui.scm
index d6058f806b..c232b32674 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -31,6 +31,7 @@
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
   #:autoload   (ice-9 ftw)  (scandir)
   #:use-module (ice-9 match)
@@ -186,7 +187,10 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
             ((nix-protocol-error? c)
              ;; FIXME: Server-provided error messages aren't i18n'd.
              (leave (_ "build failed: ~a~%")
-                    (nix-protocol-error-message c))))
+                    (nix-protocol-error-message c)))
+            ((message-condition? c)
+             ;; Normally '&message' error conditions have an i18n'd message.
+             (leave (_ "~a~%") (gettext (condition-message c)))))
     ;; Catch EPIPE and the likes.
     (catch 'system-error
       thunk