Merge branch 'master' into core-updates

Conflicts:
	Makefile.am
	gnu/packages/autotools.scm
	gnu/packages/guile.scm
	gnu/packages/python.scm
	gnu/packages/shishi.scm
	guix/gnu-maintenance.scm
	guix/scripts/build.scm
	guix/scripts/gc.scm
	guix/scripts/package.scm
	guix/scripts/substitute-binary.scm
	guix/ui.scm
	nix/nix-daemon/guix-daemon.cc
	test-env.in
	tests/nar.scm
	tests/store.scm

Makefile.am

@@ -30,8 +30,10 @@ MODULES =					\
   guix/scripts/import.scm			\
   guix/scripts/package.scm			\
   guix/scripts/gc.scm				\
+  guix/scripts/hash.scm				\
   guix/scripts/pull.scm				\
   guix/scripts/substitute-binary.scm		\
+  guix/scripts/refresh.scm			\
   guix/base32.scm				\
   guix/utils.scm				\
   guix/serialization.scm			\
@@ -46,6 +48,8 @@ MODULES =					\
   guix/build-system/perl.scm			\
   guix/build-system/trivial.scm			\
   guix/ftp-client.scm				\
+  guix/web.scm					\
+  guix/gnupg.scm				\
   guix/store.scm				\
   guix/ui.scm					\
   guix/build/download.scm			\
@@ -327,6 +331,7 @@ EXTRA_DIST =					\
   .dir-locals.el				\
   hydra.scm					\
   build-aux/download.scm			\
+  build-aux/sync-synopses.scm			\
   srfi/srfi-64.scm				\
   srfi/srfi-64.upstream.scm			\
   tests/test.drv				\
@@ -374,3 +379,7 @@ AM_DISTCHECK_CONFIGURE_FLAGS =			\
   --with-libgcrypt-prefix="$(LIBGCRYPT_PREFIX)"	\
   --with-nix-prefix="$(NIX_PREFIX)"		\
   --enable-daemon
+
+dist-hook:
+	-$(top_builddir)/pre-inst-env $(GUILE)		\
+	   $(top_srcdir)/build-aux/sync-synopses.scm

README

@@ -51,6 +51,16 @@ The "autoreconf -vi" command can be used to generate the build system
 infrastructure; it reports an error if an inappropriate version of the
 above packages is being used.
 
+* Installing Guix from Guix
+
+You can re-build and re-install Guix using a system that already runs Guix.
+To do so:
+
+  - install the dependencies (see 'Requirements' above) using Guix
+  - re-run the configure script passing it the option
+    `--with-libgcrypt-prefix=$HOME/.guix-profile/'
+  - run "make" and "make install"
+
 * How It Works
 
 Guix does the high-level preparation of a /derivation/.  A derivation is

build-aux/sync-synopses.scm

@@ -0,0 +1,62 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 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/>.
+
+;;;
+;;; Report synopses that defer from those found in the GNU Womb.
+;;;
+
+(use-modules (guix gnu-maintenance)
+             (guix packages)
+             (guix utils)
+             (guix ui)
+             (gnu packages)
+             (srfi srfi-1)
+             (srfi srfi-26)
+             (ice-9 match))
+
+(define official
+  ;; GNU package descriptors from the Womb.
+  (official-gnu-packages))
+
+(define gnus
+  ;; GNU packages available in the distro.
+  (let ((lookup (lambda (p)
+                  (find (lambda (descriptor)
+                          (equal? (gnu-package-name descriptor)
+                                  (package-name p)))
+                        official))))
+    (fold-packages (lambda (package result)
+                     (or (and=> (lookup package)
+                                (cut alist-cons package <> result))
+                         result))
+                   '())))
+
+;; Iterate over GNU packages.  Report those whose synopsis defers from that
+;; found upstream.
+(for-each (match-lambda
+           ((package . descriptor)
+            (let ((upstream   (gnu-package-doc-summary descriptor))
+                  (downstream (package-synopsis package))
+                  (loc        (or (package-field-location package 'synopsis)
+                                  (package-location package))))
+              (unless (and upstream (string=? upstream downstream))
+                (format (guix-warning-port)
+                        "~a: ~a: proposed synopsis: ~s~%"
+                        (location->string loc) (package-name package)
+                        upstream)))))
+          gnus)

doc/guix.texi

@@ -141,8 +141,10 @@ Distribution}.
 @node Installation
 @chapter Installation
 
-This section describes the software requirements of Guix, as well as how
+GNU Guix is available for download from its website at
-to install it and get ready to use it.
+@url{http://www.gnu.org/software/guix/}.  This section describes the
+software requirements of Guix, as well as how to install it and get
+ready to use it.
 
 The build procedure for Guix is the same as for other GNU software, and
 is not covered here.  Please see the files @file{README} and
@@ -293,6 +295,10 @@ The following command-line options are supported:
 Take users from @var{group} to run build processes (@pxref{Setting Up
 the Daemon, build users}).
 
+@item --no-substitutes
+Do not use substitutes for build products.  That is, always build things
+locally instead of allowing downloads of pre-built binaries.
+
 @item --cache-failures
 Cache build failures.  By default, only successful builds are cached.
 
@@ -447,11 +453,8 @@ scripts, etc.  This direct correspondence allows users to make sure a
 given package installation matches the current state of their
 distribution, and helps maximize @dfn{reproducibility}.
 
-@c FIXME: Remove footnote when it's implemented.
 This foundation allows Guix to support @dfn{transparent binary/source
-deployment}@footnote{This feature is not implemented as of version
+deployment}.  When a pre-built binary for a @file{/nix/store} path is
-@value{VERSION}.  Please contact @email{bug-guix@@gnu.org} for more
-details.}.  When a pre-built binary for a @file{/nix/store} path is
 available from an external source, Guix just downloads it; otherwise, it
 builds the package from source, locally.
 
@@ -537,9 +540,10 @@ multiple-output package.
 @itemx -r @var{package}
 Remove @var{package}.
 
-@item --upgrade=@var{regexp}
+@item --upgrade[=@var{regexp}]
-@itemx -u @var{regexp}
+@itemx -u [@var{regexp}]
-Upgrade all the installed packages matching @var{regexp}.
+Upgrade all the installed packages.  When @var{regexp} is specified, upgrade
+only installed packages whose name matches @var{regexp}.
 
 Note that this upgrades package to the latest version of packages found
 in the distribution currently installed.  To update your distribution,
@@ -810,8 +814,9 @@ the GNU mirrors defined in @code{(guix download)}.
 The @code{sha256} field specifies the expected SHA256 hash of the file
 being downloaded.  It is mandatory, and allows Guix to check the
 integrity of the file.  The @code{(base32 @dots{})} form introduces the
-base32 representation of the hash.  A convenient way to obtain this
+base32 representation of the hash.  You can obtain this information with
-information is with the @code{guix download} tool.
+the @code{guix hash} (@pxref{Invoking guix hash}) and @code{guix
+download} tools.
 
 @item
 @cindex GNU Build System
@@ -1090,6 +1095,7 @@ space.
 
 @menu
 * Invoking guix build:: Building packages from the command line.
+* Invoking guix hash:: Computing the cryptographic hash of a file.
 @end menu
 
 @node Invoking guix build
@@ -1185,6 +1191,37 @@ the @code{package-derivation} procedure of the @code{(guix packages)}
 module, and to the @code{build-derivations} procedure of the @code{(guix
 store)} module.
 
+@node Invoking guix hash
+@section Invoking @command{guix hash}
+
+The @command{guix hash} command allows to check the integrity of a file.
+It is primarily a convenience tool for anyone contributing to the
+distribution: it computes the cryptographic hash of a file, which can be
+used in the definition of a package (@pxref{Defining Packages}).
+
+The general syntax is:
+
+@example
+guix hash @var{option} @var{file}
+@end example
+
+@command{guix hash} has the following option:
+
+@table @code
+
+@item --format=@var{fmt}
+@itemx -f @var{fmt}
+Write the hash in the given format.
+
+Supported formats: @code{nix-base32}, @code{base32}, @code{base16}
+(@code{hex} and @code{hexadecimal} can be used as well).
+
+If the @option{--format} option is not specified, @command{guix hash}
+will output the hash in @code{nix-base32}.  This representation is used
+in the definitions of packages.
+
+@end table
+
 @c *********************************************************************
 @node GNU Distribution
 @chapter GNU Distribution

gnu/packages.scm

@@ -19,6 +19,7 @@
 
 (define-module (gnu packages)
   #:use-module (guix packages)
+  #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 vlist)
@@ -90,9 +91,8 @@
                       result)
                     (const #f)                    ; skip
                     (lambda (path stat errno result)
-                      (format (current-error-port)
+                      (warning (_ "cannot access `~a': ~a~%")
-                              (_ "warning: cannot access `~a': ~a~%")
+                               path (strerror errno))
-                              path (strerror errno))
                       result)
                     '()
                     %distro-module-directory
@@ -110,14 +110,6 @@
                   (false-if-exception (resolve-interface name))))
               (package-files)))
 
-(define (fold2 f seed1 seed2 lst)
-  (if (null? lst)
-      (values seed1 seed2)
-      (call-with-values
-          (lambda () (f (car lst) seed1 seed2))
-        (lambda (seed1 seed2)
-          (fold2 f seed1 seed2 (cdr lst))))))
-
 (define (fold-packages proc init)
   "Call (PROC PACKAGE RESULT) for each available package, using INIT as
 the initial value of RESULT.  It is guaranteed to never traverse the

gnu/packages/algebra.scm

@@ -92,7 +92,7 @@ solve the shortest vector problem.")
         "18qf6jzz1r3mzb5qynywv4xx3z9g61hgkbpkdrhbgqh2g7jhgfc5"))))
     (build-system gnu-build-system)
     (home-page "http://www.gnu.org/software/gsl/")
-    (synopsis "The GNU Scientific Library, a large numerical library")
+    (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
@@ -177,7 +177,7 @@ PARI is also available as a C library to allow for faster computations.")
                                     (string-append "--prefix=" out)))))
                       %standard-phases)))
     (home-page "http://www.gnu.org/software/bc/")
-    (synopsis "GNU software calculator")
+    (synopsis "Arbitrary precision numeric processing language")
     (description
      "bc is an arbitrary precision numeric processing language. Syntax
 is similar to C, but differs in many substantial areas. It supports

gnu/packages/aspell.scm

@@ -38,8 +38,7 @@
     (build-system gnu-build-system)
     (inputs `(("perl" ,perl)))
     (home-page "http://aspell.net/")
-    (synopsis
+    (synopsis "Spell checker")
-     "GNU Aspell, A spell checker for many languages")
     (description
      "GNU Aspell is a free spell checker designed to eventually replace
 Ispell.  It can either be used as a library or as an independent spell

gnu/packages/autotools.scm

@@ -50,8 +50,7 @@
     (arguments `(#:tests? #f))
     (home-page
      "http://www.gnu.org/software/autoconf/")
-    (synopsis
+    (synopsis "Create source code configuration scripts")
-     "GNU Autoconf, a part of the GNU Build System")
     (description
      "GNU Autoconf is an extensible package of M4 macros that produce
 shell scripts to automatically configure software source code
@@ -149,8 +148,17 @@ exec ~a --no-auto-compile \"$0\" \"$@\"
        ("perl" ,perl)
        ("patch/skip-amhello"
         ,(search-patch "automake-skip-amhello-tests.patch"))))
+    (native-search-paths
+     (list (search-path-specification
+            (variable "ACLOCAL_PATH")
+            (directories '("share/aclocal")))))
     (arguments
      '(#:patches (list (assoc-ref %build-inputs "patch/skip-amhello"))
+       #:modules ((guix build gnu-build-system)
+                  (guix build utils)
+                  (srfi srfi-1)
+                  (srfi srfi-26)
+                  (rnrs io ports))
        #:phases (alist-cons-before
                  'patch-source-shebangs 'patch-tests-shebangs
                  (lambda _
@@ -163,15 +171,37 @@ exec ~a --no-auto-compile \"$0\" \"$@\"
                      ;; that occur during the test suite.
                      (setenv "SHELL" sh)
                      (setenv "CONFIG_SHELL" sh)))
-                 %standard-phases)))
-    (native-search-paths
-     (list (search-path-specification
-            (variable "ACLOCAL_PATH")
-            (directories '("share/aclocal")))))
 
+                 ;; Files like `install-sh', `mdate.sh', etc. must use
+                 ;; #!/bin/sh, otherwise users could leak erroneous shebangs
+                 ;; in the wild.  See <http://bugs.gnu.org/14201> for an
+                 ;; example.
+                 (alist-cons-after
+                  'install 'unpatch-shebangs
+                  (lambda* (#:key outputs #:allow-other-keys)
+                    (let* ((out (assoc-ref outputs "out"))
+                           (dir (string-append out "/share")))
+                      (define (starts-with-shebang? file)
+                        (equal? (call-with-input-file file
+                                  (lambda (p)
+                                    (list (get-u8 p) (get-u8 p))))
+                                (map char->integer '(#\# #\!))))
+
+                      (for-each (lambda (file)
+                                  (when (and (starts-with-shebang? file)
+                                             (executable-file? file))
+                                    (format #t "restoring shebang on `~a'~%"
+                                            file)
+                                    (substitute* file
+                                      (("^#!.*/bin/sh")
+                                       "#!/bin/sh")
+                                      (("^#!.*/bin/env(.*)$" _ args)
+                                       (string-append "#!/usr/bin/env"
+                                                      args)))))
+                                (find-files dir ".*"))))
+                  %standard-phases))))
     (home-page "http://www.gnu.org/software/automake/")
-    (synopsis
+    (synopsis "Making GNU standards-compliant Makefiles")
-     "GNU Automake, a GNU standard-compliant makefile generator")
     (description
      "GNU Automake is a tool for automatically generating
 `Makefile.in' files compliant with the GNU Coding
@@ -225,7 +255,7 @@ Standards.  Automake requires the use of Autoconf.")
                  %standard-phases)))
     (inputs `(("patch/skip-tests"
                ,(search-patch "libtool-skip-tests.patch"))))
-    (synopsis "GNU Libtool, a generic library support script")
+    (synopsis "Generic shared library support tools")
     (description
      "GNU libtool is a generic library support script.  Libtool hides the
 complexity of using shared libraries behind a consistent, portable interface.

gnu/packages/base.scm

@@ -18,7 +18,8 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages base)
-  #:use-module (guix licenses)
+  #:use-module ((guix licenses)
+                #:select (gpl3+ lgpl2.0+))
   #:use-module (gnu packages)
   #:use-module (gnu packages acl)
   #:use-module (gnu packages bash)
@@ -61,7 +62,7 @@
                   ,(string-append "--with-gawk="  ; for illustration purposes
                                  (assoc-ref %build-inputs "gawk")))))
    (inputs `(("gawk" ,gawk)))
-   (synopsis "GNU Hello")
+   (synopsis "Hello, GNU world: An example GNU package")
    (description "Yeah...")
    (home-page "http://www.gnu.org/software/hello/")
    (license gpl3+)))
@@ -78,7 +79,7 @@
              (base32
               "1qbjb1l7f9blckc5pqy8jlf6482hpx4awn2acmhyf5mv9wfq03p7"))))
    (build-system gnu-build-system)
-   (synopsis "GNU implementation of the Unix grep command")
+   (synopsis "Print lines matching a pattern")
    (description
     "The grep command searches one or more input files for lines containing a
 match to a specified pattern.  By default, grep prints the matching
@@ -98,7 +99,7 @@ lines.")
              (base32
               "1myvrmh99jsvk7v3d7crm0gcrq51hmmm1r2kjyyci152in1x2j7h"))))
    (build-system gnu-build-system)
-   (synopsis "GNU sed, a batch stream editor")
+   (synopsis "Stream editor")
    (arguments
     `(#:phases (alist-cons-before
                 'patch-source-shebangs 'patch-test-suite
@@ -134,7 +135,7 @@ substituting multiple occurrences of a string within a file.")
    (inputs `(("patch/gets" ,(search-patch "tar-gets-undeclared.patch"))))
    (arguments
     `(#:patches (list (assoc-ref %build-inputs "patch/gets"))))
-   (synopsis "GNU implementation of the `tar' archiver")
+   (synopsis "Managing tar archives")
    (description
     "The Tar program provides the ability to create tar archives, as well as
 various other kinds of manipulation.  For example, you can use Tar on
@@ -167,7 +168,7 @@ files (as archives).")
     ;; TODO: When cross-compiling, add this:
     ;;  '(#:configure-flags '("ac_cv_func_strnlen_working=yes"))
     )
-   (synopsis "GNU Patch, a program to apply differences to files")
+   (synopsis "Apply differences to originals, with optional backups")
    (description
     "GNU Patch takes a patch file containing a difference listing produced by
 the diff program and applies those differences to one or more original files,
@@ -190,7 +191,7 @@ producing patched versions.")
    (inputs `(("patch/gets"
               ,(search-patch "diffutils-gets-undeclared.patch"))))
    (arguments `(#:patches (list (assoc-ref %build-inputs "patch/gets"))))
-   (synopsis "Programs to find differences among text files")
+   (synopsis "Comparing and merging files")
    (description
     "GNU Diffutils is a package of several programs related to finding
 differences between files.
@@ -243,8 +244,7 @@ You can use the sdiff command to merge two files interactively.")
     ;; `(#:configure-flags '("gl_cv_func_wcwidth_works=yes")
     ;;   ,@(arguments cross-system))
     )
-   (synopsis "Basic directory searching utilities of the GNU operating
+   (synopsis "Operating on files matching given criteria")
-system")
    (description
     "The GNU Find Utilities are the basic directory searching utilities of
 the GNU operating system.  These programs are typically used in conjunction
@@ -291,9 +291,7 @@ The tools supplied with this package are:
                       (("#!/bin/sh")
                        (format #f "#!~a/bin/bash" bash)))))
                 %standard-phases)))
-   (synopsis
+   (synopsis "Core GNU utilities (file, text, shell)")
-    "The basic file, shell and text manipulation utilities of the GNU
-operating system")
    (description
     "The GNU Core Utilities are the basic file, shell and text manipulation
 utilities of the GNU operating system.  These are the core utilities which
@@ -327,8 +325,7 @@ are expected to exist on every operating system.")
                        (format #f "default_shell[] = \"~a/bin/bash\";\n"
                                bash)))))
                 %standard-phases)))
-   (synopsis "GNU Make, a program controlling the generation of non-source
+   (synopsis "Remake files automatically")
-files from sources")
    (description
     "Make is a tool which controls the generation of executables and other
 non-source files of a program from the program's source files.
@@ -374,8 +371,7 @@ that it is possible to use Make to build and install the program.")
                           ;; expression >= 0 is always true" in wchar.h.
                           "--disable-werror")))
 
-   (synopsis "GNU Binutils, tools for manipulating binaries (linker,
+   (synopsis "Binary utilities: bfd gas gprof ld")
-assembler, etc.)")
    (description
     "The GNU Binutils are a collection of binary tools.  The main ones are
 `ld' (the GNU linker) and `as' (the GNU assembler).  They also include the
@@ -383,6 +379,17 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
    (license gpl3+)
    (home-page "http://www.gnu.org/software/binutils/")))
 
+(define-public binutils-2.23
+  (package (inherit binutils)
+    (version "2.23.2")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "mirror://gnu/binutils/binutils-"
+                                 version ".tar.bz2"))
+             (sha256
+              (base32
+               "15qhbkz3r266xaa52slh857qn3abw7rb2x2jnhpfrafpzrb4x4gy"))))))
+
 (define-public glibc
   (package
    (name "glibc")
@@ -958,6 +965,35 @@ store.")
               ,@(fold alist-delete (package-inputs ld-wrapper-boot3)
                       '("guile" "bash"))))))
 
+(define-public ld-wrapper-2.23         ; TODO: remove when Binutils is updated
+  (package (inherit ld-wrapper)
+    (inputs `(("binutils" ,binutils-2.23)
+              ,@(alist-delete "binutils" (package-inputs ld-wrapper))))))
+
+(define-public gcc-4.8
+  ;; FIXME: Move to gcc.scm when Binutils is updated.
+  (package (inherit gcc-4.7)
+    (version "4.8.0")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "mirror://gnu/gcc/gcc-"
+                                 version "/gcc-" version ".tar.bz2"))
+             (sha256
+              (base32
+               "0b6cp9d1sas3vq6dj3zrgd134p9b569fqhbixb9cl7mp698zwdxh"))))
+    (inputs `(("gmp" ,gmp)
+              ("mpfr" ,mpfr)
+              ("mpc" ,mpc)
+              ("isl" ,isl)
+              ("cloog" ,cloog)
+              ("zlib" ,(@ (gnu packages compression) zlib))
+
+              ;; With ld from Binutils 2.22, we get the following error while
+              ;; linking gcov:
+              ;; ld: gcov: hidden symbol `__deregister_frame_info' in /nix/store/47myfniw4x7kfc601d7q1yvz5mixlr00-gcc-4.7.2/lib/gcc/x86_64-unknown-linux-gnu/4.7.2/libgcc_eh.a(unwind-dw2-fde-dip.o) is referenced by DSO
+              ;; See <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=57015>.
+              ("ld-wrapper" ,ld-wrapper-2.23)))))
+
 (define-public %final-inputs
   ;; Final derivations used as implicit inputs by `gnu-build-system'.
   (let ((finalize (cut package-with-explicit-inputs <> %boot4-inputs

gnu/packages/bash.scm

@@ -76,7 +76,7 @@
         #:phases (alist-cons-after 'install 'post-install
                                    ,post-install-phase
                                    %standard-phases)))
-     (synopsis "GNU Bourne-Again Shell")
+     (synopsis "The GNU Bourne-Again SHell")
      (description
       "Bash is the shell, or command language interpreter, that will appear in
 the GNU operating system.  Bash is an sh-compatible shell that incorporates

gnu/packages/bison.scm

@@ -40,8 +40,7 @@
     (inputs `(("perl" ,perl)))
     (propagated-inputs `(("m4" ,m4)))
     (home-page "http://www.gnu.org/software/bison/")
-    (synopsis
+    (synopsis "Parser generator")
-     "GNU Bison, a Yacc-compatible parser generator")
     (description
      "Bison is a general-purpose parser generator that converts an
 annotated context-free grammar into an LALR(1) or GLR parser for

gnu/packages/cdrom.scm

@@ -78,7 +78,7 @@ caching facility provided by the library.")
        ("pkg-config" ,pkg-config)
        ("libcddb" ,libcddb)))
     (home-page "http://www.gnu.org/software/libcdio/")
-    (synopsis "A library for OS-independent CD-ROM and CD image access")
+    (synopsis "CD Input and Control library")
     (description
      "GNU libcdio is a library for OS-idependent CD-ROM and CD image access.
 It includes a library for working with ISO-9660 filesystems (libiso9660), as
@@ -88,14 +88,14 @@ well as utility programs such as an audio CD player and an extractor.")
 (define-public xorriso
   (package
     (name "xorriso")
-    (version "1.2.4")
+    (version "1.2.8")
     (source (origin
              (method url-fetch)
              (uri (string-append "mirror://gnu/xorriso/xorriso-"
                                  version ".tar.gz"))
              (sha256
               (base32
-               "1b2xh2x9fz4ihwfrmjzhbkfsrwi9c3zpmchgk7hqlkydzfgydwz8"))))
+               "1h3w9ymhsi0wghcnl7mmlml40rm4yill1c75g90xc7r1a2g8k1mn"))))
     (build-system gnu-build-system)
     (inputs
      `(("acl" ,acl)
@@ -104,7 +104,7 @@ well as utility programs such as an audio CD player and an extractor.")
        ("zlib" ,zlib)
        ("libcdio" ,libcdio)))
     (home-page "http://www.gnu.org/software/xorriso/")
-    (synopsis "An ISO 9660 Rock Ridge file system manipulator")
+    (synopsis "Create, manipulate, burn ISO-9660 filesystems")
     (description
      "GNU xorriso copies file objects from POSIX compliant filesystems into
 Rock Ridge enhanced ISO 9660 filesystems and allows session-wise manipulation

gnu/packages/cflow.scm

@@ -36,7 +36,7 @@
                "1jkbq97ajcf834z68hbn3xfhiz921zhn39gklml1racf0kb3jzh3"))))
     (build-system gnu-build-system)
     (home-page "http://www.gnu.org/software/cflow/")
-    (synopsis "A tool to analyze the control flow of C programs")
+    (synopsis "Create a graph of control flow within a program")
     (description
      "GNU cflow analyzes a collection of C source files and prints a
 graph, charting control flow within the program.

gnu/packages/compression.scm

@@ -73,7 +73,7 @@ in compression.")
              (base32
               "18rm80kar7n016g8bsyy1a3zk50i2826xdgs874yh64rzj7nxmdm"))))
    (build-system gnu-build-system)
-   (synopsis "Gzip, the GNU zip compression program")
+   (synopsis "General file (de)compression (using lzw)")
    (arguments
     ;; FIXME: The test suite wants `less', and optionally Perl.
     '(#:tests? #f))

gnu/packages/cpio.scm

@@ -42,8 +42,7 @@
     (inputs
      `(("patch/gets" ,(search-patch "cpio-gets-undeclared.patch"))))
     (home-page "https://www.gnu.org/software/cpio/")
-    (synopsis
+    (synopsis "Manage cpio and tar file archives")
-     "A program to create or extract from cpio archives")
     (description
      "GNU Cpio copies files into or out of a cpio or tar archive. The
 archive can be another file on the disk, a magnetic tape, or a pipe.
@@ -55,4 +54,4 @@ default, cpio creates binary format archives, for compatibility with
 older cpio programs. When extracting from archives, cpio automatically
 recognizes which kind of archive it is reading and can read archives
 created on machines with a different byte-order.")
-    (license gpl3+)))
+    (license gpl3+)))

gnu/packages/cppi.scm

@@ -35,7 +35,7 @@
                "1jk42cjaggk71rimjnx3qpmb6hivps0917vl3z7wbxk3i2whb98j"))))
     (build-system gnu-build-system)
     (home-page "http://www.gnu.org/software/cppi/")
-    (synopsis "A cpp directive indenter")
+    (synopsis "Indent C preprocessor directives to reflect nesting and more")
     (description
      "GNU cppi indents C preprocessor directives to reflect their nesting and
 ensure that there is exactly one space character between each #if, #elif,

gnu/packages/ddrescue.scm

@@ -37,7 +37,7 @@
     (build-system gnu-build-system)
     (home-page
      "http://www.gnu.org/software/ddrescue/ddrescue.html")
-    (synopsis "GNU Ddrescue, a data recovery tool")
+    (synopsis "Data recovery utility")
     (description
      "GNU Ddrescue is a data recovery tool.  It copies data from one
 file or block device (e.g., hard disk, CD-ROM) to another, trying hard to

gnu/packages/dejagnu.scm

@@ -26,7 +26,7 @@
 (define-public dejagnu
   (package
     (name "dejagnu")
-    (version "1.5")
+    (version "1.5.1")
     (source
      (origin
       (method url-fetch)
@@ -34,7 +34,7 @@
                           version ".tar.gz"))
       (sha256
        (base32
-        "1nx3x3h96a82q92q108q71giv2nz9xmbbn2nrlr3wvvs6l45id68"))))
+        "1lik8h4qi7x0mhsi8xmj91an1yb63rjbk6v4xrmzgiy5lk8lgrv0"))))
     (build-system gnu-build-system)
     (inputs `(("expect" ,expect)))
     (arguments
@@ -75,7 +75,7 @@
                   %standard-phases))))
     (home-page
      "http://www.gnu.org/software/dejagnu/")
-    (synopsis "The DejaGNU testing framework")
+    (synopsis "GNU software testing framework")
     (description
      "DejaGnu is a framework for testing other programs.  Its purpose
 is to provide a single front end for all tests.  Think of it as a

gnu/packages/ed.scm

@@ -26,14 +26,14 @@
 (define-public ed
   (package
     (name "ed")
-    (version "1.6")
+    (version "1.8")
     (source (origin
              (method url-fetch)
              (uri (string-append "mirror://gnu/ed/ed-"
                                  version ".tar.gz"))
              (sha256
               (base32
-               "0rcay0wci2kiwil2h505b674cblmn4nq8pqw9g9pgqmaqjq6f711"))))
+               "0wvj190ky5i0gm0pilx9k75l6alyc6h5s14fm3dbk90y7g9kihb4"))))
     (build-system gnu-build-system)
     (arguments
      '(#:configure-flags '("CC=gcc")
@@ -43,8 +43,7 @@
                                        (("/bin/sh") (which "sh"))))
                                    %standard-phases)))
     (home-page "http://www.gnu.org/software/ed/")
-    (synopsis
+    (synopsis "Line-oriented text editor")
-     "GNU ed, an implementation of the standard Unix editor")
     (description
      "GNU ed is a line-oriented text editor.  It is used to create,
 display, modify and otherwise manipulate text files, both

gnu/packages/emacs.scm

@@ -90,8 +90,7 @@
        ("patch/epaths" ,(search-patch "emacs-configure-sh.patch"))
        ))
     (home-page "http://www.gnu.org/software/emacs/")
-    (synopsis
+    (synopsis "The extensible, customizable, self-documenting text editor")
-     "GNU Emacs 24, the extensible, customizable text editor")
     (description
      "GNU Emacs is an extensible, customizable text editor—and more.  At its
 core is an interpreter for Emacs Lisp, a dialect of the Lisp

gnu/packages/fdisk.scm

@@ -46,9 +46,8 @@
        ("util-linux" ,util-linux)
        ("parted" ,parted)))
     (home-page "https://www.gnu.org/software/fdisk/")
-    (synopsis
+    (synopsis "Low-level disk partitioning and formatting")
-     "GNU Fdisk, a command-line disk partitioning tool")
     (description
      "GNU Fdisk provides alternatives to util-linux fdisk and util-linux
 cfdisk.  It uses GNU Parted.")
-    (license gpl3+)))
+    (license gpl3+)))

gnu/packages/gawk.scm

@@ -51,7 +51,7 @@
                 %standard-phases)))
    (inputs `(("libsigsegv" ,libsigsegv)))
    (home-page "http://www.gnu.org/software/gawk/")
-   (synopsis "GNU implementation of the Awk programming language")
+   (synopsis "A text scanning and processing language")
    (description
     "Many computer users need to manipulate text files: extract and then
 operate on data from parts of certain lines while discarding the rest, make

gnu/packages/gcc.scm

@@ -17,7 +17,8 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages gcc)
-  #:use-module (guix licenses)
+  #:use-module ((guix licenses)
+                #:select (gpl3+ gpl2+ lgpl2.1+ lgpl2.0+))
   #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
   #:use-module (gnu packages compression)
@@ -140,7 +141,7 @@
              (directories '("lib" "lib64")))))
 
      (properties `((gcc-libc . ,(assoc-ref inputs "libc"))))
-     (synopsis "The GNU Compiler Collection")
+     (synopsis "GNU Compiler Collection")
      (description
       "The GNU Compiler Collection includes compiler front ends for C, C++,
 Objective-C, Fortran, OpenMP for C/C++/Fortran, Java, and Ada, as well as

gnu/packages/gdb.scm

@@ -57,7 +57,7 @@
        ("texinfo" ,texinfo)
        ("dejagnu" ,dejagnu)))
     (home-page "http://www.gnu.org/software/gdb/")
-    (synopsis "GDB, the GNU Project debugger")
+    (synopsis "The GNU debugger")
     (description
      "GDB, the GNU Project debugger, allows you to see what is going
 on `inside' another program while it executes -- or what another

gnu/packages/gdbm.scm

@@ -37,7 +37,8 @@
     (arguments `(#:configure-flags '("--enable-libgdbm-compat")))
     (build-system gnu-build-system)
     (home-page "http://www.gnu.org/software/gdbm/")
-    (synopsis "GNU dbm key/value database library")
+    (synopsis
+     "Hash library of database functions compatible with traditional dbm")
     (description
      "GNU dbm (or GDBM, for short) is a library of database functions
 that use extensible hashing and work similar to the standard UNIX dbm.

gnu/packages/gettext.scm

@@ -56,8 +56,7 @@
         ,(search-patch "gettext-gets-undeclared.patch"))))
     (home-page
      "http://www.gnu.org/software/gettext/")
-    (synopsis
+    (synopsis "Tools and documentation for translation")
-     "GNU gettext, a well integrated set of translation tools and documentation")
     (description
      "Usually, programs are written and documented in English, and use
 English at execution time for interacting with users.  Using a common

gnu/packages/ghostscript.scm

@@ -163,7 +163,7 @@ printing, and psresize, for adjusting page sizes.")
           (apply install args)
           (system* "make" "install-so")))
       %standard-phases)))))
-   (synopsis "GNU Ghostscript, an interpreter for the PostScript language and for PDF")
+   (synopsis "PostScript and PDF interpreter")
    (description
     "GNU Ghostscript is an interpreter for PostScript and Portable Document
 Format (PDF) files.

gnu/packages/glib.scm

@@ -121,7 +121,7 @@ shared NFS home directories.")
       #:configure-flags (list (string-append "--with-html-dir="
                                              (assoc-ref %outputs "doc")
                                              "/share/gtk-doc"))))
-   (synopsis "C library that provides core application building blocks")
+   (synopsis "Thread-safe general utility library; basis of GTK+ and GNOME")
    (description
     "GLib provides data structure handling for C, portability wrappers,
 and interfaces for such runtime functionality as an event loop, threads,

gnu/packages/global.scm

@@ -44,7 +44,7 @@
        (list (string-append "--with-ncurses="
                             (assoc-ref %build-inputs "ncurses")))))
     (home-page "http://www.gnu.org/software/global/")
-    (synopsis "GNU GLOBAL source code tag system")
+    (synopsis "Cross-environment source code tag system")
     (description
      "GNU GLOBAL is a source code tagging system that works the same way
 across diverse environments (Emacs, vi, less, Bash, web browser, etc).

gnu/packages/gnupg.scm

@@ -57,20 +57,19 @@ Daemon and possibly more in the future.")
 (define-public libgcrypt
   (package
     (name "libgcrypt")
-    (version "1.5.1")
+    (version "1.5.2")
     (source (origin
              (method url-fetch)
              (uri (string-append "mirror://gnupg/libgcrypt/libgcrypt-"
                                  version ".tar.bz2"))
              (sha256
               (base32
-               "09z5zbxhvg6c7n8qcm8h9ygr28qli2n83hfq1f69jsg711cb37md"))))
+               "0gwnzqd64cpwdmk93nll54nidsr74jpimxzj4p4z7502ylwl66p4"))))
     (build-system gnu-build-system)
     (propagated-inputs
      `(("libgpg-error" ,libgpg-error)))
     (home-page "http://gnupg.org/")
-    (synopsis
+    (synopsis "Cryptographic function library")
-     "GNU Libgcrypt, a general-pupose cryptographic library")
     (description
      "GNU Libgcrypt is a general purpose cryptographic library based on
 the code from GnuPG.  It provides functions for all
@@ -166,8 +165,7 @@ specifications are building blocks of S/MIME and TLS.")
            (apply configure args)))
        %standard-phases)))
     (home-page "http://gnupg.org/")
-    (synopsis
+    (synopsis "GNU Privacy Guard")
-     "GNU Privacy Guard (GnuPG), GNU Project's implementation of the OpenPGP standard")
     (description
      "GnuPG is the GNU project's complete and free implementation of
 the OpenPGP standard as defined by RFC4880.  GnuPG allows to

gnu/packages/gnutls.scm

@@ -31,7 +31,7 @@
 (define-public libtasn1
   (package
     (name "libtasn1")
-    (version "3.2")
+    (version "3.3")
     (source
      (origin
       (method url-fetch)
@@ -39,10 +39,10 @@
                           version ".tar.gz"))
       (sha256
        (base32
-        "0gvgndypwicchf7m660zh7jdgmkfj9g9xavpcc08pyd0120y0bk7"))))
+        "1h1sz5py8zlg4yczybr6wa925pyadvjcxrdmhilwaqqgs4n2lrcj"))))
     (build-system gnu-build-system)
     (home-page "http://www.gnu.org/software/libtasn1/")
-    (synopsis "GNU Libtasn1, an ASN.1 library")
+    (synopsis "ASN.1 library")
     (description
      "Libtasn1 is the ASN.1 library used by GnuTLS, GNU Shishi and some
 other packages.  The goal of this implementation is to be highly
@@ -73,7 +73,7 @@ portable, and only require an ANSI C89 platform.")
        ("nettle" ,nettle)
        ("which" ,which)))
     (home-page "http://www.gnu.org/software/gnutls/")
-    (synopsis "The GNU Transport Layer Security Library")
+    (synopsis "Transport layer security library")
     (description
      "GnuTLS is a project that aims to develop a library which provides
 a secure layer, over a reliable transport layer. Currently the GnuTLS

gnu/packages/gperf.scm

@@ -37,8 +37,7 @@
     (build-system gnu-build-system)
     (arguments '(#:parallel-tests? #f))
     (home-page "http://www.gnu.org/software/gperf/")
-    (synopsis
+    (synopsis "Perfect hash function generator")
-     "GNU gperf, a perfect hash function generator")
     (description
      "GNU gperf is a perfect hash function generator.  For a given
 list of strings, it produces a hash function and hash table, in

gnu/packages/gprolog.scm

@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,15 +26,15 @@
 (define-public gprolog
   (package
     (name "gprolog")
-    (version "1.4.2")
+    (version "1.4.3")
     (source
      (origin
       (method url-fetch)
-      (uri (string-append "http://www.gprolog.org/gprolog-"
+      (uri (string-append "mirror://gnu/gprolog/gprolog-" version
-                          version ".tar.gz"))
+                          ".tar.gz"))
       (sha256
        (base32
-        "0y25c2gwz41i6g28qyfjklrmanzgk0c8cr4jn2s7s8qgd9dnm1fm"))))
+        "16yl6q9ydx9d8lphg9xkk53l1m0fq0kpvrhry8njsxhhncazm4j2"))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases (alist-cons-before
@@ -45,9 +46,7 @@
                      (("= /bin/sh") (string-append "= " (which "sh")))))
                  %standard-phases)))
     (home-page "https://www.gnu.org/software/gprolog/")
-    (synopsis
+    (synopsis "Prolog compiler")
-     "GNU Prolog, a free Prolog compiler with constraint solving over
-finite domains")
     (description
      "GNU Prolog is a free Prolog compiler with constraint solving over
 finite domains developed by Daniel Diaz.
@@ -69,4 +68,4 @@ interface, sockets).
 GNU Prolog also includes an efficient constraint solver over finite domains.
 This opens contraint logic programming to the user combining the power of
 constraint programming to the declarativity of logic programming.")
-    (license (list gpl2+ lgpl3+))))
+    (license (list gpl2+ lgpl3+))))

gnu/packages/groff.scm

@@ -31,13 +31,13 @@
 (define-public groff
   (package
    (name "groff")
-   (version "1.22.1")
+   (version "1.22.2")
    (source (origin
             (method url-fetch)
             (uri (string-append "mirror://gnu/groff/groff-" version
                                 ".tar.gz"))
             (sha256 (base32
-                     "1kihja9sj182pqms8lah2nn3y96rqccws7w04f7f7wpy84vs5bvn"))))
+                     "0xi07nhj5vdgax37rj25mwxzdmsz1ifx50hjgc6hqbkpqkd6821q"))))
    (build-system gnu-build-system)
    (inputs `(("bison" ,bison)
              ("ghostscript" ,ghostscript)
@@ -45,7 +45,7 @@
              ("perl" ,perl)
              ("psutils" ,psutils)
              ("texinfo" ,texinfo)))
-   (synopsis "GNU Troff text formatting system")
+   (synopsis "Typesetting from plain text mixed with formatting commands")
    (description
     "GNU Troff (Groff) is a software typesetting package which reads plain
 text mixed with formatting commands and produces formatted output.")

gnu/packages/grub.scm

@@ -73,8 +73,7 @@
        ("qemu" ,qemu)
        ("xorriso" ,xorriso)))
     (home-page "http://www.gnu.org/software/grub/")
-    (synopsis
+    (synopsis "GRand unified boot loader")
-     "GNU GRUB, the Grand Unified Boot Loader (2.x beta)")
     (description
      "GNU GRUB is a Multiboot boot loader. It was derived from GRUB, GRand
 Unified Bootloader, which was originally designed and implemented by Erich

gnu/packages/gsasl.scm

@@ -61,7 +61,7 @@
              ("shishi" ,shishi)
              ("zlib" ,guix:zlib)
             ))
-   (synopsis "GNU GSS (Generic Security Service), a free implementatio of RFC 2743/2744")
+   (synopsis "Generic Security Service library")
    (description
     "GNU GSS is an implementation of the Generic Security Service Application
 Program Interface (GSS-API). GSS-API is used by network servers to provide
@@ -87,7 +87,7 @@ SMTP/IMAP servers. GSS consists of a library and a manual.")
              ("gss" ,gss)
              ("zlib" ,guix:zlib)
              ))
-   (synopsis "GNU SASL, an implementation of the Simple Authentication and Security Layer framework")
+   (synopsis "Simple Authentication and Security Layer library")
    (description
     "GNU SASL is an implementation of the Simple Authentication and Security
 Layer framework and a few common SASL mechanisms. SASL is used by network

gnu/packages/guile.scm

@@ -93,7 +93,7 @@
            (variable "GUILE_LOAD_PATH")
            (directories '("share/guile/site")))))
 
-   (synopsis "GNU Guile 1.8, an embeddable Scheme interpreter")
+   (synopsis "Scheme implementation intended especially for extensions")
    (description
 "GNU Guile 1.8 is an interpreter for the Scheme programming language,
 packaged as a library that can be embedded into programs to make them
@@ -104,14 +104,14 @@ extensible.  It supports many SRFIs.")
 (define-public guile-2.0
   (package
    (name "guile")
-   (version "2.0.7")
+   (version "2.0.9")
    (source (origin
             (method url-fetch)
             (uri (string-append "mirror://gnu/guile/guile-" version
                                 ".tar.xz"))
             (sha256
              (base32
-              "0f53pxkia4v17n0avwqlcjpy0n89hkazm2xsa6p84lv8k6k8y9vg"))))
+              "0nw9y8vjyz4r61v06p9msks5lm58pd91irmzg4k487vmv743h2pp"))))
    (build-system gnu-build-system)
    (native-inputs `(("pkgconfig" ,pkg-config)))
    (inputs `(("libffi" ,libffi)
@@ -150,7 +150,7 @@ extensible.  It supports many SRFIs.")
            (variable "GUILE_LOAD_COMPILED_PATH")
            (directories '("share/guile/site/2.0")))))
 
-   (synopsis "GNU Guile 2.0, an embeddable Scheme implementation")
+   (synopsis "Scheme implementation intended especially for extensions")
    (description
 "GNU Guile is an implementation of the Scheme programming language, with
 support for many SRFIs, packaged for use in a wide variety of environments.
@@ -164,7 +164,15 @@ call interface, and powerful string processing.")
 (define-public guile-2.0/fixed
   ;; A package of Guile 2.0 that's rarely changed.  It is the one used
   ;; in the `base' module, and thus changing it entails a full rebuild.
-  guile-2.0)
+  (package (inherit guile-2.0)
+    (version "2.0.7")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "mirror://gnu/guile/guile-" version
+                                 ".tar.xz"))
+             (sha256
+              (base32
+               "0f53pxkia4v17n0avwqlcjpy0n89hkazm2xsa6p84lv8k6k8y9vg"))))))
 
 
 ;;;
@@ -244,8 +252,7 @@ many readers as needed).")
                                out)))))
                  %standard-phases)))
     (home-page "http://www.gnu.org/software/guile-ncurses/")
-    (synopsis
+    (synopsis "Guile bindings to ncurses")
-     "GNU Guile-Ncurses, Scheme interface to the NCurses libraries")
     (description
      "GNU Guile-Ncurses is a library for the Guile Scheme interpreter that
 provides functions for creating text user interfaces.  The text user interface
@@ -271,8 +278,7 @@ menu.")
      `(("ed" ,ed) ("which" ,which) ("guile" ,guile-1.8)
        ("patch/install" ,(search-patch "mcron-install.patch"))))
     (home-page "http://www.gnu.org/software/mcron/")
-    (synopsis
+    (synopsis "Run jobs at scheduled times")
-     "GNU mcron, a flexible implementation of `cron' in Guile")
     (description
      "The GNU package mcron (Mellor's cron) is a 100% compatible replacement
 for Vixie cron.  It is written in pure Guile, and allows configuration files

gnu/packages/help2man.scm

@@ -45,7 +45,7 @@
        ;; ("gettext" ,gettext)
        ))
     (home-page "http://www.gnu.org/software/help2man/")
-    (synopsis "GNU help2man generates man pages from `--help' output")
+    (synopsis "Automatically generate man pages from program --help")
     (description
      "help2man produces simple manual pages from the ‘--help’ and
 ‘--version’ output of other commands.")

gnu/packages/idutils.scm

@@ -42,7 +42,7 @@
                ,(search-patch "diffutils-gets-undeclared.patch"))))
     (arguments `(#:patches (list (assoc-ref %build-inputs "patch/gets"))))
     (home-page "http://www.gnu.org/software/idutils/")
-    (synopsis "GNU Idutils, a text searching utility")
+    (synopsis "Identifier database utilities")
     (description
      "An \"ID database\" is a binary file containing a list of file
 names, a list of tokens, and a sparse matrix indicating which

gnu/packages/indent.scm

@@ -34,7 +34,7 @@
             (sha256 (base32
                      "0f9655vqdvfwbxvs1gpa7py8k1z71aqh8hp73f65vazwbfz436wa"))))
    (build-system gnu-build-system)
-   (synopsis "GNU Indent, a program for code indentation and formatting")
+   (synopsis "Code reformatter")
    (description
     "GNU Indent can be used to make code easier to read. It can also convert
 from one style of writing C to another. Indent understands a substantial

gnu/packages/less.scm

@@ -38,9 +38,7 @@
     (build-system gnu-build-system)
     (inputs `(("ncurses" ,ncurses)))
     (home-page "https://www.gnu.org/software/less/")
-    (synopsis
+    (synopsis "Paginator for terminals")
-     "GNU less is a program similar to more, but which allows backward
-movement in the file as well as forward movement")
     (description
      "GNU less is a program similar to more, but which allows backward
 movement in the file as well as forward movement. Also, less does not
@@ -48,4 +46,4 @@ have to read the entire input file before starting, so with large input
 files it starts up faster than text editors like vi. Less uses
 termcap (or terminfo on some systems), so it can run on a variety of
 terminals. There is even limited support for hardcopy terminals.")
-    (license gpl3+))) ; some files are under GPLv2+
+    (license gpl3+))) ; some files are under GPLv2+

gnu/packages/libidn.scm

@@ -35,7 +35,7 @@
                      "0g657kv60rh486m7bwyp5k24ljmym4wnb8nmk6d3i3qgr1qlqbqa"))))
    (build-system gnu-build-system)
 ;; FIXME: No Java and C# libraries are currently built.
-   (synopsis "GNU Libidn, a library to encode and decode internationalised domain names")
+   (synopsis "Internationalized string processing library")
    (description
     "GNU Libidn is a fully documented implementation of the Stringprep,
 Punycode and IDNA specifications. Libidn's purpose is to encode and decode

gnu/packages/libsigsegv.scm

@@ -35,7 +35,7 @@
              (base32 "16hrs8k3nmc7a8jam5j1fpspd6sdpkamskvsdpcw6m29vnis8q44"))))
    (build-system gnu-build-system)
    (home-page "http://www.gnu.org/software/libsigsegv/")
-   (synopsis "GNU libsigsegv, a library to handle page faults in user mode")
+   (synopsis "Library for handling page faults")
    (description
 "GNU libsigsegv is a library for handling page faults in user mode. A page
 fault occurs when a program tries to access to a region of memory that is

gnu/packages/libunistring.scm

@@ -36,7 +36,7 @@
               "18q620269xzpw39dwvr9zpilnl2dkw5z5kz3mxaadnpv4k3kw3b1"))))
    (propagated-inputs '())                  ; FIXME: add libiconv when !glibc
    (build-system gnu-build-system)
-   (synopsis "GNU Libunistring, a Unicode string library")
+   (synopsis "C library for manipulating Unicode strings")
    (description
     "This library provides functions for manipulating Unicode strings and for
 manipulating C strings according to the Unicode standard.

gnu/packages/linux.scm

@@ -193,7 +193,7 @@
                   'install ,install-phase
                   (alist-delete 'configure %standard-phases)))
        #:tests? #f))
-    (synopsis "GNU Linux-Libre kernel")
+    (synopsis "100% free redistribution of a cleaned Linux kernel")
     (description "Linux-Libre operating system kernel.")
     (license gpl2)
     (home-page "http://www.gnu.org/software/linux-libre/"))))

gnu/packages/lsh.scm

@@ -117,8 +117,7 @@
              (which "cat"))))
         %standard-phases)))
     (home-page "http://www.lysator.liu.se/~nisse/lsh/")
-    (synopsis
+    (synopsis "GNU implementation of the Secure Shell (ssh) protocols")
-     "GNU lsh, a GPL'd implementation of the SSH protocol")
     (description
      "lsh is a free implementation (in the GNU sense) of the ssh
 version 2 protocol, currently being standardised by the IETF

gnu/packages/m4.scm

@@ -61,7 +61,7 @@
              ("patch/readlink-EINVAL"
               ,(search-patch "m4-readlink-EINVAL.patch"))
              ("patch/gets" ,(search-patch "m4-gets-undeclared.patch"))))
-   (synopsis "GNU M4, a macro processor")
+   (synopsis "Macro processor")
    (description
     "GNU M4 is an implementation of the traditional Unix macro processor.  It
 is mostly SVR4 compatible although it has some extensions (for example,

gnu/packages/mailutils.scm

@@ -82,7 +82,7 @@
        ("patch/gets-undeclared"
         ,(search-patch "m4-gets-undeclared.patch"))))
     (home-page "http://www.gnu.org/software/mailutils/")
-    (synopsis "A rich and powerful protocol-independent mail framework")
+    (synopsis "Utilities and library for reading and serving mail")
     (description
      "GNU Mailutils is a rich and powerful protocol-independent mail
 framework.  It contains a series of useful mail libraries, clients, and

gnu/packages/multiprecision.scm

@@ -43,7 +43,7 @@
                   ;; sub-architectures.
                   "--enable-fat"
                   "--enable-cxx")))
-   (synopsis "GMP, the GNU multiple precision arithmetic library")
+   (synopsis "Multiple-precision arithmetic library")
    (description
     "GMP is a free library for arbitrary precision arithmetic, operating on
 signed integers, rational numbers, and floating point numbers.  There is no
@@ -79,8 +79,7 @@ faster algorithms.")
                      "0fs501qi8l523gs3cpy4jjcnvwxggyfbklcys80wq236xx3hz79r"))))
    (build-system gnu-build-system)
    (propagated-inputs `(("gmp" ,gmp)))            ; <mpfr.h> refers to <gmp.h>
-   (synopsis "GNU MPFR, a library for multiple-precision floating-point
+   (synopsis "C library for arbitrary precision floating-point arithmetic")
-arithmetic")
    (description
     "The GNU MPFR library is a C library for multiple-precision
 floating-point computations with correct rounding.  MPFR is based on the GMP
@@ -106,8 +105,7 @@ double-precision floating-point arithmetic (53-bit mantissa).")
    (build-system gnu-build-system)
    (propagated-inputs `(("gmp" ,gmp)              ; <mpc.h> refers to both
                         ("mpfr" ,mpfr)))
-   (synopsis "GNU MPC, a library for multiprecision complex arithmetic
+   (synopsis "C library for arbitrary precision complex arithmetic")
-with exact rounding")
    (description
     "GNU MPC is a C library for the arithmetic of complex numbers with
 arbitrarily high precision and correct rounding of the result. It extends

gnu/packages/nano.scm

@@ -28,7 +28,7 @@
 (define-public nano
   (package
     (name "nano")
-    (version "2.2.6")
+    (version "2.3.2")
     (source
      (origin
       (method url-fetch)
@@ -36,17 +36,16 @@
                           version ".tar.gz"))
       (sha256
        (base32
-        "0yp6pid67k8h7394spzw0067fl2r7rxm2b6kfccg87g8nlry2s5y"))))
+        "1s3b21h5p7r8xafw0gahswj16ai6k2vnjhmd15b491hl0x494c7z"))))
     (build-system gnu-build-system)
     (inputs
      `(("gettext" ,guix:gettext)
        ("ncurses" ,ncurses)))
     (home-page "http://www.nano-editor.org/")
-    (synopsis
+    (synopsis "Small, user-friendly console text editor")
-     "A small, user-friendly console text editor")
     (description
      "GNU nano is designed to be a free replacement for the Pico text
 editor, part of the Pine email suite from The University of
 Washington. It aims to emulate Pico as closely as possible and perhaps
 include extra functionality.")
-    (license gpl3+))) ; some files are under GPLv2+
+    (license gpl3+))) ; some files are under GPLv2+

gnu/packages/ncurses.scm

@@ -107,8 +107,7 @@
                     ,configure-phase
                     %standard-phases)))))
      (self-native-input? #t)
-     (synopsis
+     (synopsis "Terminal emulation (termcap, terminfo) library")
-      "GNU Ncurses, a free software emulation of curses in SVR4 and more")
      (description
       "The Ncurses (new curses) library is a free software emulation of curses
 in System V Release 4.0, and more.  It uses Terminfo format, supports pads

gnu/packages/nettle.scm

@@ -27,19 +27,19 @@
 (define-public nettle
   (package
     (name "nettle")
-    (version "2.6")
+    (version "2.7")
     (source (origin
              (method url-fetch)
              (uri (string-append "mirror://gnu/nettle/nettle-"
                                  version ".tar.gz"))
              (sha256
               (base32
-               "0mminj3fg0vba8qx4q6dbf0xz6fskamli7z2r8rci5xrcd7n5pv0"))))
+               "1mnl5i1136p47lrklm0mhnnv3gjakza385zvxz12qf057h9ym562"))))
     (build-system gnu-build-system)
     (inputs `(("m4" ,m4)))
     (propagated-inputs `(("gmp" ,gmp)))
     (home-page "http://www.lysator.liu.se/~nisse/nettle/")
-    (synopsis "GNU Nettle, a cryptographic library")
+    (synopsis "C library for low-level crytographic functionality")
     (description
      "Nettle is a cryptographic library that is designed to fit easily
 in more or less any context: In crypto toolkits for object-oriented

gnu/packages/oggvorbis.scm

@@ -94,8 +94,7 @@ polyphonic) audio and music at fixed and variable bitrates from 16 to
     (build-system gnu-build-system)
     (inputs `(("libogg" ,libogg)))
     (home-page "https://gnu.org/software/speex")
-    (synopsis
+    (synopsis "Library for patent-free audio compression format")
-     "GNU Speex, a patent-free voice codec")
     (description
      "GNU Speex is a patent-free voice codec.  It is designed to
 compress voice at bitrates in the 2--45 kbps range.  Possible

gnu/packages/parted.scm

@@ -58,8 +58,7 @@
        ("readline" ,readline)
        ("util-linux" ,util-linux)))
     (home-page "http://www.gnu.org/software/parted/")
-    (synopsis
+    (synopsis "Disk partition editor")
-     "GNU Parted, a tool to manipulate partitions")
     (description
      "GNU Parted is an industrial-strength package for creating, destroying,
 resizing, checking and copying partitions, and the file systems on them.  This
@@ -68,4 +67,4 @@ usage, copying data on hard disks and disk imaging.
 
 It contains a library, libparted, and a command-line frontend, parted, which
 also serves as a sample implementation and script backend.")
-    (license gpl3+)))
+    (license gpl3+)))

gnu/packages/pth.scm

@@ -37,7 +37,7 @@
     (build-system gnu-build-system)
     (arguments '(#:parallel-build? #f))
     (home-page "http://www.gnu.org/software/pth")
-    (synopsis "The GNU Portable Threads library")
+    (synopsis "Portable thread library")
     (description
      "Pth is a very portable POSIX/ANSI-C based library for Unix
 platforms which provides non-preemptive priority-based scheduling for

gnu/packages/python.scm

@@ -31,7 +31,7 @@
 (define-public python
   (package
     (name "python")
-    (version "2.7.3")
+    (version "2.7.4")
     (source
      (origin
       (method url-fetch)
@@ -39,12 +39,10 @@
                           version "/Python-" version ".tar.xz"))
       (sha256
        (base32
-        "11f9aw855lrmknr6c82gm1ijr3n0smc6idyp94y7774yivjnplv1"))))
+        "0bdn4dylm92n2dsvqvjfyask9jbz88aan5hi4lgkawkxs2v6wqmn"))))
     (build-system gnu-build-system)
     (arguments
      `(#:tests? #f ; XXX: some tests fail
-       #:patches (list (assoc-ref %build-inputs "patch-dbm"))
-       #:patch-flags '("-p0")
        #:configure-flags
         (let ((bz2 (assoc-ref %build-inputs "bzip2"))
               (gdbm (assoc-ref %build-inputs "gdbm"))
@@ -68,8 +66,7 @@
        ("gdbm" ,gdbm)
        ("openssl" ,openssl)
        ("readline" ,readline)
-       ("zlib" ,zlib)
+       ("zlib" ,zlib)))
-       ("patch-dbm" ,(search-patch "python-fix-dbm.patch"))))
     (native-search-paths
      (list (search-path-specification
             (variable "PYTHONPATH")

gnu/packages/readline.scm

@@ -62,7 +62,7 @@
                              'install 'post-install
                              ,post-install-phase
                              %standard-phases)))
-      (synopsis "GNU Readline, a library for interactive line editing")
+      (synopsis "Edit command lines while typing, with history support")
       (description
        "The GNU Readline library provides a set of functions for use by
 applications that allow users to edit command lines as they are typed in.

gnu/packages/recutils.scm

@@ -46,8 +46,7 @@
              ("patch/gets"
               ,(search-patch "diffutils-gets-undeclared.patch"))))
    (arguments `(#:patches (list (assoc-ref %build-inputs "patch/gets"))))
-   (synopsis "GNU recutils, tools and libraries to access human-editable,
+   (synopsis "Manipulate plain text files as databases")
-text-based databases")
    (description
     "GNU recutils is a set of tools and libraries to access human-editable,
 text-based databases called recfiles.  The data is stored as a sequence of

gnu/packages/scheme.scm

@@ -102,7 +102,7 @@
               (base32
                "0pclakzwxbqgy6wqwvs6ml62wgby8ba8xzmwzdwhx1v8wv05yw1j"))))))))
     (home-page "http://www.gnu.org/software/mit-scheme/")
-    (synopsis "MIT/GNU Scheme, a native code Scheme compiler")
+    (synopsis "Scheme implementation with integrated editor and debugger")
     (description
      "MIT/GNU Scheme is an implementation of the Scheme programming
 language, providing an interpreter, compiler, source-code debugger,
@@ -197,7 +197,7 @@ between Scheme and C# programs.")
                                  version ".tar.gz"))
              (sha256
               (base32
-               "04fhy5jp9lq12fmdqfjzj1w32f7nxc80fagbj7pfci7xh86nm2c5"))))
+               "1v2r4ga58kk1sx0frn8qa8ccmjpic9csqzpk499wc95y9c4b1wy3"))))
     (build-system gnu-build-system)
     (arguments
      '(#:phases

gnu/packages/screen.scm

@@ -40,7 +40,7 @@
      `(("ncurses", ncurses)
        ("perl" ,perl)))
     (home-page "http://www.gnu.org/software/screen/")
-    (synopsis "GNU Screen, a terminal multiplexer")
+    (synopsis "Full-screen window manager providing multiple terminals")
     (description
      "GNU screen is a full-screen window manager that multiplexes a physical
 terminal between several processes, typically interactive shells. Each virtual

gnu/packages/shishi.scm

@@ -46,8 +46,7 @@
        ("libgcrypt" ,libgcrypt)
        ("libtasn1" ,libtasn1)))
     (home-page "http://www.gnu.org/software/shishi/")
-    (synopsis
+    (synopsis "Implementation of the Kerberos 5 network security system")
-     "GNU Shishi, an implementation of the Kerberos 5 network security system")
     (description
      "Shishi contains a library ('libshishi') that can be used by application
 developers to add support for Kerberos 5.  Shishi contains a command line

gnu/packages/smalltalk.scm

@@ -26,7 +26,7 @@
 (define-public smalltalk
   (package
     (name "smalltalk")
-    (version "3.2.4")
+    (version "3.2.5")
     (source
      (origin
       (method url-fetch)
@@ -34,7 +34,7 @@
                           version ".tar.xz"))
       (sha256
        (base32
-        "1bdhbppjv1fswh4ls9q90zix38l1hg9qd4c4bz1pbg1af991xq3a"))))
+        "1k2ssrapfzhngc7bg1zrnd9n2vyxp9c9m70byvsma6wapbvib6l1"))))
     (build-system gnu-build-system)
     (inputs `(("zip" ,zip)))
     (arguments
@@ -47,8 +47,7 @@
                        (("@LIBC_SO_DIR@")  (string-append libc "/lib")))))
                 %standard-phases)))
     (home-page "https://www.gnu.org/software/smalltalk/")
-    (synopsis
+    (synopsis "Smalltalk environment")
-     "GNU Smalltalk, a free implementation of the Smalltalk-80 language")
     (description
      "GNU Smalltalk is a free implementation of the Smalltalk-80 language.
 

gnu/packages/system.scm

@@ -38,8 +38,7 @@
         "18w0dbg77i56cx1bwa789w0qi3l4xkkbascxcv2b6gbm0zmjg1g6"))))
     (build-system gnu-build-system)
     (home-page "http://www.gnu.org/software/pies/")
-    (synopsis
+    (synopsis "Program invocation and execution supervisor")
-     "GNU Pies, a program invocation and execution supervisor")
     (description
      "The name Pies (pronounced \"p-yes\") stands for Program Invocation
 and Execution Supervisor.  This utility starts and controls execution of
@@ -81,8 +80,7 @@ it can replace the inetd utility!")
     (inputs `(("patch/gets" ,(search-patch "diffutils-gets-undeclared.patch"))
               ("ncurses" ,ncurses)))
     (home-page "http://www.gnu.org/software/inetutils/")
-    (synopsis
+    (synopsis "Basic networking utilities")
-     "GNU Inetutils, a collection of common network programs")
     (description
      "The GNU network utilities suite provides the following tools:
 ftp(d), hostname, ifconfig, inetd, logger, ping, rcp, rexec(d),

gnu/packages/texinfo.scm

@@ -42,7 +42,7 @@
     ;; TODO: Remove Perl from here when 'patch-shebang' DTRT with /usr/bin/env.
     (propagated-inputs `(("perl" ,perl)))         ; yuck!
     (home-page "http://www.gnu.org/software/texinfo/")
-    (synopsis "GNU Texinfo, the GNU documentation system")
+    (synopsis "The GNU documentation format")
     (description
      "Texinfo is the official documentation format of the GNU project.
 It was invented by Richard Stallman and Bob Chassell many years

gnu/packages/time.scm

@@ -49,9 +49,7 @@
                                     (string-append "--prefix=" out)))))
                       %standard-phases)))
     (home-page "http://www.gnu.org/software/time/")
-    (synopsis
+    (synopsis "Run a command, then display its resource usage")
-     "GNU Time, a tool that runs programs and summarizes the system
-resources they use")
     (description
      "The 'time' command runs another program, then displays information
 about the resources used by that program, collected by the system while

gnu/packages/wdiff.scm

@@ -21,13 +21,14 @@
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
+  #:use-module (gnu packages texinfo)
   #:use-module (gnu packages screen)
   #:use-module (gnu packages which))
 
 (define-public wdiff
   (package
     (name "wdiff")
-    (version "1.1.2")
+    (version "1.2.1")
     (source
      (origin
       (method url-fetch)
@@ -35,7 +36,7 @@
                           version ".tar.gz"))
       (sha256
        (base32
-        "0q78y5awvjjmsvizqilbpwany62shlmlq2ayxkjbygmdafpk1k8j"))))
+        "1gb5hpiyikada9bwz63q3g96zs383iskiir0xsqynqnvq1vd4n41"))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases (alist-cons-before
@@ -46,10 +47,12 @@
                       (string-append "#!" (which "sh")))))
                  %standard-phases)))
     (inputs `(("screen" ,screen)
-              ("which" ,which)))
+              ("which" ,which)
+
+              ;; For some reason wdiff.info gets rebuilt.
+              ("texinfo" ,texinfo)))
     (home-page "https://www.gnu.org/software/wdiff/")
-    (synopsis
+    (synopsis "Word difference finder")
-     "GNU Wdiff, a tool for comparing files on a word by word basis")
     (description
      "GNU Wdiff is a front end to 'diff' for comparing files on a word per
 word basis.  A word is anything between whitespace.  This is useful for
@@ -58,4 +61,4 @@ paragraphs have been refilled.  It works by creating two temporary files, one
 word per line, and then executes 'diff' on these files.  It collects the
 'diff' output and uses it to produce a nicer display of word differences
 between the original files.")
-    (license gpl3+)))
+    (license gpl3+)))

gnu/packages/wget.scm

@@ -44,8 +44,7 @@
        ("perl" ,perl)
        ("gettext" ,guix:gettext)))
     (home-page "http://www.gnu.org/software/wget/")
-    (synopsis
+    (synopsis "Non-interactive command-line utility for downloading files")
-     "GNU Wget, a tool for retrieving files using HTTP, HTTPS, and FTP")
     (description
      "GNU Wget is a free software package for retrieving files using HTTP,
 HTTPS and FTP, the most widely-used Internet protocols.  It is a

gnu/packages/which.scm

@@ -36,8 +36,7 @@
         "1y2p50zadb36izzh2zw4dm5hvdiydqf3qa88l8kav20dcmfbc5yl"))))
     (build-system gnu-build-system)
     (home-page "https://gnu.org/software/which/")
-    (synopsis
+    (synopsis "Find full path of shell commands")
-     "GNU Which shows the full path of (shell) commands")
     (description
      "GNU Which takes one or more arguments. For each of its arguments
 it prints to stdout the full path of the executables that would have

gnu/packages/zile.scm

@@ -45,7 +45,7 @@
        ("perl" ,perl)
        ("help2man" ,help2man)))
     (home-page "http://www.gnu.org/software/zile/")
-    (synopsis "GNU Zile, a lightweight Emacs clone")
+    (synopsis "Zile is lossy Emacs, a lightweight Emacs clone")
     (description
      "GNU Zile, which is a lightweight Emacs clone.  Zile is short
 for Zile Is Lossy Emacs.  Zile has been written to be as

guix/derivations.scm

@@ -48,6 +48,7 @@
             derivation-input?
             derivation-input-path
             derivation-input-sub-derivations
+            derivation-input-output-paths
 
             fixed-output-derivation?
             derivation-hash
@@ -99,6 +100,14 @@ download with a fixed hash (aka. `fetchurl')."
      #t)
     (_ #f)))
 
+(define (derivation-input-output-paths input)
+  "Return the list of output paths corresponding to INPUT, a
+<derivation-input>."
+  (match input
+    (($ <derivation-input> path sub-drvs)
+     (map (cut derivation-path->output-path path <>)
+          sub-drvs))))
+
 (define (derivation-prerequisites drv)
   "Return the list of derivation-inputs required to build DRV, recursively."
   (let loop ((drv    drv)
@@ -113,47 +122,85 @@ download with a fixed hash (aka. `fetchurl')."
                  inputs)))))
 
 (define* (derivation-prerequisites-to-build store drv
-                                            #:key (outputs
+                                            #:key
-                                                   (map
+                                            (outputs
-                                                    car
+                                             (map
-                                                    (derivation-outputs drv))))
+                                              car
-  "Return the list of derivation-inputs required to build the OUTPUTS of
+                                              (derivation-outputs drv)))
-DRV and not already available in STORE, recursively."
+                                            (use-substitutes? #t))
+  "Return two values: the list of derivation-inputs required to build the
+OUTPUTS of DRV and not already available in STORE, recursively, and the list
+of required store paths that can be substituted.  When USE-SUBSTITUTES? is #f,
+that second value is the empty list."
+  (define (derivation-output-paths drv sub-drvs)
+    (match drv
+      (($ <derivation> outputs)
+       (map (lambda (sub-drv)
+              (derivation-output-path (assoc-ref outputs sub-drv)))
+            sub-drvs))))
+
   (define built?
     (cut valid-path? store <>))
 
+  (define substitutable?
+    ;; Return true if the given path is substitutable.  Call
+    ;; `substitutable-paths' upfront, to benefit from parallelism in the
+    ;; substituter.
+    (if use-substitutes?
+        (let ((s (substitutable-paths store
+                                      (append
+                                       (derivation-output-paths drv outputs)
+                                       (append-map
+                                        derivation-input-output-paths
+                                        (derivation-prerequisites drv))))))
+          (cut member <> s))
+        (const #f)))
+
   (define input-built?
-    (match-lambda
+    (compose (cut any built? <>) derivation-input-output-paths))
-     (($ <derivation-input> path sub-drvs)
+
-      (let ((out (map (cut derivation-path->output-path path <>)
+  (define input-substitutable?
-                      sub-drvs)))
+    ;; Return true if and only if all of SUB-DRVS are subsitutable.  If at
-        (any built? out)))))
+    ;; least one is missing, then everything must be rebuilt.
+    (compose (cut every substitutable? <>) derivation-input-output-paths))
 
   (define (derivation-built? drv sub-drvs)
-    (match drv
+    (every built? (derivation-output-paths drv sub-drvs)))
-      (($ <derivation> outputs)
-       (let ((paths (map (lambda (sub-drv)
-                           (derivation-output-path
-                            (assoc-ref outputs sub-drv)))
-                         sub-drvs)))
-         (every built? paths)))))
 
-  (let loop ((drv      drv)
+  (define (derivation-substitutable? drv sub-drvs)
-             (sub-drvs outputs)
+    (every substitutable? (derivation-output-paths drv sub-drvs)))
-             (result   '()))
+
-    (if (derivation-built? drv sub-drvs)
+  (let loop ((drv        drv)
-        result
+             (sub-drvs   outputs)
-        (let ((inputs (remove (lambda (i)
+             (build      '())
-                                (or (member i result) ; XXX: quadratic
+             (substitute '()))
-                                    (input-built? i)))
+    (cond ((derivation-built? drv sub-drvs)
-                              (derivation-inputs drv))))
+           (values build substitute))
-          (fold loop
+          ((derivation-substitutable? drv sub-drvs)
-                (append inputs result)
+           (values build
-                (map (lambda (i)
+                   (append (derivation-output-paths drv sub-drvs)
-                       (call-with-input-file (derivation-input-path i)
+                           substitute)))
-                         read-derivation))
+          (else
-                     inputs)
+           (let ((inputs (remove (lambda (i)
-                (map derivation-input-sub-derivations inputs))))))
+                                   (or (member i build) ; XXX: quadratic
+                                       (input-built? i)
+                                       (input-substitutable? i)))
+                                 (derivation-inputs drv))))
+             (fold2 loop
+                    (append inputs build)
+                    (append (append-map (lambda (input)
+                                          (if (and (not (input-built? input))
+                                                   (input-substitutable? input))
+                                              (derivation-input-output-paths
+                                               input)
+                                              '()))
+                                        (derivation-inputs drv))
+                            substitute)
+                    (map (lambda (i)
+                           (call-with-input-file (derivation-input-path i)
+                             read-derivation))
+                         inputs)
+                    (map derivation-input-sub-derivations inputs)))))))
 
 (define (%read-derivation drv-port)
   ;; Actually read derivation from DRV-PORT.

guix/download.scm

@@ -21,13 +21,15 @@
   #:use-module (ice-9 match)
   #:use-module (guix derivations)
   #:use-module (guix packages)
-  #:use-module ((guix store) #:select (derivation-path?))
+  #:use-module ((guix store) #:select (derivation-path? add-to-store))
+  #:use-module ((guix build download) #:renamer (symbol-prefix-proc 'build:))
   #:use-module (guix utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:export (%mirrors
-            url-fetch))
+            url-fetch
+            download-to-store))
 
 ;;; Commentary:
 ;;;
@@ -230,4 +232,17 @@ must be a list of symbol/URL-list pairs."
                                   #:guile-for-build guile-for-build
                                   #:env-vars env-vars)))
 
+(define* (download-to-store store url #:optional (name (basename url))
+                            #:key (log (current-error-port)))
+  "Download from URL to STORE, either under NAME or URL's basename if
+omitted.  Write progress reports to LOG."
+  (call-with-temporary-output-file
+   (lambda (temp port)
+     (let ((result
+            (parameterize ((current-output-port log))
+              (build:url-fetch url temp #:mirrors %mirrors))))
+       (close port)
+       (and result
+            (add-to-store store name #f "sha256" temp))))))
+
 ;;; download.scm ends here

guix/gnu-maintenance.scm

@@ -28,9 +28,17 @@
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (system foreign)
+  #:use-module (guix web)
   #:use-module (guix ftp-client)
+  #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix packages)
+  #:use-module ((guix download) #:select (download-to-store))
+  #:use-module (guix gnupg)
+  #:use-module (rnrs io ports)
+  #:use-module (guix base32)
+  #:use-module ((guix build utils)
+                #:select (substitute))
   #:export (gnu-package-name
             gnu-package-mundane-name
             gnu-package-copyright-holder
@@ -49,7 +57,10 @@
 
             releases
             latest-release
-            gnu-package-name->name+version))
+            gnu-package-name->name+version
+            package-update-path
+            package-update
+            update-package-source))
 
 ;;; Commentary:
 ;;;
@@ -63,46 +74,11 @@
 ;;; List of GNU packages.
 ;;;
 
-(define (http-fetch uri)
-  "Return an input port containing the textual data at URI, a string."
-  (let*-values (((resp data)
-                 (let ((uri (string->uri uri)))
-                   ;; Try hard to use the API du jour to get an input port.
-                   (if (version>? "2.0.7" (version))
-                       (if (defined? 'http-get*)
-                           (http-get* uri)
-                           (http-get uri))       ; old Guile, returns a string
-                       (http-get uri #:streaming? #t)))) ; 2.0.8 or later
-               ((code)
-                (response-code resp)))
-    (case code
-      ((200)
-       (cond ((not data)
-              (begin
-                ;; XXX: Guile 2.0.5 and earlier did not support chunked transfer
-                ;; encoding, which is required when fetching %PACKAGE-LIST-URL
-                ;; (see <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>).
-                ;; Since users may still be using these versions, warn them and
-                ;; bail out.
-                (format (current-error-port)
-                        "warning: using Guile ~a, ~a ~s encoding~%"
-                        (version)
-                        "which does not support HTTP"
-                        (response-transfer-encoding resp))
-                (error "download failed; use a newer Guile"
-                       uri resp)))
-             ((string? data)                 ; old `http-get' returns a string
-              (open-input-string data))
-             (else                           ; input port
-              data)))
-      (else
-       (error "download failed" uri code
-              (response-reason-phrase resp))))))
-
 (define %package-list-url
-  (string-append "http://cvs.savannah.gnu.org/"
+  (string->uri
-                 "viewvc/*checkout*/gnumaint/"
+   (string-append "http://cvs.savannah.gnu.org/"
-                 "gnupackages.txt?root=womb"))
+                  "viewvc/*checkout*/gnumaint/"
+                  "gnupackages.txt?root=womb")))
 
 (define-record-type* <gnu-package-descriptor>
   gnu-package-descriptor
@@ -188,7 +164,7 @@
                                "savannah" "fsd" "language" "logo"
                                "doc-category" "doc-summary" "doc-urls"
                                "download-url")))
-        (group-package-fields (http-fetch %package-list-url)
+        (group-package-fields (http-fetch %package-list-url #:text? #t)
                               '(())))))
 
 (define (find-packages regexp)
@@ -201,16 +177,17 @@
 
 (define gnu-package?
   (memoize
-   (lambda (package)
+   (let ((official-gnu-packages (memoize official-gnu-packages)))
-     "Return true if PACKAGE is a GNU package.  This procedure may access the
+     (lambda (package)
+       "Return true if PACKAGE is a GNU package.  This procedure may access the
 network to check in GNU's database."
-     ;; TODO: Find a way to determine that a package is non-GNU without going
+       ;; TODO: Find a way to determine that a package is non-GNU without going
-     ;; through the network.
+       ;; through the network.
-     (let ((url  (and=> (package-source package) origin-uri))
+       (let ((url  (and=> (package-source package) origin-uri))
-           (name (package-name package)))
+             (name (package-name package)))
-       (or (and (string? url) (string-prefix? "mirror://gnu" url))
+         (or (and (string? url) (string-prefix? "mirror://gnu" url))
-           (and (member name (map gnu-package-name (official-gnu-packages)))
+             (and (member name (map gnu-package-name (official-gnu-packages)))
-                #t))))))
+                  #t)))))))
 
 
 ;;;
@@ -234,6 +211,7 @@ stored."
       ("mit-scheme"   "ftp.gnu.org" "/gnu/mit-scheme/stable.pkg")
       ("icecat"       "ftp.gnu.org" "/gnu/gnuzilla")
       ("source-highlight" "ftp.gnu.org" "/gnu/src-highlite")
+      ("glib"         "ftp.gnome.org" "/pub/gnome/sources/glib")
       ("TeXmacs"      "ftp.texmacs.org" "/TeXmacs/targz")))
 
   (match (assoc project quirks)
@@ -242,30 +220,33 @@ stored."
     (_
      (values "ftp.gnu.org" (string-append "/gnu/" project)))))
 
+(define (sans-extension tarball)
+  "Return TARBALL without its .tar.* extension."
+  (let ((end (string-contains tarball ".tar")))
+    (substring tarball 0 end)))
+
+(define %tarball-rx
+  (make-regexp "^(.+)-([0-9]|[^-])*(-src)?\\.tar\\."))
+
+(define %alpha-tarball-rx
+  (make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|cvs|svn|git)-?[0-9\\.]*\\.tar\\."))
+
+(define (release-file project file)
+  "Return #f if FILE is not a release tarball of PROJECT, otherwise return
+PACKAGE-VERSION."
+  (and (not (string-suffix? ".sig" file))
+       (and=> (regexp-exec %tarball-rx file)
+              (lambda (match)
+                ;; Filter out unrelated files, like `guile-www-1.1.1'.
+                (equal? project (match:substring match 1))))
+       (not (regexp-exec %alpha-tarball-rx file))
+       (let ((s (sans-extension file)))
+         (and (regexp-exec %package-name-rx s) s))))
+
 (define (releases project)
   "Return the list of releases of PROJECT as a list of release name/directory
 pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\"). "
   ;; TODO: Parse something like fencepost.gnu.org:/gd/gnuorg/packages-ftp.
-  (define release-rx
-    (make-regexp (string-append "^" project
-                                "-([0-9]|[^-])*(-src)?\\.tar\\.")))
-
-  (define alpha-rx
-    (make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|cvs|svn|git)-?[0-9\\.]*\\.tar\\."))
-
-  (define (sans-extension tarball)
-    (let ((end (string-contains tarball ".tar")))
-      (substring tarball 0 end)))
-
-  (define (release-file file)
-    ;; Return #f if FILE is not a release tarball, otherwise return
-    ;; PACKAGE-VERSION.
-    (and (not (string-suffix? ".sig" file))
-         (regexp-exec release-rx file)
-         (not (regexp-exec alpha-rx file))
-         (let ((s (sans-extension file)))
-           (and (regexp-exec %package-name-rx s) s))))
-
   (let-values (((server directory) (ftp-server/directory project)))
     (define conn (ftp-open server))
 
@@ -291,7 +272,7 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
                   ;; guile-www; in mit-scheme, filter out binaries.
                   (filter-map (match-lambda
                                 ((file 'file . _)
-                                 (and=> (release-file file)
+                                 (and=> (release-file project file)
                                         (cut cons <> directory)))
                                 (_ #f))
                               files)
@@ -299,14 +280,39 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
 
 (define (latest-release project)
   "Return (\"FOO-X.Y\" . \"/bar/foo\") or #f."
-  (let ((releases (releases project)))
+  (define (latest a b)
-    (and (not (null? releases))
+    (if (version>? a b) a b))
-         (fold (lambda (release latest)
+
-                 (if (version>? (car release) (car latest))
+  (define contains-digit?
-                     release
+    (cut string-any char-set:digit <>))
-                     latest))
+
-               '("" . "")
+  (let-values (((server directory) (ftp-server/directory project)))
-               releases))))
+    (define conn (ftp-open server))
+
+    (let loop ((directory directory))
+      (let* ((entries (ftp-list conn directory))
+             (subdirs (filter-map (match-lambda
+                                   ((dir 'directory . _) dir)
+                                   (_ #f))
+                                  entries)))
+        (match subdirs
+          (()
+           ;; No sub-directories, so assume that tarballs are here.
+           (let ((files (filter-map (match-lambda
+                                     ((file 'file . _)
+                                      (release-file project file))
+                                     (_ #f))
+                                    entries)))
+             (and=> (reduce latest #f files)
+                    (cut cons <> directory))))
+          ((subdirs ...)
+           ;; Assume that SUBDIRS correspond to versions, and jump into the
+           ;; one with the highest version number.  Filter out sub-directories
+           ;; that do not contain digits---e.g., /gnuzilla/lang.
+           (let* ((subdirs (filter contains-digit? subdirs))
+                  (target  (reduce latest #f subdirs)))
+             (and target
+                  (loop (string-append directory "/" target))))))))))
 
 (define %package-name-rx
   ;; Regexp for a package name, e.g., "foo-X.Y".  Since TeXmacs uses
@@ -320,4 +326,116 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
         (values name+version #f)
         (values (match:substring match 1) (match:substring match 2)))))
 
+
+;;;
+;;; Auto-update.
+;;;
+
+(define (package-update-path package)
+  "Return an update path for PACKAGE, or #f if no update is needed."
+  (and (gnu-package? package)
+       (match (latest-release (package-name package))
+         ((name+version . directory)
+          (let-values (((_ new-version)
+                        (package-name->name+version name+version)))
+            (and (version>? name+version (package-full-name package))
+                 `(,new-version . ,directory))))
+         (_ #f))))
+
+(define* (download-tarball store project directory version
+                           #:optional (archive-type "gz"))
+  "Download PROJECT's tarball over FTP and check its OpenPGP signature.  On
+success, return the tarball file name."
+  (let* ((server  (ftp-server/directory project))
+         (base    (string-append project "-" version ".tar." archive-type))
+         (url     (string-append "ftp://" server "/" directory "/" base))
+         (sig-url (string-append url ".sig"))
+         (tarball (download-to-store store url))
+         (sig     (download-to-store store sig-url)))
+    (let ((ret (gnupg-verify* sig tarball)))
+      (if ret
+          tarball
+          (begin
+            (warning (_ "signature verification failed for `~a'~%")
+                     base)
+            (warning (_ "(could be because the public key is not in your keyring)~%"))
+            #f)))))
+
+(define (package-update store package)
+  "Return the new version and the file name of the new version tarball for
+PACKAGE, or #f and #f when PACKAGE is up-to-date."
+  (match (package-update-path package)
+    ((version . directory)
+     (let-values (((name)
+                   (package-name package))
+                  ((archive-type)
+                   (let ((source (package-source package)))
+                     (or (and (origin? source)
+                              (file-extension (origin-uri source)))
+                         "gz"))))
+       (let ((tarball (download-tarball store name directory version
+                                        archive-type)))
+         (values version tarball))))
+    (_
+     (values #f #f))))
+
+(define (update-package-source package version hash)
+  "Modify the source file that defines PACKAGE to refer to VERSION,
+whose tarball has SHA256 HASH (a bytevector).  Return the new version string
+if an update was made, and #f otherwise."
+  (define (new-line line matches replacement)
+    ;; Iterate over MATCHES and return the modified line based on LINE.
+    ;; Replace each match with REPLACEMENT.
+    (let loop ((m* matches)                       ; matches
+               (o  0)                             ; offset in L
+               (r  '()))                          ; result
+      (match m*
+        (()
+         (let ((r (cons (substring line o) r)))
+           (string-concatenate-reverse r)))
+        ((m . rest)
+         (loop rest
+               (match:end m)
+               (cons* replacement
+                      (substring line o (match:start m))
+                      r))))))
+
+  (define (update-source file old-version version
+                         old-hash hash)
+    ;; Update source file FILE, replacing occurrences OLD-VERSION by VERSION
+    ;; and occurrences of OLD-HASH by HASH (base32 representation thereof).
+
+    ;; TODO: Currently this is a bit of a sledgehammer: if VERSION occurs in
+    ;; different unrelated places, we may modify it more than needed, for
+    ;; instance.  We should try to make changes only within the sexp that
+    ;; corresponds to the definition of PACKAGE.
+    (let ((old-hash (bytevector->nix-base32-string old-hash))
+          (hash     (bytevector->nix-base32-string hash)))
+      (substitute file
+                  `((,(regexp-quote old-version)
+                     . ,(cut new-line <> <> version))
+                    (,(regexp-quote old-hash)
+                     . ,(cut new-line <> <> hash))))
+      version))
+
+  (let ((name (package-name package))
+        (loc  (package-field-location package 'version)))
+    (if loc
+        (let ((old-version (package-version package))
+              (old-hash    (origin-sha256 (package-source package)))
+              (file        (and=> (location-file loc)
+                                  (cut search-path %load-path <>))))
+          (if file
+              (update-source file
+                             old-version version
+                             old-hash hash)
+              (begin
+                (warning (_ "~a: could not locate source file")
+                         (location-file loc))
+                #f)))
+        (begin
+          (format (current-error-port)
+                  (_ "~a: ~a: no `version' field in source; skipping~%")
+                  name (package-location package))))))
+
 ;;; gnu-maintenance.scm ends here

guix/gnupg.scm

@@ -0,0 +1,152 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2010, 2011, 2013 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 gnupg)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 rdelim)
+  #:use-module (srfi srfi-1)
+  #:export (gnupg-verify
+            gnupg-verify*
+            gnupg-status-good-signature?
+            gnupg-status-missing-key?))
+
+;;; Commentary:
+;;;
+;;; GnuPG interface.
+;;;
+;;; Code:
+
+(define %gpg-command "gpg2")
+(define %openpgp-key-server "keys.gnupg.net")
+
+(define (gnupg-verify sig file)
+  "Verify signature SIG for FILE.  Return a status s-exp if GnuPG failed."
+
+  (define (status-line->sexp line)
+    ;; See file `doc/DETAILS' in GnuPG.
+    (define sigid-rx
+      (make-regexp
+       "^\\[GNUPG:\\] SIG_ID ([A-Za-z0-9/]+) ([[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2}) ([[:digit:]]+)"))
+    (define goodsig-rx
+      (make-regexp "^\\[GNUPG:\\] GOODSIG ([[:xdigit:]]+) (.+)$"))
+    (define validsig-rx
+      (make-regexp
+       "^\\[GNUPG:\\] VALIDSIG ([[:xdigit:]]+) ([[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2}) ([[:digit:]]+) .*$"))
+    (define expkeysig-rx                    ; good signature, but expired key
+      (make-regexp "^\\[GNUPG:\\] EXPKEYSIG ([[:xdigit:]]+) (.*)$"))
+    (define errsig-rx
+      (make-regexp
+       "^\\[GNUPG:\\] ERRSIG ([[:xdigit:]]+) ([^ ]+) ([^ ]+) ([^ ]+) ([[:digit:]]+) ([[:digit:]]+)"))
+
+    (cond ((regexp-exec sigid-rx line)
+           =>
+           (lambda (match)
+             `(signature-id ,(match:substring match 1) ; sig id
+                            ,(match:substring match 2) ; date
+                            ,(string->number           ; timestamp
+                              (match:substring match 3)))))
+          ((regexp-exec goodsig-rx line)
+           =>
+           (lambda (match)
+             `(good-signature ,(match:substring match 1)    ; key id
+                              ,(match:substring match 2)))) ; user name
+          ((regexp-exec validsig-rx line)
+           =>
+           (lambda (match)
+             `(valid-signature ,(match:substring match 1) ; fingerprint
+                               ,(match:substring match 2) ; sig creation date
+                               ,(string->number           ; timestamp
+                                 (match:substring match 3)))))
+          ((regexp-exec expkeysig-rx line)
+           =>
+           (lambda (match)
+             `(expired-key-signature ,(match:substring match 1) ; fingerprint
+                                     ,(match:substring match 2)))) ; user name
+          ((regexp-exec errsig-rx line)
+           =>
+           (lambda (match)
+             `(signature-error ,(match:substring match 1) ; key id or fingerprint
+                               ,(match:substring match 2) ; pubkey algo
+                               ,(match:substring match 3) ; hash algo
+                               ,(match:substring match 4) ; sig class
+                               ,(string->number           ; timestamp
+                                 (match:substring match 5))
+                               ,(let ((rc
+                                       (string->number ; return code
+                                        (match:substring match 6))))
+                                  (case rc
+                                    ((9) 'missing-key)
+                                    ((4) 'unknown-algorithm)
+                                    (else rc))))))
+          (else
+           `(unparsed-line ,line))))
+
+  (define (parse-status input)
+    (let loop ((line   (read-line input))
+               (result '()))
+      (if (eof-object? line)
+          (reverse result)
+          (loop (read-line input)
+                (cons (status-line->sexp line) result)))))
+
+  (let* ((pipe   (open-pipe* OPEN_READ %gpg-command "--status-fd=1"
+                             "--verify" sig file))
+         (status (parse-status pipe)))
+    ;; Ignore PIPE's exit status since STATUS above should contain all the
+    ;; info we need.
+    (close-pipe pipe)
+    status))
+
+(define (gnupg-status-good-signature? status)
+  "If STATUS, as returned by `gnupg-verify', denotes a good signature, return
+a key-id/user pair; return #f otherwise."
+  (any (lambda (sexp)
+         (match sexp
+           (((or 'good-signature 'expired-key-signature) key-id user)
+            (cons key-id user))
+           (_ #f)))
+       status))
+
+(define (gnupg-status-missing-key? status)
+  "If STATUS denotes a missing-key error, then return the key-id of the
+missing key."
+  (any (lambda (sexp)
+         (match sexp
+           (('signature-error key-id _ ...)
+            key-id)
+           (_ #f)))
+       status))
+
+(define (gnupg-receive-keys key-id server)
+  (system* %gpg-command "--keyserver" server "--recv-keys" key-id))
+
+(define* (gnupg-verify* sig file #:optional (server %openpgp-key-server))
+  "Like `gnupg-verify', but try downloading the public key if it's missing.
+Return #t if the signature was good, #f otherwise."
+  (let ((status (gnupg-verify sig file)))
+    (or (gnupg-status-good-signature? status)
+        (let ((missing (gnupg-status-missing-key? status)))
+          (and missing
+               (begin
+                 ;; Download the missing key and try again.
+                 (gnupg-receive-keys missing server)
+                 (gnupg-status-good-signature? (gnupg-verify sig file))))))))
+
+;;; gnupg.scm ends here

guix/packages.scm

@@ -64,6 +64,7 @@
             package-maintainers
             package-properties
             package-location
+            package-field-location
 
             package-transitive-inputs
             package-transitive-propagated-inputs
@@ -182,6 +183,38 @@ corresponds to the arguments expected by `set-path-environment-variable'."
                                                        package)
                                                       16)))))
 
+(define (package-field-location package field)
+  "Return the source code location of the definition of FIELD for PACKAGE, or
+#f if it could not be determined."
+  (define (goto port line column)
+    (unless (and (= (port-column port) (- column 1))
+                 (= (port-line port) (- line 1)))
+      (unless (eof-object? (read-char port))
+        (goto port line column))))
+
+  (match (package-location package)
+    (($ <location> file line column)
+     (catch 'system
+       (lambda ()
+         (call-with-input-file (search-path %load-path file)
+           (lambda (port)
+             (goto port line column)
+             (match (read port)
+               (('package inits ...)
+                (let ((field (assoc field inits)))
+                  (match field
+                    ((_ value)
+                     (and=> (or (source-properties value)
+                                (source-properties field))
+                            source-properties->location))
+                    (_
+                     #f))))
+               (_
+                #f)))))
+       (lambda _
+         #f)))
+    (_ #f)))
+
 
 ;; Error conditions.
 

guix/scripts/build.scm

@@ -43,12 +43,11 @@
 When SOURCE? is true, return the derivations of the package sources."
   (let ((p (read/eval-package-expression str)))
     (if source?
-        (let ((source (package-source p))
+        (let ((source (package-source p)))
-              (loc    (package-location p)))
           (if source
               (package-source-derivation (%store) source)
-              (leave (_ "~a: error: package `~a' has no source~%")
+              (leave (_ "package `~a' has no source~%")
-                     (location->string loc) (package-name p))))
+                     (package-name p))))
         (package-derivation (%store) p system))))
 
 
@@ -169,7 +168,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
             (add-indirect-root (%store) root))
            ((paths ...)
             (fold (lambda (path count)
-                    (let ((root (string-append root "-" (number->string count))))
+                    (let ((root (string-append root
+                                               "-"
+                                               (number->string count))))
                       (symlink path root)
                       (add-indirect-root (%store) root))
                     (+ 1 count))
@@ -177,8 +178,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                   paths))))
        (lambda args
          (leave (_ "failed to create GC root `~a': ~a~%")
-                root (strerror (system-error-errno args)))
+                root (strerror (system-error-errno args)))))))
-         (exit 1)))))
 
   (define newest-available-packages
     (memoize find-newest-available-packages))
@@ -237,7 +237,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                                    (_ #f))
                                   opts)))
 
-          (show-what-to-build (%store) drv (assoc-ref opts 'dry-run?))
+          (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)

guix/scripts/download.scm

@@ -21,30 +21,15 @@
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix base32)
-  #:use-module ((guix download) #:select (%mirrors))
+  #:use-module (guix download)
-  #:use-module (guix build download)
   #:use-module (web uri)
   #: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)
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:export (guix-download))
 
-(define (fetch-and-store store fetch name)
-  "Call FETCH for URI, and pass it the name of a file to write to; eventually,
-copy data from that port to STORE, under NAME.  Return the resulting
-store path."
-  (call-with-temporary-output-file
-   (lambda (temp port)
-     (let ((result
-            (parameterize ((current-output-port (current-error-port)))
-              (fetch temp))))
-       (close port)
-       (and result
-            (add-to-store store name #f "sha256" temp))))))
 
 ;;;
 ;;; Command-line options.
@@ -55,11 +40,14 @@ store path."
   `((format . ,bytevector->nix-base32-string)))
 
 (define (show-help)
-  (display (_ "Usage: guix download [OPTION]... URL
+  (display (_ "Usage: guix download [OPTION] URL
 Download the file at URL, add it to the store, and print its store path
-and the hash of its contents.\n"))
+and the hash of its contents.
+
+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 (default: `nix-base32')"))
+  -f, --format=FMT       write the hash in the given format"))
   (newline)
   (display (_ "
   -h, --help             display this help and exit"))
@@ -114,20 +102,18 @@ and the hash of its contents.\n"))
            (store (open-connection))
            (arg   (assq-ref opts 'argument))
            (uri   (or (string->uri arg)
-                      (leave (_ "guix-download: ~a: failed to parse URI~%")
+                      (leave (_ "~a: failed to parse URI~%")
                              arg)))
            (path  (case (uri-scheme uri)
                     ((file)
                      (add-to-store store (basename (uri-path uri))
                                    #f "sha256" (uri-path uri)))
                     (else
-                     (fetch-and-store store
+                     (download-to-store store (uri->string uri)
-                                      (cut url-fetch arg <>
+                                        (basename (uri-path uri))))))
-                                           #:mirrors %mirrors)
-                                      (basename (uri-path uri))))))
            (hash  (call-with-input-file
                       (or path
-                          (leave (_ "guix-download: ~a: download failed~%")
+                          (leave (_ "~a: download failed~%")
                                  arg))
                     (compose sha256 get-bytevector-all)))
            (fmt   (assq-ref opts 'format)))

guix/scripts/gc.scm

@@ -87,9 +87,8 @@ interpreted."
              ("TB"  (expt 10 12))
              (""    1)
              (_
-              (leave (_ "error: unknown unit: ~a~%") unit)
+              (leave (_ "unknown unit: ~a~%") unit))))
-              (exit 1))))
+        (leave (_ "invalid number: ~a~%") numstr))))
-        (leave (_ "error: invalid number: ~a") numstr))))
 
 (define %options
   ;; Specification of the command-line options.
@@ -110,7 +109,7 @@ interpreted."
                       (let ((amount (size->number arg)))
                         (if arg
                             (alist-cons 'min-freed amount result)
-                            (leave (_ "error: invalid amount of storage: ~a~%")
+                            (leave (_ "invalid amount of storage: ~a~%")
                                    arg))))
                      (#f result)))))
         (option '(#\d "delete") #f #f

guix/scripts/hash.scm

@@ -0,0 +1,120 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.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 hash)
+    #:use-module (guix base32)
+    #: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-26)
+    #:use-module (srfi srfi-37)
+    #:export (guix-hash))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  ;; Alist of default option values.
+  `((format . ,bytevector->nix-base32-string)))
+
+(define (show-help)
+  (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"))
+  (format #t (_ "
+  -f, --format=FMT       write the hash in the given format"))
+  (newline)
+  (display (_ "
+  -h, --help             display this help and exit"))
+  (display (_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specification of the command-line options.
+  (list (option '(#\f "format") #t #f
+                (lambda (opt name arg result)
+                  (define fmt-proc
+                    (match arg
+                      ("nix-base32"
+                       bytevector->nix-base32-string)
+                      ("base32"
+                       bytevector->base32-string)
+                      ((or "base16" "hex" "hexadecimal")
+                       bytevector->base16-string)
+                      (x
+                       (leave (_ "unsupported hash format: ~a~%")
+                              arg))))
+
+                  (alist-cons 'format fmt-proc
+                              (alist-delete 'format result))))
+
+        (option '(#\h "help") #f #f
+                (lambda args
+                  (show-help)
+                  (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda args
+                  (show-version-and-exit "guix hash")))))
+
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-hash . args)
+  (define (parse-options)
+    ;; Return the alist of option values.
+    (args-fold args %options
+               (lambda (opt name arg result)
+                 (leave (_ "unrecognized option: ~a~%")
+                        name))
+               (lambda (arg result)
+                 (alist-cons 'argument arg result))
+               %default-options))
+
+    (let* ((opts (parse-options))
+           (args (filter-map (match-lambda
+                              (('argument . value)
+                               value)
+                              (_ #f))
+                             (reverse opts)))
+           (fmt  (assq-ref opts 'format)))
+
+      (match args
+        ((file)
+         (catch 'system-error
+           (lambda ()
+             (format #t "~a~%"
+                     (call-with-input-file file
+                       (compose fmt sha256 get-bytevector-all))))
+           (lambda args
+             (leave (_ "~a~%")
+                    (strerror (system-error-errno args))))))
+        (_
+         (leave (_ "wrong number of arguments~%"))))))

guix/scripts/package.scm

@@ -208,7 +208,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
       (switch-symlinks profile previous-profile))
 
     (cond ((not (file-exists? profile))           ; invalid profile
-           (leave (_ "error: profile `~a' does not exist~%")
+           (leave (_ "profile `~a' does not exist~%")
                   profile))
           ((zero? number)                         ; empty profile
            (format (current-error-port)
@@ -266,19 +266,42 @@ matching packages."
                        (assoc-ref (derivation-outputs drv) sub-drv))))
          `(,name ,out))))))
 
+(define %sigint-prompt
+  ;; The prompt to jump to upon SIGINT.
+  (make-prompt-tag "interruptible"))
+
+(define (call-with-sigint-handler thunk handler)
+  "Call THUNK and return its value.  Upon SIGINT, call HANDLER with the signal
+number in the context of the continuation of the call to this function, and
+return its return value."
+  (call-with-prompt %sigint-prompt
+                    (lambda ()
+                      (sigaction SIGINT
+                        (lambda (signum)
+                          (sigaction SIGINT SIG_DFL)
+                          (abort-to-prompt %sigint-prompt signum)))
+                      (thunk))
+                    (lambda (k signum)
+                      (handler signum))))
+
 (define-syntax-rule (waiting exp fmt rest ...)
   "Display the given message while EXP is being evaluated."
   (let* ((message (format #f fmt rest ...))
          (blank   (make-string (string-length message) #\space)))
     (display message (current-error-port))
     (force-output (current-error-port))
-    (let ((result exp))
+    (call-with-sigint-handler
-      ;; Clear the line.
+     (lambda ()
-      (display #\cr (current-error-port))
+       (let ((result exp))
-      (display blank (current-error-port))
+         ;; Clear the line.
-      (display #\cr (current-error-port))
+         (display #\cr (current-error-port))
-      (force-output (current-error-port))
+         (display blank (current-error-port))
-      exp)))
+         (display #\cr (current-error-port))
+         (force-output (current-error-port))
+         exp))
+     (lambda (signum)
+       (format (current-error-port) "  interrupted by signal ~a~%" SIGINT)
+       #f))))
 
 (define (check-package-freshness package)
   "Check whether PACKAGE has a newer version available upstream, and report
@@ -328,7 +351,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
   (display (_ "
   -r, --remove=PACKAGE   remove PACKAGE"))
   (display (_ "
-  -u, --upgrade=REGEXP   upgrade all the installed packages matching REGEXP"))
+  -u, --upgrade[=REGEXP] upgrade all the installed packages matching REGEXP"))
   (display (_ "
       --roll-back        roll back to the previous generation"))
   (newline)
@@ -379,7 +402,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
         (option '(#\r "remove") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'remove arg result)))
-        (option '(#\u "upgrade") #t #f
+        (option '(#\u "upgrade") #f #t
                 (lambda (opt name arg result)
                   (alist-cons 'upgrade arg result)))
         (option '("roll-back") #f #f
@@ -454,8 +477,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
     (define (ensure-output p sub-drv)
       (if (member sub-drv (package-outputs p))
           p
-          (leave (_ "~a: error: package `~a' lacks output `~a'~%")
+          (leave (_ "package `~a' lacks output `~a'~%")
-                 (location->string (package-location p))
                  (package-full-name p)
                  sub-drv)))
 
@@ -602,7 +624,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
         (let* ((installed (manifest-packages (profile-manifest profile)))
                (upgrade-regexps (filter-map (match-lambda
                                              (('upgrade . regexp)
-                                              (make-regexp regexp))
+                                              (make-regexp (or regexp "")))
                                              (_ #f))
                                             opts))
                (upgrade  (if (null? upgrade-regexps)
@@ -674,7 +696,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
             (ensure-default-profile))
 
           (show-what-to-remove/install remove* install* dry-run?)
-          (show-what-to-build (%store) drv dry-run?)
+          (show-what-to-build (%store) drv
+                              #:use-substitutes? (assoc-ref opts 'substitutes?)
+                              #:dry-run? dry-run?)
 
           (or dry-run?
               (and (build-derivations (%store) drv)

guix/scripts/refresh.scm

@@ -0,0 +1,182 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 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 refresh)
+  #:use-module (guix ui)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (guix packages)
+  #:use-module (guix gnu-maintenance)
+  #:use-module (gnu packages)
+  #:use-module ((gnu packages base) #:select (%final-inputs))
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-37)
+  #:use-module (rnrs io ports)
+  #:export (guix-refresh))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  ;; Alist of default option values.
+  '())
+
+(define %options
+  ;; Specification of the command-line options.
+  (list (option '(#\n "dry-run") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'dry-run? #t result)))
+        (option '(#\s "select") #t #f
+                (lambda (opt name arg result)
+                  (match arg
+                    ((or "core" "non-core")
+                     (alist-cons 'select (string->symbol arg)
+                                 result))
+                    (x
+                     (leave (_ "~a: invalid selection; expected `core' or `non-core'")
+                            arg)))))
+
+        (option '(#\h "help") #f #f
+                (lambda args
+                  (show-help)
+                  (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda args
+                  (show-version-and-exit "guix refresh")))))
+
+(define (show-help)
+  (display (_ "Usage: guix refresh [OPTION]... PACKAGE...
+Update package definitions to match the latest upstream version.
+
+When PACKAGE... is given, update only the specified packages.  Otherwise
+update all the packages of the distribution, or the subset thereof
+specified with `--select'.\n"))
+  (display (_ "
+  -n, --dry-run          do not build the derivations"))
+  (display (_ "
+  -s, --select=SUBSET    select all the packages in SUBSET, one of
+                         `core' or `non-core'"))
+  (newline)
+  (display (_ "
+  -h, --help             display this help and exit"))
+  (display (_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-refresh . 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)
+                 (alist-cons 'argument arg result))
+               %default-options))
+
+  (define core-package?
+    (let* ((input->package (match-lambda
+                            ((name (? package? package) _ ...) package)
+                            (_ #f)))
+           (final-inputs   (map input->package %final-inputs))
+           (core           (append final-inputs
+                                   (append-map (compose (cut filter-map input->package <>)
+                                                        package-transitive-inputs)
+                                               final-inputs)))
+           (names          (delete-duplicates (map package-name core))))
+      (lambda (package)
+        "Return true if PACKAGE is likely a \"core package\"---i.e., one whose
+update would trigger a complete rebuild."
+        ;; Compare by name because packages in base.scm basically inherit
+        ;; other packages.  So, even if those packages are not core packages
+        ;; themselves, updating them would also update those who inherit from
+        ;; them.
+        ;; XXX: Fails to catch MPFR/MPC, whose *source* is used as input.
+        (member (package-name package) names))))
+
+  (let* ((opts     (parse-options))
+         (dry-run? (assoc-ref opts 'dry-run?))
+         (packages (match (concatenate
+                           (filter-map (match-lambda
+                                        (('argument . value)
+                                         (let ((p (find-packages-by-name value)))
+                                           (unless p
+                                             (leave (_ "~a: no package by that name")
+                                                    value))
+                                           p))
+                                        (_ #f))
+                                       opts))
+                     (()                          ; default to all packages
+                      (let ((select? (match (assoc-ref opts 'select)
+                                       ('core core-package?)
+                                       ('non-core (negate core-package?))
+                                       (_ (const #t)))))
+                        ;; TODO: Keep only the newest of each package.
+                        (fold-packages (lambda (package result)
+                                         (if (select? package)
+                                             (cons package result)
+                                             result))
+                                       '())))
+                     (some                        ; user-specified packages
+                      some))))
+    (with-error-handling
+      (if dry-run?
+          (for-each (lambda (package)
+                      (match (false-if-exception (package-update-path package))
+                        ((new-version . directory)
+                         (let ((loc (or (package-field-location package 'version)
+                                        (package-location package))))
+                           (format (current-error-port)
+                                   (_ "~a: ~a would be upgraded from ~a to ~a~%")
+                                   (location->string loc)
+                                   (package-name package) (package-version package)
+                                   new-version)))
+                        (_ #f)))
+                    packages)
+          (let ((store (open-connection)))
+            (for-each (lambda (package)
+                        (let-values (((version tarball)
+                                      (catch #t
+                                        (lambda ()
+                                          (package-update store package))
+                                        (lambda _
+                                          (values #f #f))))
+                                     ((loc)
+                                      (or (package-field-location package
+                                                                  'version)
+                                          (package-location package))))
+                          (when version
+                            (format (current-error-port)
+                                    (_ "~a: ~a: updating from version ~a to version ~a...~%")
+                                    (location->string loc) (package-name package)
+                                    (package-version package) version)
+                            (let ((hash (call-with-input-file tarball
+                                          (compose sha256 get-bytevector-all))))
+                              (update-package-source package version hash)))))
+                      packages))))))

guix/scripts/substitute-binary.scm

@@ -22,18 +22,20 @@
   #:use-module (guix utils)
   #:use-module (guix config)
   #:use-module (guix nar)
+  #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 ftw)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (web uri)
-  #:use-module (web client)
+  #:use-module (guix web)
-  #:use-module (web response)
   #:export (guix-substitute-binary))
 
 ;;; Comment:
@@ -47,6 +49,40 @@
 ;;;
 ;;; Code:
 
+(define %narinfo-cache-directory
+  ;; A local cache of narinfos, to avoid going to the network.
+  (or (and=> (getenv "XDG_CACHE_HOME")
+             (cut string-append <> "/guix/substitute-binary"))
+      (string-append %state-directory "/substitute-binary/cache")))
+
+(define %narinfo-ttl
+  ;; Number of seconds during which cached narinfo lookups are considered
+  ;; valid.
+  (* 24 3600))
+
+(define %narinfo-negative-ttl
+  ;; Likewise, but for negative lookups---i.e., cached lookup failures.
+  (* 3 3600))
+
+(define %narinfo-expired-cache-entry-removal-delay
+  ;; How often we want to remove files corresponding to expired cache entries.
+  (* 7 24 3600))
+
+(define (with-atomic-file-output file proc)
+  "Call PROC with an output port for the file that is going to replace FILE.
+Upon success, FILE is atomically replaced by what has been written to the
+output port, and PROC's result is returned."
+  (let* ((template (string-append file ".XXXXXX"))
+         (out      (mkstemp! template)))
+    (with-throw-handler #t
+      (lambda ()
+        (let ((result (proc out)))
+          (close out)
+          (rename-file template file)
+          result))
+      (lambda (key . args)
+        (false-if-exception (delete-file template))))))
+
 (define (fields->alist port)
   "Read recutils-style record from PORT and return them as a list of key/value
 pairs."
@@ -72,6 +108,17 @@ pairs."
   (let ((args (map (cut assoc-ref alist <>) keys)))
     (apply make args)))
 
+(define (object->fields object fields port)
+  "Write OBJECT (typically a record) as a series of recutils-style fields to
+PORT, according to FIELDS.  FIELDS must be a list of field name/getter pairs."
+  (let loop ((fields fields))
+    (match fields
+      (()
+       object)
+      (((field . get) rest ...)
+       (format port "~a: ~a~%" field (get object))
+       (loop rest)))))
+
 (define (fetch uri)
   "Return a binary input port to URI and the number of bytes it's expected to
 provide."
@@ -80,28 +127,7 @@ provide."
      (let ((port (open-input-file (uri-path uri))))
        (values port (stat:size (stat port)))))
     ((http)
-     (let*-values (((resp port)
+     (http-fetch uri #:text? #f))))
-                    ;; XXX: `http-get*' was introduced in 2.0.7, and deprecated
-                    ;; in 2.0.8 (!).  Assume it is available here.
-                    (if (version>? "2.0.7" (version))
-                        (http-get* uri #:decode-body? #f)
-                        (http-get uri #:streaming? #t)))
-                   ((code)
-                    (response-code resp))
-                   ((size)
-                    (response-content-length resp)))
-       (case code
-         ((200)                                   ; OK
-          (values port size))
-         ((301                                    ; moved permanently
-           302)                                   ; found (redirection)
-          (let ((uri (response-location resp)))
-            (format #t "following redirection to `~a'...~%"
-                    (uri->string uri))
-            (fetch uri)))
-         (else
-          (error "download failed" (uri->string uri)
-                 code (response-reason-phrase resp))))))))
 
 (define-record-type <cache>
   (%make-cache url store-directory wants-mass-query?)
@@ -161,22 +187,166 @@ failure."
                      (_ deriver))
                    system)))
 
+(define* (read-narinfo port #:optional url)
+  "Read a narinfo from PORT in its standard external form.  If URL is true, it
+must be a string used to build full URIs from relative URIs found while
+reading PORT."
+  (alist->record (fields->alist port)
+                 (narinfo-maker url)
+                 '("StorePath" "URL" "Compression"
+                   "FileHash" "FileSize" "NarHash" "NarSize"
+                   "References" "Deriver" "System")))
+
+(define (write-narinfo narinfo port)
+  "Write NARINFO to PORT."
+  (define (empty-string-if-false x)
+    (or x ""))
+
+  (define (number-or-empty-string x)
+    (if (number? x)
+        (number->string x)
+        ""))
+
+  (object->fields narinfo
+                  `(("StorePath" . ,narinfo-path)
+                    ("URL" . ,(compose uri->string narinfo-uri))
+                    ("Compression" . ,narinfo-compression)
+                    ("FileHash" . ,(compose empty-string-if-false
+                                            narinfo-file-hash))
+                    ("FileSize" . ,(compose number-or-empty-string
+                                            narinfo-file-size))
+                    ("NarHash" . ,(compose empty-string-if-false
+                                           narinfo-hash))
+                    ("NarSize" . ,(compose number-or-empty-string
+                                           narinfo-size))
+                    ("References" . ,(compose string-join narinfo-references))
+                    ("Deriver" . ,(compose empty-string-if-false
+                                           narinfo-deriver))
+                    ("System" . ,narinfo-system))
+                  port))
+
+(define (narinfo->string narinfo)
+  "Return the external representation of NARINFO."
+  (call-with-output-string (cut write-narinfo narinfo <>)))
+
+(define (string->narinfo str)
+  "Return the narinfo represented by STR."
+  (call-with-input-string str (cut read-narinfo <>)))
+
 (define (fetch-narinfo cache path)
   "Return the <narinfo> record for PATH, or #f if CACHE does not hold PATH."
   (define (download url)
     ;; Download the `nix-cache-info' from URL, and return its contents as an
     ;; list of key/value pairs.
-    (and=> (false-if-exception (fetch (string->uri url)))
+    (false-if-exception (fetch (string->uri url))))
-           fields->alist))
 
-  (and=> (download (string-append (cache-url cache) "/"
+  (and (string=? (cache-store-directory cache) (%store-prefix))
-                                  (store-path-hash-part path)
+       (and=> (download (string-append (cache-url cache) "/"
-                                  ".narinfo"))
+                                       (store-path-hash-part path)
-         (lambda (properties)
+                                       ".narinfo"))
-           (alist->record properties (narinfo-maker (cache-url cache))
+              (cute read-narinfo <> (cache-url cache)))))
-                          '("StorePath" "URL" "Compression"
+
-                            "FileHash" "FileSize" "NarHash" "NarSize"
+(define (obsolete? date now ttl)
-                            "References" "Deriver" "System")))))
+  "Return #t if DATE is obsolete compared to NOW + TTL seconds."
+  (time>? (subtract-duration now (make-time time-duration 0 ttl))
+          (make-time time-monotonic 0 date)))
+
+(define (lookup-narinfo cache path)
+  "Check locally if we have valid info about PATH, otherwise go to CACHE and
+check what it has."
+  (define now
+    (current-time time-monotonic))
+
+  (define cache-file
+    (string-append %narinfo-cache-directory "/"
+                   (store-path-hash-part path)))
+
+  (define (cache-entry narinfo)
+    `(narinfo (version 0)
+              (date ,(time-second now))
+              (value ,(and=> narinfo narinfo->string))))
+
+  (let*-values (((valid? cached)
+                 (catch 'system-error
+                   (lambda ()
+                     (call-with-input-file cache-file
+                       (lambda (p)
+                         (match (read p)
+                           (('narinfo ('version 0) ('date date)
+                                      ('value #f))
+                            ;; A cached negative lookup.
+                            (if (obsolete? date now %narinfo-negative-ttl)
+                                (values #f #f)
+                                (values #t #f)))
+                           (('narinfo ('version 0) ('date date)
+                                      ('value value))
+                            ;; A cached positive lookup
+                            (if (obsolete? date now %narinfo-ttl)
+                                (values #f #f)
+                                (values #t (string->narinfo value))))))))
+                   (lambda _
+                     (values #f #f)))))
+    (if valid?
+        cached                                    ; including negative caches
+        (let ((narinfo (and=> (force cache)
+                              (cut fetch-narinfo <> path))))
+          (with-atomic-file-output cache-file
+            (lambda (out)
+              (write (cache-entry narinfo) out)))
+          narinfo))))
+
+(define (remove-expired-cached-narinfos)
+  "Remove expired narinfo entries from the cache.  The sole purpose of this
+function is to make sure `%narinfo-cache-directory' doesn't grow
+indefinitely."
+  (define now
+    (current-time time-monotonic))
+
+  (define (expired? file)
+    (catch 'system-error
+      (lambda ()
+        (call-with-input-file file
+          (lambda (port)
+            (match (read port)
+              (('narinfo ('version 0) ('date date)
+                         ('value #f))
+               (obsolete? date now %narinfo-negative-ttl))
+              (('narinfo ('version 0) ('date date)
+                         ('value _))
+               (obsolete? date now %narinfo-ttl))
+              (_ #t)))))
+      (lambda args
+        ;; FILE may have been deleted.
+        #t)))
+
+  (for-each (lambda (file)
+              (let ((file (string-append %narinfo-cache-directory
+                                         "/" file)))
+                (when (expired? file)
+                  ;; Wrap in `false-if-exception' because FILE might have been
+                  ;; deleted in the meantime (TOCTTOU).
+                  (false-if-exception (delete-file file)))))
+            (scandir %narinfo-cache-directory
+                     (lambda (file)
+                       (= (string-length file) 32)))))
+
+(define (maybe-remove-expired-cached-narinfo)
+  "Remove expired narinfo entries from the cache if deemed necessary."
+  (define now
+    (current-time time-monotonic))
+
+  (define expiry-file
+    (string-append %narinfo-cache-directory "/last-expiry-cleanup"))
+
+  (define last-expiry-date
+    (or (false-if-exception
+         (call-with-input-file expiry-file read))
+        0))
+
+  (when (obsolete? last-expiry-date now %narinfo-expired-cache-entry-removal-delay)
+    (remove-expired-cached-narinfos)
+    (call-with-output-file expiry-file
+      (cute write (time-second now) <>))))
 
 (define (filtered-port command input)
   "Return an input port (and PID) where data drained from INPUT is filtered
@@ -214,9 +384,11 @@ through COMMAND.  INPUT must be a file input port."
 
 (define (guix-substitute-binary . args)
   "Implement the build daemon's substituter protocol."
+  (mkdir-p %narinfo-cache-directory)
+  (maybe-remove-expired-cached-narinfo)
   (match args
     (("--query")
-     (let ((cache (open-cache %cache-url)))
+     (let ((cache (delay (open-cache %cache-url))))
        (let loop ((command (read-line)))
          (or (eof-object? command)
              (begin
@@ -225,7 +397,7 @@ through COMMAND.  INPUT must be a file input port."
                   ;; Return the subset of PATHS available in CACHE.
                   (let ((substitutable
                          (if cache
-                             (par-map (cut fetch-narinfo cache <>)
+                             (par-map (cut lookup-narinfo cache <>)
                                       paths)
                              '())))
                     (for-each (lambda (narinfo)
@@ -237,7 +409,7 @@ through COMMAND.  INPUT must be a file input port."
                   ;; Reply info about PATHS if it's in CACHE.
                   (let ((substitutable
                          (if cache
-                             (par-map (cut fetch-narinfo cache <>)
+                             (par-map (cut lookup-narinfo cache <>)
                                       paths)
                              '())))
                     (for-each (lambda (narinfo)
@@ -262,8 +434,8 @@ through COMMAND.  INPUT must be a file input port."
                (loop (read-line)))))))
     (("--substitute" store-path destination)
      ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
-     (let* ((cache   (open-cache %cache-url))
+     (let* ((cache   (delay (open-cache %cache-url)))
-            (narinfo (fetch-narinfo cache store-path))
+            (narinfo (lookup-narinfo cache store-path))
             (uri     (narinfo-uri narinfo)))
        ;; Tell the daemon what the expected hash of the Nar itself is.
        (format #t "~a~%" (narinfo-hash narinfo))

guix/snix.scm

@@ -34,6 +34,7 @@
   #:use-module (guix utils)
   #:use-module (guix base32)
   #:use-module (guix config)
+  #:use-module (guix gnu-maintenance)
   #:export (open-nixpkgs
             xml->snix
             nixpkgs->guix-package))
@@ -435,8 +436,16 @@ location of DERIVATION."
 
              (home-page ,(and=> (find-attribute-by-name "homepage" meta)
                                 attribute-value))
-             (synopsis ,(and=> (find-attribute-by-name "description" meta)
+             (synopsis
-                               attribute-value))
+              ;; For GNU packages, prefer the official synopsis.
+              ,(or (false-if-exception
+                    (and=> (find (lambda (gnu-package)
+                                   (equal? (gnu-package-name gnu-package)
+                                           name))
+                                 (official-gnu-packages))
+                           gnu-package-doc-summary))
+                   (and=> (find-attribute-by-name "description" meta)
+                          attribute-value)))
              (description
               ,(and=> (find-attribute-by-name "longDescription" meta)
                       attribute-value))

guix/store.scm

@@ -336,7 +336,10 @@ encoding conversion errors."
              #f))
           ((= k %stderr-error)
            (let ((error  (read-latin1-string p))
-                 (status (if (>= (nix-server-minor-version server) 8)
+                 ;; Currently the daemon fails to send a status code for early
+                 ;; errors like DB schema version mismatches, so check for EOF.
+                 (status (if (and (>= (nix-server-minor-version server) 8)
+                                  (not (eof-object? (lookahead-u8 p))))
                              (read-int p)
                              1)))
              (raise (condition (&nix-protocol-error

guix/ui.scm

@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,7 +41,6 @@
             with-error-handling
             read/eval-package-expression
             location->string
-            call-with-temporary-output-file
             switch-symlinks
             config-directory
             fill-paragraph
@@ -64,15 +64,50 @@
 (define _ (cut gettext <> %gettext-domain))
 (define N_ (cut ngettext <> <> <> %gettext-domain))
 
+(define-syntax-rule (define-diagnostic name prefix)
+  "Create a diagnostic macro (i.e., NAME), which will prepend PREFIX to all
+messages."
+  (define-syntax name
+    (lambda (x)
+      (define (augmented-format-string fmt)
+        (string-append "~:[~*~;guix ~a: ~]~a" (syntax->datum fmt)))
+
+      (syntax-case x (N_ _)                    ; these are literals, yeah...
+        ((name (_ fmt) args (... ...))
+         (string? (syntax->datum #'fmt))
+         (with-syntax ((fmt*   (augmented-format-string #'fmt))
+                       (prefix (datum->syntax x prefix)))
+           #'(format (guix-warning-port) (gettext fmt*)
+                     (program-name) (program-name) prefix
+                     args (... ...))))
+        ((name (N_ singular plural n) args (... ...))
+         (and (string? (syntax->datum #'singular))
+              (string? (syntax->datum #'plural)))
+         (with-syntax ((s      (augmented-format-string #'singular))
+                       (p      (augmented-format-string #'plural))
+                       (prefix (datum->syntax x prefix)))
+           #'(format (guix-warning-port)
+                     (ngettext s p n %gettext-domain)
+                     (program-name) (program-name) prefix
+                     args (... ...))))))))
+
+(define-diagnostic warning "warning: ") ; emit a warning
+
+(define-diagnostic report-error "error: ")
+(define-syntax-rule (leave args ...)
+  "Emit an error message and exit."
+  (begin
+    (report-error args ...)
+    (exit 1)))
+
 (define (install-locale)
   "Install the current locale settings."
   (catch 'system-error
     (lambda _
       (setlocale LC_ALL ""))
     (lambda args
-      (format (current-error-port)
+      (warning (_ "failed to install locale: ~a~%")
-              (_ "warning: failed to install locale: ~a~%")
+               (strerror (system-error-errno args))))))
-              (strerror (system-error-errno args))))))
 
 (define (initialize-guix)
   "Perform the usual initialization for stand-alone Guix commands."
@@ -81,12 +116,6 @@
   (setvbuf (current-output-port) _IOLBF)
   (setvbuf (current-error-port) _IOLBF))
 
-(define-syntax-rule (leave fmt args ...)
-  "Format FMT and ARGS to the error port and exit."
-  (begin
-    (format (current-error-port) fmt args ...)
-    (exit 1)))
-
 (define* (show-version-and-exit #:optional (command (car (command-line))))
   "Display version information for COMMAND and `(exit 0)'."
   (simple-format #t "~a (~a) ~a~%"
@@ -111,16 +140,16 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
                     (file     (location-file location))
                     (line     (location-line location))
                     (column   (location-column location)))
-               (leave (_ "~a:~a:~a: error: package `~a' has an invalid input: ~s~%")
+               (leave (_ "~a:~a:~a: package `~a' has an invalid input: ~s~%")
                       file line column
                       (package-full-name package) input)))
             ((nix-connection-error? c)
-             (leave (_ "error: failed to connect to `~a': ~a~%")
+             (leave (_ "failed to connect to `~a': ~a~%")
                     (nix-connection-error-file c)
                     (strerror (nix-connection-error-code c))))
             ((nix-protocol-error? c)
              ;; FIXME: Server-provided error messages aren't i18n'd.
-             (leave (_ "error: build failed: ~a~%")
+             (leave (_ "build failed: ~a~%")
                     (nix-protocol-error-message c))))
     (thunk)))
 
@@ -144,33 +173,66 @@ error."
           (leave (_ "expression `~s' does not evaluate to a package~%")
                  exp)))))
 
-(define* (show-what-to-build store drv #:optional dry-run?)
+(define* (show-what-to-build store drv
+                             #:key dry-run? (use-substitutes? #t))
   "Show what will or would (depending on DRY-RUN?) be built in realizing the
 derivations listed in DRV.  Return #t if there's something to build, #f
-otherwise."
+otherwise.  When USE-SUBSTITUTES?, check and report what is prerequisites are
-  (let* ((req  (append-map (lambda (drv-path)
+available for download."
-                             (let ((d (call-with-input-file drv-path
+  (let*-values (((build download)
-                                        read-derivation)))
+                 (fold2 (lambda (drv-path build download)
-                               (derivation-prerequisites-to-build
+                          (let ((drv (call-with-input-file drv-path
-                                store d)))
+                                       read-derivation)))
-                           drv))
+                            (let-values (((b d)
-         (req* (delete-duplicates
+                                          (derivation-prerequisites-to-build
-                (append (remove (compose (cute valid-path? store <>)
+                                           store drv
-                                         derivation-path->output-path)
+                                           #:use-substitutes?
-                                drv)
+                                           use-substitutes?)))
-                        (map derivation-input-path req)))))
+                              (values (append b build)
+                                      (append d download)))))
+                        '() '()
+                        drv))
+                ((build)                          ; add the DRV themselves
+                 (delete-duplicates
+                  (append (remove (compose (lambda (out)
+                                             (or (valid-path? store out)
+                                                 (and use-substitutes?
+                                                      (has-substitutes? store
+                                                                        out))))
+                                           derivation-path->output-path)
+                                  drv)
+                          (map derivation-input-path build))))
+                ((download)                   ; add the references of DOWNLOAD
+                 (delete-duplicates
+                  (append download
+                          (remove (cut valid-path? store <>)
+                                  (append-map
+                                   substitutable-references
+                                   (substitutable-path-info store download)))))))
     (if dry-run?
-        (format (current-error-port)
+        (begin
-                (N_ "~:[the following derivation would be built:~%~{   ~a~%~}~;~]"
+          (format (current-error-port)
-                    "~:[the following derivations would be built:~%~{    ~a~%~}~;~]"
+                  (N_ "~:[the following derivation would be built:~%~{   ~a~%~}~;~]"
-                    (length req*))
+                      "~:[the following derivations would be built:~%~{    ~a~%~}~;~]"
-                (null? req*) req*)
+                      (length build))
-        (format (current-error-port)
+                  (null? build) build)
-                (N_ "~:[the following derivation will be built:~%~{   ~a~%~}~;~]"
+          (format (current-error-port)
-                    "~:[the following derivations will be built:~%~{    ~a~%~}~;~]"
+                  (N_ "~:[the following file would be downloaded:~%~{   ~a~%~}~;~]"
-                    (length req*))
+                      "~:[the following files would be downloaded:~%~{    ~a~%~}~;~]"
-                (null? req*) req*))
+                      (length download))
-    (pair? req*)))
+                  (null? download) download))
+        (begin
+          (format (current-error-port)
+                  (N_ "~:[the following derivation will be built:~%~{   ~a~%~}~;~]"
+                      "~:[the following derivations will be built:~%~{    ~a~%~}~;~]"
+                      (length build))
+                  (null? build) build)
+          (format (current-error-port)
+                  (N_ "~:[the following file will be downloaded:~%~{   ~a~%~}~;~]"
+                      "~:[the following files will be downloaded:~%~{    ~a~%~}~;~]"
+                      (length download))
+                  (null? download) download)))
+    (pair? build)))
 
 (define-syntax with-error-handling
   (syntax-rules ()
@@ -187,21 +249,6 @@ otherwise."
     (($ <location> file line column)
      (format #f "~a:~a:~a" file line column))))
 
-(define (call-with-temporary-output-file proc)
-  "Call PROC with a name of a temporary file and open output port to that
-file; close the file and delete it when leaving the dynamic extent of this
-call."
-  (let* ((template (string-copy "guix-file.XXXXXX"))
-         (out      (mkstemp! template)))
-    (dynamic-wind
-      (lambda ()
-        #t)
-      (lambda ()
-        (proc template out))
-      (lambda ()
-        (false-if-exception (close out))
-        (false-if-exception (delete-file template))))))
-
 (define (switch-symlinks link target)
   "Atomically switch LINK, a symbolic link, to point to TARGET.  Works
 both when LINK already exists and when it does not."
@@ -342,36 +389,6 @@ WIDTH columns."
 (define guix-warning-port
   (make-parameter (current-warning-port)))
 
-(define-syntax warning
-  (lambda (s)
-    "Emit a warming.  The macro assumes that `_' is bound to `gettext'."
-    ;; All this just to preserve `-Wformat' warnings.  Too much?
-
-    (define (augmented-format-string fmt)
-      (string-append "~:[~;guix ~a: ~]~a" (syntax->datum fmt)))
-
-    (define prefix
-      #'(_ "warning: "))
-
-    (syntax-case s (N_ _)                        ; these are literals, yeah...
-      ((warning (_ fmt) args ...)
-       (string? (syntax->datum #'fmt))
-       (with-syntax ((fmt*   (augmented-format-string #'fmt))
-                     (prefix prefix))
-         #'(format (guix-warning-port) (gettext fmt*)
-                   (program-name) (program-name) prefix
-                   args ...)))
-      ((warning (N_ singular plural n) args ...)
-       (and (string? (syntax->datum #'singular))
-            (string? (syntax->datum #'plural)))
-       (with-syntax ((s (augmented-format-string #'singular))
-                     (p (augmented-format-string #'plural))
-                     (b prefix))
-         #'(format (guix-warning-port)
-                   (ngettext s p n %gettext-domain)
-                   (program-name) (program-name) b
-                   args ...))))))
-
 (define (guix-main arg0 . args)
   (initialize-guix)
   (let ()

guix/utils.scm

@@ -59,7 +59,10 @@
             %current-system
             version-compare
             version>?
-            package-name->name+version))
+            package-name->name+version
+            file-extension
+            call-with-temporary-output-file
+            fold2))
 
 
 ;;;
@@ -463,6 +466,52 @@ introduce the version part."
       ((head tail ...)
        (loop tail (cons head prefix))))))
 
+(define (file-extension file)
+  "Return the extension of FILE or #f if there is none."
+  (let ((dot (string-rindex file #\.)))
+    (and dot (substring file (+ 1 dot) (string-length file)))))
+
+(define (call-with-temporary-output-file proc)
+  "Call PROC with a name of a temporary file and open output port to that
+file; close the file and delete it when leaving the dynamic extent of this
+call."
+  (let* ((template (string-copy "guix-file.XXXXXX"))
+         (out      (mkstemp! template)))
+    (dynamic-wind
+      (lambda ()
+        #t)
+      (lambda ()
+        (proc template out))
+      (lambda ()
+        (false-if-exception (close out))
+        (false-if-exception (delete-file template))))))
+
+(define fold2
+  (case-lambda
+    ((proc seed1 seed2 lst)
+     "Like `fold', but with a single list and two seeds."
+     (let loop ((result1 seed1)
+                (result2 seed2)
+                (lst     lst))
+       (if (null? lst)
+           (values result1 result2)
+           (call-with-values
+               (lambda () (proc (car lst) result1 result2))
+             (lambda (result1 result2)
+               (loop result1 result2 (cdr lst)))))))
+    ((proc seed1 seed2 lst1 lst2)
+     "Like `fold', but with a two lists and two seeds."
+     (let loop ((result1 seed1)
+                (result2 seed2)
+                (lst1    lst1)
+                (lst2    lst2))
+       (if (or (null? lst1) (null? lst2))
+           (values result1 result2)
+           (call-with-values
+               (lambda () (proc (car lst1) (car lst2) result1 result2))
+             (lambda (result1 result2)
+               (fold2 proc result1 result2 (cdr lst1) (cdr lst2)))))))))
+
 
 ;;;
 ;;; Source location.
@@ -490,5 +539,6 @@ etc."
   (let ((file (assq-ref loc 'filename))
         (line (assq-ref loc 'line))
         (col  (assq-ref loc 'column)))
-    ;; In accordance with the GCS, start line and column numbers at 1.
+    ;; In accordance with the GCS, start line and column numbers at 1.  Note
-    (location file (and line (+ line 1)) (and col (+ col 1)))))
+    ;; that unlike LINE and `port-column', COL is actually 1-indexed here...
+    (location file (and line (+ line 1)) col)))

guix/web.scm

@@ -0,0 +1,85 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 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 web)
+  #:use-module (web uri)
+  #:use-module (web client)
+  #:use-module (web response)
+  #:use-module (srfi srfi-11)
+  #:use-module (rnrs io ports)
+  #:use-module (rnrs bytevectors)
+  #:use-module (guix ui)
+  #:use-module (guix utils)
+  #:export (http-fetch))
+
+;;; Commentary:
+;;;
+;;; Web client portable among Guile versions.
+;;;
+;;; Code:
+
+(define* (http-fetch uri #:key (text? #f))
+  "Return an input port containing the data at URI, and the expected number of
+bytes available or #f.  If TEXT? is true, the data at URI is considered to be
+textual.  Follow any HTTP redirection."
+  (let loop ((uri uri))
+    (let*-values (((resp data)
+                   ;; Try hard to use the API du jour to get an input port.
+                   ;; On Guile 2.0.5 and before, we can only get a string or
+                   ;; bytevector, and not an input port.  Work around that.
+                   (if (version>? "2.0.7" (version))
+                       (if (defined? 'http-get*)
+                           (http-get* uri #:decode-body? text?) ; 2.0.7
+                           (http-get uri #:decode-body? text?)) ; 2.0.5-
+                       (http-get uri #:streaming? #t)))         ; 2.0.9+
+                  ((code)
+                   (response-code resp)))
+      (case code
+        ((200)
+         (let ((len (response-content-length resp)))
+           (cond ((not data)
+                  (begin
+                    ;; XXX: Guile 2.0.5 and earlier did not support chunked
+                    ;; transfer encoding, which is required for instance when
+                    ;; fetching %PACKAGE-LIST-URL (see
+                    ;; <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>).
+                    ;; Since users may still be using these versions, warn them
+                    ;; and bail out.
+                    (warning (_ "using Guile ~a, ~a ~s encoding~%")
+                             (version)
+                             "which does not support HTTP"
+                             (response-transfer-encoding resp))
+                    (leave (_ "download failed; use a newer Guile~%")
+                           uri resp)))
+                 ((string? data)                   ; `http-get' from 2.0.5-
+                  (values (open-input-string data) len))
+                 ((bytevector? data)               ; likewise
+                  (values (open-bytevector-input-port data) len))
+                 (else                             ; input port
+                  (values data len)))))
+        ((301                                      ; moved permanently
+          302)                                     ; found (redirection)
+         (let ((uri (response-location resp)))
+           (format #t "following redirection to `~a'...~%"
+                   (uri->string uri))
+           (loop uri)))
+        (else
+         (error "download failed" uri code
+                (response-reason-phrase resp)))))))
+
+;;; web.scm ends here

nix/nix-daemon/guix-daemon.cc

@@ -65,6 +65,7 @@ builds derivations on behalf of its clients.";
 #define GUIX_OPT_DEBUG 9
 #define GUIX_OPT_CHROOT_DIR 10
 #define GUIX_OPT_LISTEN 11
+#define GUIX_OPT_NO_SUBSTITUTES 12
 
 static const struct argp_option options[] =
   {
@@ -90,6 +91,8 @@ static const struct argp_option options[] =
     },
     { "build-users-group", GUIX_OPT_BUILD_USERS_GROUP, "GROUP", 0,
       "Perform builds as a user of GROUP" },
+    { "no-substitutes", GUIX_OPT_NO_SUBSTITUTES, 0, 0,
+      "Do not use substitutes" },
     { "cache-failures", GUIX_OPT_CACHE_FAILURES, 0, 0,
       "Cache build failures" },
     { "lose-logs", GUIX_OPT_LOSE_LOGS, 0, 0,
@@ -152,6 +155,9 @@ parse_opt (int key, char *arg, struct argp_state *state)
 	  exit (EXIT_FAILURE);
 	}
       break;
+    case GUIX_OPT_NO_SUBSTITUTES:
+      settings.useSubstitutes = false;
+      break;
     case GUIX_OPT_DEBUG:
       verbosity = lvlDebug;
       break;
@@ -202,18 +208,21 @@ main (int argc, char *argv[])
 
       /* Use our substituter by default.  */
       settings.substituters.clear ();
-      string subs = getEnv ("NIX_SUBSTITUTERS", "default");
+      settings.useSubstitutes = true;
-      if (subs == "default")
-	/* XXX: No substituters until we have something that works.  */
-	settings.substituters.clear ();
-	// settings.substituters.push_back (settings.nixLibexecDir
-	// 				 + "/guix/substitute-binary");
-      else
-	settings.substituters = tokenizeString<Strings> (subs, ":");
-
 
       argp_parse (&argp, argc, argv, 0, 0, 0);
 
+      if (settings.useSubstitutes)
+	{
+	  string subs = getEnv ("NIX_SUBSTITUTERS", "default");
+
+	  if (subs == "default")
+	    settings.substituters.push_back (settings.nixLibexecDir
+					     + "/guix/substitute-binary");
+	  else
+	    settings.substituters = tokenizeString<Strings> (subs, ":");
+	}
+
       if (geteuid () == 0 && settings.buildUsersGroup.empty ())
 	fprintf (stderr, "warning: daemon is running as root, so "
 		 "using `--build-users-group' is highly recommended\n");

po/POTFILES.in

@@ -8,5 +8,8 @@ guix/scripts/build.scm
 guix/scripts/download.scm
 guix/scripts/package.scm
 guix/scripts/gc.scm
+guix/scripts/hash.scm
 guix/scripts/pull.scm
+guix/gnu-maintenance.scm
 guix/ui.scm
+guix/web.scm

test-env.in

@@ -45,9 +45,13 @@ then
     rm -rf "$NIX_STATE_DIR/substituter-data"
     mkdir -p "$NIX_STATE_DIR/substituter-data"
 
+    # Place for the substituter's cache.
+    XDG_CACHE_HOME="$NIX_STATE_DIR/cache-$$"
+
     export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR			\
 	NIX_LOCALSTATE_DIR NIX_LOG_DIR NIX_STATE_DIR NIX_DB_DIR		\
-	NIX_ROOT_FINDER NIX_SETUID_HELPER GUIX_BINARY_SUBSTITUTE_URL
+	NIX_ROOT_FINDER NIX_SETUID_HELPER GUIX_BINARY_SUBSTITUTE_URL	\
+        XDG_CACHE_HOME
 
     # Do that because store.scm calls `canonicalize-path' on it.
     mkdir -p "$NIX_STORE_DIR"

tests/derivations.scm

@@ -32,6 +32,7 @@
   #:use-module (srfi srfi-64)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
+  #:use-module (web uri)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 ftw)
@@ -398,6 +399,51 @@
          ;; prerequisite to build because DRV itself is already built.
          (null? (derivation-prerequisites-to-build %store drv)))))
 
+(test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1))
+(test-assert "derivation-prerequisites-to-build and substitutes"
+  (let*-values (((store)
+                 (open-connection))
+                ((drv-path drv)
+                 (build-expression->derivation store "prereq-subst"
+                                               (%current-system)
+                                               (random 1000) '()))
+                ((output)
+                 (derivation-output-path
+                  (assoc-ref (derivation-outputs drv) "out")))
+                ((dir)
+                 (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
+                        (compose uri-path string->uri))))
+    ;; Create fake substituter data, to be read by `substitute-binary'.
+    (call-with-output-file (string-append dir "/nix-cache-info")
+      (lambda (p)
+        (format p "StoreDir: ~a\nWantMassQuery: 0\n"
+                (%store-prefix))))
+    (call-with-output-file (string-append dir "/" (store-path-hash-part output)
+                                          ".narinfo")
+      (lambda (p)
+        (format p "StorePath: ~a
+URL: ~a
+Compression: none
+NarSize: 1234
+References: 
+System: ~a
+Deriver: ~a~%"
+                output                              ; StorePath
+                (string-append dir "/example.nar")  ; URL
+                (%current-system)                   ; System
+                (basename drv-path))))              ; Deriver
+
+    (let-values (((build download)
+                  (derivation-prerequisites-to-build store drv))
+                 ((build* download*)
+                  (derivation-prerequisites-to-build store drv
+                                                     #:use-substitutes? #f)))
+      (pk build download build* download*)
+      (and (null? build)
+           (equal? download (list output))
+           (null? download*)
+           (null? build*)))))
+
 (test-assert "build-expression->derivation with expression returning #f"
   (let* ((builder  '(begin
                       (mkdir %output)

tests/guix-package.sh

@@ -62,18 +62,19 @@ then
     # name and version string.
     installed="`guix package -p "$profile" --list-installed | cut -f1 | xargs echo | sort`"
     case "x$installed" in
-	"guile-bootstrap make-boot0")
+        "guile-bootstrap make-boot0")
-	    true;;
+            true;;
-	"make-boot0 guile-bootstrap")
+        "make-boot0 guile-bootstrap")
-	    true;;
+            true;;
-	"*")
+        "*")
             false;;
     esac
 
     test "`guix package -p "$profile" -I 'g.*e' | cut -f1`" = "guile-bootstrap"
 
     # Search.
-    test "`guix package -s "GNU Hello" | grep ^name:`" = "name: hello"
+    test "`guix package -s "An example GNU package" | grep ^name:`" = \
+        "name: hello"
     test "`guix package -s "n0t4r341p4ck4g3"`" = ""
 
     # Remove a package.
@@ -92,10 +93,10 @@ then
     # Move to the empty profile.
     for i in `seq 1 3`
     do
-	guix package --bootstrap --roll-back -p "$profile"
+        guix package --bootstrap --roll-back -p "$profile"
-	! test -f "$profile/bin"
+        ! test -f "$profile/bin"
-	! test -f "$profile/lib"
+        ! test -f "$profile/lib"
-	test "`readlink_base "$profile"`" = "$profile-0-link"
+        test "`readlink_base "$profile"`" = "$profile-0-link"
     done
 
     # Reinstall after roll-back to the empty profile.

tests/nar.scm

@@ -196,7 +196,8 @@
                   (cut restore-file <> output))
                 (file-tree-equal? input output))
               (lambda ()
-                (false-if-exception (delete-file nar)))))))
+                (false-if-exception (delete-file nar))
+                (false-if-exception (rm-rf output)))))))
       (lambda ()
         (rmdir input)))))
 

tests/packages.scm

@@ -53,6 +53,28 @@
            (home-page #f) (license #f)
            extra-fields ...))
 
+(test-assert "package-field-location"
+  (let ()
+    (define (goto port line column)
+      (unless (and (= (port-column port) (- column 1))
+                   (= (port-line port) (- line 1)))
+        (unless (eof-object? (get-char port))
+          (goto port line column))))
+
+    (define read-at
+      (match-lambda
+       (($ <location> file line column)
+        (call-with-input-file (search-path %load-path file)
+          (lambda (port)
+            (goto port line column)
+            (read port))))))
+
+    (and (equal? (read-at (package-field-location %bootstrap-guile 'name))
+                 (package-name %bootstrap-guile))
+         (equal? (read-at (package-field-location %bootstrap-guile 'version))
+                 (package-version %bootstrap-guile))
+         (not (package-field-location %bootstrap-guile 'does-not-exist)))))
+
 (test-assert "package-transitive-inputs"
   (let* ((a (dummy-package "a"))
          (b (dummy-package "b"

tests/store.scm

@@ -159,6 +159,12 @@ Deriver: ~a~%"
                 (%current-system)                   ; System
                 (basename d))))                     ; Deriver
 
+    ;; Remove entry from the local cache.
+    (false-if-exception
+     (delete-file (string-append (getenv "XDG_CACHE_HOME")
+                                 "/guix/substitute-binary/"
+                                 (store-path-hash-part o))))
+
     ;; Make sure `substitute-binary' correctly communicates the above data.
     (set-build-options s #:use-substitutes? #t)
     (and (has-substitutes? s o)

tests/utils.scm

@@ -64,6 +64,31 @@
            ("nixpkgs" "1.0pre22125_a28fe19")
            ("gtk2" "2.38.0"))))
 
+(test-equal "fold2, 1 list"
+    (list (reverse (iota 5))
+          (map - (reverse (iota 5))))
+  (call-with-values
+      (lambda ()
+        (fold2 (lambda (i r1 r2)
+                 (values (cons i r1)
+                         (cons (- i) r2)))
+               '() '()
+               (iota 5)))
+    list))
+
+(test-equal "fold2, 2 lists"
+    (list (reverse '((a . 0) (b . 1) (c . 2) (d . 3)))
+          (reverse '((a . 0) (b . -1) (c . -2) (d . -3))))
+  (call-with-values
+      (lambda ()
+        (fold2 (lambda (k v r1 r2)
+                 (values (alist-cons k v r1)
+                         (alist-cons k (- v) r2)))
+               '() '()
+               '(a b c d)
+               '(0 1 2 3)))
+    list))
+
 (test-assert "define-record-type*"
   (begin
     (define-record-type* <foo> foo make-foo