Merge branch 'master' into core-updates

Makefile.am

@@ -203,6 +203,7 @@ SCM_TESTS =					\
   tests/lint.scm				\
   tests/publish.scm				\
   tests/size.scm				\
+  tests/file-systems.scm			\
   tests/containers.scm
 
 if HAVE_GUILE_JSON

doc/guix.texi

@@ -760,6 +760,7 @@ explicitly enable substitution @i{via} the @code{set-build-options}
 remote procedure call (@pxref{The Store}).
 
 @item --substitute-urls=@var{urls}
+@anchor{daemon-substitute-urls}
 Consider @var{urls} the default whitespace-separated list of substitute
 source URLs.  When this option is omitted, @indicateurl{http://hydra.gnu.org}
 is used.
@@ -1434,9 +1435,12 @@ also result from derivation builds, can be available as substitutes.
 The @code{hydra.gnu.org} server is a front-end to a build farm that
 builds packages from the GNU distribution continuously for some
 architectures, and makes them available as substitutes.  This is the
-default source of substitutes; it can be overridden by passing
+default source of substitutes; it can be overridden by passing the
-@command{guix-daemon} the @code{--substitute-urls} option
+@option{--substitute-urls} option either to @command{guix-daemon}
-(@pxref{Invoking guix-daemon}).
+(@pxref{daemon-substitute-urls,, @code{guix-daemon --substitute-urls}})
+or to client tools such as @command{guix package}
+(@pxref{client-substitute-urls,, client @option{--substitute-urls}
+option}).
 
 @cindex security
 @cindex digital signatures
@@ -3584,6 +3588,16 @@ Do not build the derivations.
 When substituting a pre-built binary fails, fall back to building
 packages locally.
 
+@item --substitute-urls=@var{urls}
+@anchor{client-substitute-urls}
+Consider @var{urls} the whitespace-separated list of substitute source
+URLs, overriding the default list of URLs of @command{guix-daemon}
+(@pxref{daemon-substitute-urls,, @command{guix-daemon} URLs}).
+
+This means that substitutes may be downloaded from @var{urls}, provided
+they are signed by a key authorized by the system administrator
+(@pxref{Substitutes}).
+
 @item --no-substitutes
 Do not use substitutes for build products.  That is, always build things
 locally instead of allowing downloads of pre-built binaries
@@ -4949,8 +4963,24 @@ interpreted as a file name; when it is @code{label}, then @code{device}
 is interpreted as a partition label name; when it is @code{uuid},
 @code{device} is interpreted as a partition unique identifier (UUID).
 
+UUIDs may be converted from their string representation (as shown by the
+@command{tune2fs -l} command) using the @code{uuid} form, like this:
+
+@example
+(file-system
+  (mount-point "/home")
+  (type "ext4")
+  (title 'uuid)
+  (device (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))
+@end example
+
 The @code{label} and @code{uuid} options offer a way to refer to disk
-partitions without having to hard-code their actual device name.
+partitions without having to hard-code their actual device
+name@footnote{Note that, while it is tempting to use
+@file{/dev/disk/by-uuid} and similar device names to achieve the same
+result, this is not recommended: These special device nodes are created
+by the udev daemon and may be unavailable at the time the device is
+mounted.}.
 
 However, when a file system's source is a mapped device (@pxref{Mapped
 Devices}), its @code{device} field @emph{must} refer to the mapped

emacs/guix-emacs.el

@@ -42,19 +42,40 @@ If PROFILE is nil, use `guix-user-profile'."
   (expand-file-name "share/emacs/site-lisp"
                     (or profile guix-user-profile)))
 
+(defun guix-emacs-find-autoloads-in-directory (directory)
+  "Return list of Emacs 'autoloads' files in DIRECTORY."
+  (directory-files directory 'full-name "-autoloads\\.el\\'" 'no-sort))
+
+(defun guix-emacs-subdirs (directory)
+  "Return list of DIRECTORY subdirectories."
+  (cl-remove-if (lambda (file)
+                  (or (string-match-p (rx "/." string-end) file)
+                      (string-match-p (rx "/.." string-end) file)
+                      (not (file-directory-p file))))
+                (directory-files directory 'full-name nil 'no-sort)))
+
 (defun guix-emacs-find-autoloads (&optional profile)
   "Return list of autoloads of Emacs packages installed in PROFILE.
 If PROFILE is nil, use `guix-user-profile'.
 Return nil if there are no emacs packages installed in PROFILE."
-  (let ((dir (guix-emacs-directory profile)))
+  (let ((elisp-root-dir (guix-emacs-directory profile)))
-    (if (file-directory-p dir)
+    (if (file-directory-p elisp-root-dir)
-        (directory-files dir 'full-name "-autoloads\\.el\\'")
+        (let ((elisp-pkgs-dir (expand-file-name "guix.d" elisp-root-dir))
+              (root-autoloads (guix-emacs-find-autoloads-in-directory
+                               elisp-root-dir)))
+          (if (file-directory-p elisp-pkgs-dir)
+              (let ((pkgs-autoloads
+                     (cl-mapcan #'guix-emacs-find-autoloads-in-directory
+                                (guix-emacs-subdirs elisp-pkgs-dir))))
+                (append root-autoloads pkgs-autoloads))
+            root-autoloads))
       (message "Directory '%s' does not exist." dir)
       nil)))
 
 ;;;###autoload
 (defun guix-emacs-load-autoloads (&optional all)
   "Load autoloads for Emacs packages installed in a user profile.
+Add autoloads directories to `load-path'.
 If ALL is nil, activate only those packages that were installed
 after the last activation, otherwise activate all Emacs packages
 installed in `guix-user-profile'."
@@ -65,6 +86,8 @@ installed in `guix-user-profile'."
                   (cl-nset-difference autoloads guix-emacs-autoloads
                                       :test #'string=))))
     (dolist (file files)
+      (cl-pushnew (file-name-directory file) load-path
+                  :test #'string=)
       (load file 'noerror))
     (setq guix-emacs-autoloads autoloads)))
 

emacs/guix-info.el

@@ -1,6 +1,7 @@
 ;;; guix-info.el --- Info buffers for displaying entries   -*- lexical-binding: t -*-
 
-;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
+;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
 
 ;; This file is part of GNU Guix.
 
@@ -482,6 +483,12 @@ If nil, insert package in a default way.")
 (defvar guix-package-info-heading-params '(synopsis description)
   "List of parameters displayed in a heading along with name and version.")
 
+(defcustom guix-package-info-fill-heading t
+  "If nil, insert heading parameters in a raw form, without
+filling them to fit the window."
+  :type 'boolean
+  :group 'guix-package-info)
+
 (defun guix-package-info-insert-heading (entry)
   "Insert the heading for package ENTRY.
 Show package name, version, and `guix-package-info-heading-params'."
@@ -494,8 +501,12 @@ Show package name, version, and `guix-package-info-heading-params'."
                 (face (guix-get-symbol (symbol-name param)
                                        'info 'package)))
             (when val
-              (guix-format-insert val (and (facep face) face))
+              (let* ((col (min (window-width) fill-column))
-              (insert "\n\n"))))
+                     (val (if guix-package-info-fill-heading
+                              (guix-get-filled-string val col)
+                            val)))
+                (guix-format-insert val (and (facep face) face))
+                (insert "\n\n")))))
         guix-package-info-heading-params))
 
 (defun guix-package-info-insert-with-heading (entry)

emacs/guix-init.el.in

@@ -1,5 +1,4 @@
 (require 'guix-autoloads)
-(require 'guix-emacs)
 
 (defvar guix-load-path
   (replace-regexp-in-string "${prefix}" "@prefix@" "@emacsuidir@")
@@ -13,9 +12,8 @@ avoid loading autoloads of Emacs packages installed in
   :type 'boolean
   :group 'guix)
 
-(add-to-list 'load-path (guix-emacs-directory))
-
 (when guix-package-enable-at-startup
+  (require 'guix-emacs)
   (guix-emacs-load-autoloads 'all))
 
 (provide 'guix-init)

gnu-system.am

@@ -86,6 +86,7 @@ GNU_SYSTEM_MODULES =				\
   gnu/packages/dns.scm				\
   gnu/packages/docbook.scm			\
   gnu/packages/doxygen.scm			\
+  gnu/packages/dunst.scm			\
   gnu/packages/ebook.scm			\
   gnu/packages/ed.scm				\
   gnu/packages/elf.scm				\
@@ -256,6 +257,7 @@ GNU_SYSTEM_MODULES =				\
   gnu/packages/qemu.scm				\
   gnu/packages/qt.scm				\
   gnu/packages/ratpoison.scm			\
+  gnu/packages/rc.scm				\
   gnu/packages/rdesktop.scm			\
   gnu/packages/rdf.scm				\
   gnu/packages/readline.scm			\
@@ -272,6 +274,7 @@ GNU_SYSTEM_MODULES =				\
   gnu/packages/search.scm			\
   gnu/packages/serveez.scm			\
   gnu/packages/shishi.scm			\
+  gnu/packages/skarnet.scm			\
   gnu/packages/skribilo.scm			\
   gnu/packages/slang.scm			\
   gnu/packages/slim.scm				\
@@ -391,6 +394,7 @@ dist_patch_DATA =						\
   gnu/packages/patches/binutils-ld-new-dtags.patch		\
   gnu/packages/patches/binutils-loongson-workaround.patch	\
   gnu/packages/patches/bitlbee-configure-doc-fix.patch		\
+  gnu/packages/patches/boost-mips-avoid-m32.patch		\
   gnu/packages/patches/calibre-drop-unrar.patch			\
   gnu/packages/patches/calibre-no-updates-dialog.patch		\
   gnu/packages/patches/cdparanoia-fpic.patch			\

gnu/build/file-systems.scm

@@ -22,13 +22,16 @@
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 format)
   #:use-module (system foreign)
   #:autoload   (system repl repl) (start-repl)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (disk-partitions
             partition-label-predicate
+            partition-uuid-predicate
             find-partition-by-label
+            find-partition-by-uuid
             canonicalize-device-spec
 
             MS_RDONLY
@@ -53,9 +56,10 @@
 ;; 'mount' is already defined in the statically linked Guile used for initial
 ;; RAM disks, but in all other cases the (guix build syscalls) module contains
 ;; the mount binding.
-(unless (defined? 'mount)
+(eval-when (expand load eval)
-  (module-use! (current-module)
+  (unless (defined? 'mount)
-               (resolve-interface '(guix build syscalls))))
+    (module-use! (current-module)
+                 (resolve-interface '(guix build syscalls)))))
 
 ;; Linux mount flags, from libc's <sys/mount.h>.
 (define MS_RDONLY 1)
@@ -158,29 +162,42 @@ if DEVICE does not contain an ext2 file system."
                      (loop (cons name parts))
                      (loop parts))))))))))
 
-(define (partition-label-predicate label)
+(define (read-ext2-superblock* device)
-  "Return a procedure that, when applied to a partition name such as \"sda1\",
+  "Like 'read-ext2-superblock', but return #f when DEVICE does not exist
-return #t if that partition's volume name is LABEL."
+instead of throwing an exception."
-  (lambda (part)
+  (catch 'system-error
-    (let* ((device (string-append "/dev/" part))
+    (lambda ()
-           (sblock (catch 'system-error
+      (read-ext2-superblock device))
-                     (lambda ()
+    (lambda args
-                       (read-ext2-superblock device))
+      ;; When running on the hand-made /dev,
-                     (lambda args
+      ;; 'disk-partitions' could return partitions for which
-                       ;; When running on the hand-made /dev,
+      ;; we have no /dev node.  Handle that gracefully.
-                       ;; 'disk-partitions' could return partitions for which
+      (if (= ENOENT (system-error-errno args))
-                       ;; we have no /dev node.  Handle that gracefully.
+          (begin
-                       (if (= ENOENT (system-error-errno args))
+            (format (current-error-port)
-                           (begin
+                    "warning: device '~a' not found~%" device)
-                             (format (current-error-port)
+            #f)
-                                     "warning: device '~a' not found~%"
+          (apply throw args)))))
-                                     device)
+
-                             #f)
+(define (partition-predicate field =)
-                           (apply throw args))))))
+  "Return a predicate that returns true if the FIELD of an ext2 superblock is
-      (and sblock
+= to the given value."
-           (let ((volume (ext2-superblock-volume-name sblock)))
+  (lambda (expected)
-             (and volume
+    "Return a procedure that, when applied to a partition name such as \"sda1\",
-                  (string=? volume label)))))))
+returns #t if that partition's volume name is LABEL."
+    (lambda (part)
+      (let* ((device (string-append "/dev/" part))
+             (sblock (read-ext2-superblock* device)))
+        (and sblock
+             (let ((actual (field sblock)))
+               (and actual
+                    (= actual expected))))))))
+
+(define partition-label-predicate
+  (partition-predicate ext2-superblock-volume-name string=?))
+
+(define partition-uuid-predicate
+  (partition-predicate ext2-superblock-uuid bytevector=?))
 
 (define (find-partition-by-label label)
   "Return the first partition found whose volume name is LABEL, or #f if none
@@ -189,6 +206,28 @@ were found."
                (disk-partitions))
          (cut string-append "/dev/" <>)))
 
+(define (find-partition-by-uuid uuid)
+  "Return the first partition whose unique identifier is UUID (a bytevector),
+or #f if none was found."
+  (and=> (find (partition-uuid-predicate uuid)
+               (disk-partitions))
+         (cut string-append "/dev/" <>)))
+
+(define-syntax %network-byte-order
+  (identifier-syntax (endianness big)))
+
+(define (uuid->string uuid)
+  "Convert UUID, a 16-byte bytevector, to its string representation, something
+like \"6b700d61-5550-48a1-874c-a3d86998990e\"."
+  ;; See <https://tools.ietf.org/html/rfc4122>.
+  (let ((time-low  (bytevector-uint-ref uuid 0 %network-byte-order 4))
+        (time-mid  (bytevector-uint-ref uuid 4 %network-byte-order 2))
+        (time-hi   (bytevector-uint-ref uuid 6 %network-byte-order 2))
+        (clock-seq (bytevector-uint-ref uuid 8 %network-byte-order 2))
+        (node      (bytevector-uint-ref uuid 10 %network-byte-order 6)))
+    (format #f "~8,'0x-~4,'0x-~4,'0x-~4,'0x-~12,'0x"
+            time-low time-mid time-hi clock-seq node)))
+
 (define* (canonicalize-device-spec spec #:optional (title 'any))
   "Return the device name corresponding to SPEC.  TITLE is a symbol, one of
 the following:
@@ -197,6 +236,8 @@ the following:
      \"/dev/sda1\";
   • 'label', in which case SPEC is known to designate a partition label--e.g.,
      \"my-root-part\";
+  • 'uuid', in which case SPEC must be a UUID (a 16-byte bytevector)
+     designating a partition;
   • 'any', in which case SPEC can be anything.
 "
   (define max-trials
@@ -209,30 +250,36 @@ the following:
   (define canonical-title
     ;; The realm of canonicalization.
     (if (eq? title 'any)
-        (if (string-prefix? "/" spec)
+        (if (string? spec)
-            'device
+            (if (string-prefix? "/" spec)
-            'label)
+                'device
+                'label)
+            'uuid)
         title))
 
+  (define (resolve find-partition spec fmt)
+    (let loop ((count 0))
+      (let ((device (find-partition spec)))
+        (or device
+            ;; Some devices take a bit of time to appear, most notably USB
+            ;; storage devices.  Thus, wait for the device to appear.
+            (if (> count max-trials)
+                (error "failed to resolve partition" (fmt spec))
+                (begin
+                  (format #t "waiting for partition '~a' to appear...~%"
+                          (fmt spec))
+                  (sleep 1)
+                  (loop (+ 1 count))))))))
+
   (case canonical-title
     ((device)
      ;; Nothing to do.
      spec)
     ((label)
      ;; Resolve the label.
-     (let loop ((count 0))
+     (resolve find-partition-by-label spec identity))
-       (let ((device (find-partition-by-label spec)))
+    ((uuid)
-         (or device
+     (resolve find-partition-by-uuid spec uuid->string))
-             ;; Some devices take a bit of time to appear, most notably USB
-             ;; storage devices.  Thus, wait for the device to appear.
-             (if (> count max-trials)
-                 (error "failed to resolve partition label" spec)
-                 (begin
-                   (format #t "waiting for partition '~a' to appear...~%"
-                           spec)
-                   (sleep 1)
-                   (loop (+ 1 count))))))))
-    ;; TODO: Add support for UUIDs.
     (else
      (error "unknown device title" title))))
 

gnu/packages/admin.scm

@@ -480,7 +480,8 @@ tools: server, client, and relay agent.")
                 "14wyjywrdi1ikaj6yc9c72m6m2r64z94lb0gm7k1a3q6q5cj3scs"))))
     (build-system gnu-build-system)
     (native-inputs `(("bison" ,bison) ("flex" ,flex)))
-    (arguments '(#:tests? #f))                    ; no 'check' target
+    (arguments '(#:configure-flags '("--with-pcap=linux")
+                 #:tests? #f))                    ; no 'check' target
     (home-page "http://www.tcpdump.org")
     (synopsis "Network packet capture library")
     (description

gnu/packages/algebra.scm

@@ -383,7 +383,7 @@ cosine/ sine transforms or DCT/DST).")
                  (lambda _
                    ;; First build the tests, in parallel.
                    ;; See <http://eigen.tuxfamily.org/index.php?title=Tests>.
-                   (let* ((cores  (current-processor-count))
+                   (let* ((cores  (parallel-job-count))
                           (dash-j (format #f "-j~a" cores)))
                      ;; These variables are supposed to be honored.
                      (setenv "EIGEN_MAKE_ARGS" dash-j)

gnu/packages/boost.scm

@@ -33,7 +33,7 @@
 (define-public boost
   (package
     (name "boost")
-    (version "1.57.0")
+    (version "1.58.0")
     (source (origin
               (method url-fetch)
               (uri (string-append
@@ -42,7 +42,8 @@
                     ".tar.bz2"))
               (sha256
                (base32
-                "0rs94vdmg34bwwj23fllva6mhrml2i7mvmlb11zyrk1k5818q34i"))))
+                "1rfkqxns60171q62cppiyzj8pmsbwp1l8jd7p6crriryqd7j1z7x"))
+              (patches (list (search-patch "boost-mips-avoid-m32.patch")))))
     (build-system gnu-build-system)
     (inputs `(("zlib" ,zlib)))
     (native-inputs

gnu/packages/ccache.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,7 +28,7 @@
 (define-public ccache
   (package
     (name "ccache")
-    (version "3.1.10")
+    (version "3.2.2")
     (source
      (origin
       (method url-fetch)
@@ -36,16 +36,18 @@
                           version ".tar.xz"))
       (sha256
        (base32
-        "0mr8n1nbykxw4rs55ad8wd6xmfhihn09mxpxb91sn9mlsd1ryhw8"))))
+        "1jm0qb3h5sypllaiyj81zp6m009vm50hzjnx994ril94kxlrj3ag"))))
     (build-system gnu-build-system)
     (native-inputs `(("perl" ,perl)))   ;for test.sh
     (inputs `(("zlib" ,zlib)))
     (arguments
      '(#:phases (alist-cons-before
-                 'check 'patch-test-shebangs
+                 'check 'setup-tests
                  (lambda _
                    (substitute* '("test/test_hashutil.c" "test.sh")
-                     (("#!/bin/sh") (string-append "#!" (which "sh")))))
+                     (("#!/bin/sh") (string-append "#!" (which "sh"))))
+                   (setenv "SHELL" (which "sh"))
+                   #t)
                  %standard-phases)))
     (home-page "https://ccache.samba.org/")
     (synopsis "Compiler cache")

gnu/packages/dunst.scm

@@ -0,0 +1,72 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages dunst)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu)
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages freedesktop)
+  #:use-module (gnu packages glib)
+  #:use-module (gnu packages gtk)
+  #:use-module (gnu packages perl)
+  #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages xorg))
+
+(define-public dunst
+  (package
+    (name "dunst")
+    (version "1.1.0")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "http://knopwob.org/public/dunst-release/dunst-"
+                    version ".tar.bz2"))
+              (sha256
+               (base32
+                "0w3hilzwanwsp4q6dxbdj6l0mvpg4fq02wf8isll8kmbx9kz2ay7"))))
+    (build-system gnu-build-system)
+    (arguments
+     '(#:tests? #f                      ; no check target
+       #:make-flags (list "CC=gcc"
+                          (string-append "PREFIX=" %output))
+       #:phases (modify-phases %standard-phases
+                  (delete 'configure))))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)
+       ("perl" ,perl)                   ; for pod2man
+       ("which" ,which)))
+    (inputs
+     `(("dbus" ,dbus)
+       ("glib" ,glib)
+       ("cairo" ,cairo)
+       ("pango" ,pango)
+       ("libx11" ,libx11)
+       ("libxext" ,libxext)
+       ("libxft" ,libxft)
+       ("libxscrnsaver" ,libxscrnsaver)
+       ("libxinerama" ,libxinerama)
+       ("libxdg-basedir" ,libxdg-basedir)))
+    (home-page "http://knopwob.org/dunst")
+    (synopsis "Customizable and lightweight notification daemon")
+    (description
+     "Dunst is a highly configurable and minimalistic notification daemon.
+It provides 'org.freedesktop.Notifications' D-Bus service, so it is
+started automatically on the first call via D-Bus.")
+    (license license:bsd-3)))

gnu/packages/freedesktop.scm

@@ -91,6 +91,39 @@ freedesktop.org project.")
 other applications that need to directly deal with input devices.")
     (license license:x11)))
 
+(define-public libxdg-basedir
+  (package
+    (name "libxdg-basedir")
+    (version "1.2.0")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "https://github.com/devnev/libxdg-basedir/archive/"
+                    name "-" version ".tar.gz"))
+              (sha256
+               (base32
+                "0s28c7sfwqimsmb3kn91mx7wi55fs3flhbmynl9k60rrllr00aqw"))))
+    (build-system gnu-build-system)
+    (arguments
+     '(#:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'autogen
+           (lambda _
+             ;; Run 'configure' in its own phase, not now.
+             (substitute* "autogen.sh"
+               (("^.*\\./configure.*") ""))
+             (zero? (system* "sh" "autogen.sh")))))))
+    (native-inputs
+     `(("autoconf" ,autoconf)
+       ("automake" ,automake)
+       ("libtool" ,libtool)))
+    (home-page "https://github.com/devnev/libxdg-basedir")
+    (synopsis "Implementation of the XDG Base Directory specification")
+    (description
+     "libxdg-basedir is a C library providing some functions to use with
+the freedesktop.org XDG Base Directory specification.")
+    (license license:expat)))
+
 (define-public elogind
   (let ((commit "14405a9"))
     (package

gnu/packages/gcc.scm

@@ -27,6 +27,10 @@
   #:use-module (gnu packages compression)
   #:use-module (gnu packages multiprecision)
   #:use-module (gnu packages texinfo)
+  #:use-module (gnu packages doxygen)
+  #:use-module (gnu packages xml)
+  #:use-module (gnu packages docbook)
+  #:use-module (gnu packages graphviz)
   #:use-module (gnu packages elf)
   #:use-module (gnu packages perl)
   #:use-module (guix packages)
@@ -544,6 +548,65 @@ using compilers other than GCC."
 (define-public gcc-objc++-4.8
   (custom-gcc gcc-4.8 "gcc-objc++" '("obj-c++")))
 
+(define (make-libstdc++-doc gcc)
+  "Return a package with the libstdc++ documentation for GCC."
+  (package
+    (inherit gcc)
+    (name "libstdc++-doc")
+    (version (package-version gcc))
+    (synopsis "GNU libstdc++ documentation")
+    (outputs '("out"))
+    (native-inputs `(("doxygen" ,doxygen)
+                     ("texinfo" ,texinfo)
+                     ("libxml2" ,libxml2)
+                     ("libxslt" ,libxslt)
+                     ("docbook-xml" ,docbook-xml)
+                     ("docbook-xsl" ,docbook-xsl)
+                     ("graphviz" ,graphviz))) ;for 'dot', invoked by 'doxygen'
+    (inputs '())
+    (propagated-inputs '())
+    (arguments
+     '(#:out-of-source? #t
+       #:tests? #f                                ;it's just documentation
+       #:phases (modify-phases %standard-phases
+                  (add-before 'configure 'chdir
+                              (lambda _
+                                (chdir "libstdc++-v3")))
+                  (add-before 'configure 'set-xsl-directory
+                              (lambda* (#:key inputs #:allow-other-keys)
+                                (let ((docbook (assoc-ref inputs "docbook-xsl")))
+                                  (substitute* (find-files "doc"
+                                                           "^Makefile\\.in$")
+                                    (("@XSL_STYLE_DIR@")
+                                     (string-append
+                                      docbook "/xml/xsl/"
+                                      (string-drop
+                                       docbook
+                                       (+ 34
+                                          (string-length
+                                           (%store-directory))))))))))
+                  (replace 'build
+                           (lambda _
+                             ;; XXX: There's also a 'doc-info' target, but it
+                             ;; relies on docbook2X, which itself relies on
+                             ;; DocBook 4.1.2, which is not really usable
+                             ;; (lacks a catalog.xml.)
+                             (zero? (system* "make"
+                                             "doc-html"
+                                             "doc-man"))))
+                  (replace 'install
+                           (lambda* (#:key outputs #:allow-other-keys)
+                             (let ((out (assoc-ref outputs "out")))
+                               (zero? (system* "make"
+                                               "doc-install-html"
+                                               "doc-install-man"))))))))))
+
+(define-public libstdc++-doc-4.9
+  (make-libstdc++-doc gcc-4.9))
+
+(define-public libstdc++-doc-5.1
+  (make-libstdc++-doc gcc-5.1))
+
 (define-public isl
   (package
     (name "isl")

gnu/packages/gnome.scm

@@ -2090,11 +2090,12 @@ floating in an ocean using only your brain and a little bit of luck.")
        ("desktop-file-utils" ,desktop-file-utils)
        ("intltool" ,intltool)
        ("itstool" ,itstool)))
+    (propagated-inputs
+     `(("dconf" ,dconf)))
     (inputs
      `(("gtk+" ,gtk+)
        ("vte" ,vte)
        ("gnutls" ,gnutls)
-       ("dconf" ,dconf)
        ("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
        ("util-linux" ,util-linux)
        ("vala" ,vala)))
@@ -2914,3 +2915,89 @@ which can read a large number of file formats.")
     ;; to be used and distributed together with GStreamer and Totem.  See
     ;; file://COPYING in the source distribution for details.
     (license license:gpl2+)))
+
+(define-public rhythmbox
+ (package
+   (name "rhythmbox")
+   (version "3.2.1")
+   (source (origin
+            (method url-fetch)
+            (uri (string-append "mirror://gnome/sources/" name "/"
+                                (version-major+minor version) "/"
+                                name "-" version ".tar.xz"))
+            (sha256
+             (base32
+              "0f3radhlji7rxl760yl2vm49fvfslympxrpm8497acbmbd7wlhxz"))))
+   (build-system glib-or-gtk-build-system)
+   (arguments
+    `(#:configure-flags
+      (list "--enable-lirc"
+            "--enable-python"
+            "--enable-vala"
+            "--with-brasero"
+            "--with-gudev"
+            "--with-libsecret")
+      #:phases
+      (modify-phases %standard-phases
+        (add-after
+         'install 'wrap-rhythmbox
+         (lambda* (#:key inputs outputs #:allow-other-keys)
+           (let ((out               (assoc-ref outputs "out"))
+                 (gi-typelib-path   (getenv "GI_TYPELIB_PATH"))
+                 (gst-plugin-path   (getenv "GST_PLUGIN_SYSTEM_PATH"))
+                 (grl-plugin-path   (getenv "GRL_PLUGIN_PATH")))
+             (wrap-program (string-append out "/bin/rhythmbox")
+               `("GI_TYPELIB_PATH"        ":" prefix (,gi-typelib-path))
+               `("GST_PLUGIN_SYSTEM_PATH" ":" prefix (,gst-plugin-path))
+               `("GRL_PLUGIN_PATH"        ":" prefix (,grl-plugin-path))))
+           #t)))))
+   (propagated-inputs
+    `(("dconf" ,dconf)))
+   (native-inputs
+    `(("intltool" ,intltool)
+      ("glib" ,glib "bin")
+      ("gobject-introspection" ,gobject-introspection)
+      ("desktop-file-utils" ,desktop-file-utils)
+      ("pkg-config" ,pkg-config)))
+   (inputs
+    `(("json-glib" ,json-glib)
+      ("tdb" ,tdb)
+      ("gnome-desktop" ,gnome-desktop)
+      ("python" ,python)
+      ("python-pygobject" ,python2-pygobject)
+      ("vala" ,vala)
+      ("gmime" ,gmime)
+      ("nettle" ,nettle)
+      ("itstool" ,itstool)
+      ("adwaita-icon-theme" ,adwaita-icon-theme)
+      ("grilo" ,grilo)
+      ("grilo-plugins" ,grilo-plugins)
+      ("gstreamer" ,gstreamer)
+      ("gst-plugins-base" ,gst-plugins-base)
+      ("gst-plugins-good" ,gst-plugins-good)
+      ("eudev" ,eudev)
+      ("totem-pl-parser" ,totem-pl-parser)
+      ;;("libmtp" ,libmtp) FIXME: Not detected
+      ("libsecret" ,libsecret)
+      ("libsoup" ,libsoup)
+      ("libnotify" ,libnotify)
+      ("libpeas" ,libpeas)
+      ("lirc" ,lirc)
+      ;; TODO: clutter* only used by visualizer plugin, which also requires mx
+      ;;("clutter" ,clutter)
+      ;;("clutter-gtk" ,clutter-gtk)
+      ;;("clutter-gst" ,clutter-gst)
+      ("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
+      ("atk" ,atk)
+      ("pango" ,pango)
+      ("gtk+" ,gtk+)
+      ;; TODO:
+      ;;  * libgpod
+      ;;  * mx
+      ;;  * webkit
+      ("brasero" ,brasero)))
+   (home-page "https://wiki.gnome.org/Apps/Rhythmbox")
+   (synopsis "Music player for GNOME")
+   (description "Rhythmbox is a music playing application for GNOME.  It
+supports playlists, song ratings, and any codecs installed through gstreamer.")
+   (license license:gpl2+)))

gnu/packages/linux.scm

@@ -210,7 +210,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM."
      #f)))
 
 (define-public linux-libre
-  (let* ((version "4.1.1")
+  (let* ((version "4.1.2")
          (build-phase
           '(lambda* (#:key system inputs #:allow-other-keys #:rest args)
              ;; Apply the neat patch.
@@ -283,7 +283,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM."
              (uri (linux-libre-urls version))
              (sha256
               (base32
-               "12fdrawzjqhlmjvw79iy9419pf7m3k29xcjri57i4ynaf3yfzkk0"))))
+               "0clgjpcw1xzqa7jpm6k5fafg3wnc28mzyar3xgr4vbm6zb61fl7k"))))
     (build-system gnu-build-system)
     (native-inputs `(("perl" ,perl)
                      ("bc" ,bc)

gnu/packages/music.scm

@@ -424,7 +424,14 @@ Editor.  It is compatible with Power Tab Editor 1.7 and Guitar Pro.")
        (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
              (string-append "FONTFILE="
                             (assoc-ref %build-inputs "font-bitstream-vera")
-                            "/share/fonts/truetype/VeraBd.ttf"))
+                            "/share/fonts/truetype/VeraBd.ttf")
+             ;; Disable unsupported optimization flags on non-x86
+             ,@(let ((system (or (%current-target-system)
+                                 (%current-system))))
+                 (if (or (string-prefix? "x86_64" system)
+                         (string-prefix? "i686" system))
+                     '()
+                     '("OPTIMIZATIONS=-ffast-math -fomit-frame-pointer -O3"))))
        #:phases
        (modify-phases %standard-phases
          (add-before 'build 'set-CC-variable

gnu/packages/ntp.scm

@@ -24,6 +24,7 @@
   #:use-module (gnu packages linux)
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages tls)
+  #:use-module (gnu packages libevent)
   #:use-module ((guix licenses) #:prefix l:)
   #:use-module (guix packages)
   #:use-module (guix utils)
@@ -34,7 +35,7 @@
 (define-public ntp
   (package
    (name "ntp")
-   (version "4.2.8p2")
+   (version "4.2.8p3")
    (source (origin
 	    (method url-fetch)
 	    (uri (string-append 
@@ -43,17 +44,39 @@
                   "/ntp-" version ".tar.gz"))
 	    (sha256
 	     (base32
-	      "0ccv9kh5asxpk7bjn73vwrqimbkbfl743bgx0km47bfajl7bqs8d"))))
+	      "13zkzcvjm5kbxl4xbcmaq07slplhmpkgahzcqnqlba3cxpra9341"))
+            (modules '((guix build utils)))
+            (snippet
+             '(begin
+                ;; Remove the bundled copy of libevent, but we must keep
+                ;; sntp/libevent/build-aux since configure.ac contains
+                ;; AC_CONFIG_AUX_DIR([sntp/libevent/build-aux])
+                (rename-file "sntp/libevent/build-aux"
+                             "sntp/libevent:build-aux")
+                (delete-file-recursively "sntp/libevent")
+                (mkdir "sntp/libevent")
+                (rename-file "sntp/libevent:build-aux"
+                             "sntp/libevent/build-aux")
+                #t))))
    (native-inputs `(("which" ,which)
                     ("pkg-config" ,pkg-config)))
    (inputs
     `(("openssl" ,openssl)
+      ("libevent" ,libevent)
       ;; Build with POSIX capabilities support on GNU/Linux.  This allows 'ntpd'
       ;; to run as non-root (when invoked with '-u'.)
       ,@(if (string-suffix? "-linux"
                             (or (%current-target-system) (%current-system)))
             `(("libcap" ,libcap))
             '())))
+   (arguments
+    `(#:phases
+      (modify-phases %standard-phases
+        (add-after 'unpack 'disable-network-test
+                   (lambda _
+                     (substitute* "tests/libntp/Makefile.in"
+                       (("test-decodenetnum\\$\\(EXEEXT\\) ") ""))
+                     #t)))))
    (build-system gnu-build-system)
    (synopsis "Real time clock synchonization system")
    (description "NTP is a system designed to synchronize the clocks of

gnu/packages/patches/boost-mips-avoid-m32.patch

@@ -0,0 +1,15 @@
+The following patch prevents the use of the -m32 flag on mips, where it
+is not understood by gcc, as well as other non-x86 architectures.
+
+diff -u -r boost_1_58_0.orig/tools/build/src/tools/gcc.jam boost_1_58_0/tools/build/src/tools/gcc.jam
+--- boost_1_58_0.orig/tools/build/src/tools/gcc.jam	2015-04-04 19:25:07.000000000 +0200
++++ boost_1_58_0/tools/build/src/tools/gcc.jam	2015-07-10 01:08:19.822733823 +0200
+@@ -451,7 +451,7 @@
+         else
+         {
+             local arch = [ feature.get-values architecture : $(properties) ] ;
+-            if $(arch) != arm
++            if $(arch) = x86
+             {
+                 if $(model) = 32
+                 {

gnu/packages/polkit.scm

@@ -35,7 +35,7 @@
 (define-public polkit
   (package
     (name "polkit")
-    (version "0.112")
+    (version "0.113")
     (source (origin
              (method url-fetch)
              (uri (string-append
@@ -43,7 +43,7 @@
                    name "-" version ".tar.gz"))
              (sha256
               (base32
-               "1xkary7yirdcjdva950nqyhmsz48qhrdsr78zciahj27p8yg95fn"))
+               "109w86kfqrgz83g9ivggplmgc77rz8kx8646izvm2jb57h4rbh71"))
              (patches (list (search-patch "polkit-drop-test.patch")))))
     (build-system gnu-build-system)
     (inputs

gnu/packages/pumpio.scm

@@ -30,15 +30,15 @@
 (define-public pumpa
   (package
     (name "pumpa")
-    (version "0.9")
+    (version "0.9.1")
     (source (origin
               (method git-fetch) ; no source tarballs
               (uri (git-reference
-                    (url "https://gitorious.org/pumpa/pumpa.git")
+                    (url "git://pumpa.branchable.com/")
                     (commit (string-append "v" version))))
               (sha256
                (base32
-                "0v55xq17wnc9mvpmrm5r3rjrsg9npnjv1lznbz8ppk77ba8pwimy"))))
+                "14s0m46yqph8bs5rjpmiq42f020j9l3mygan2zj93z6qzypwd07f"))))
     (build-system gnu-build-system)
     (arguments
      '(#:phases (alist-replace

gnu/packages/rc.scm

@@ -0,0 +1,72 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Jeff Mickey <j@codemac.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages rc)
+  #:use-module (gnu packages autotools)
+  #:use-module (gnu packages perl)
+  #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages readline)
+  #:use-module (guix build-system gnu)
+  #:use-module (guix git-download)
+  #:use-module (guix licenses)
+  #:use-module (guix packages))
+
+(define-public rc
+  (package
+    (name "rc")
+    (version "1.7.4")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "git://github.com/rakitzis/rc.git")
+                    ;; commit name 'release: rc-1.7.4'
+                    (commit "c884da53a7c885d46ace2b92de78946855b18e92")))
+              (sha256
+               (base32
+                "00mgzvrrh9w96xa85g4gjbsvq02f08k4jwjcdnxq7kyh5xgiw95l"))
+              (file-name (string-append name "-" version "-checkout"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:configure-flags
+       '("--with-edit=gnu")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after
+          'unpack 'autoreconf
+          (lambda _ (zero? (system* "autoreconf" "-vfi"))))
+         (add-before
+          'autoreconf 'patch-trip.rc
+          (lambda _
+            (substitute* "trip.rc"
+              (("/bin/pwd") (which "pwd"))
+              (("/bin/sh")  (which "sh"))
+              (("/bin/rm")  (which "rm"))
+              (("/bin\\)")  (string-append (dirname (which "rm")) ")")))
+            #t)))))
+    (inputs `(("readline" ,readline)
+              ("perl" ,perl)))
+    (native-inputs `(("autoconf" ,autoconf)
+                     ("automake" ,automake)
+                     ("libtool" ,libtool)
+                     ("pkg-config" ,pkg-config)))
+    (synopsis "Alternative implementation of the rc shell by Byron Rakitzis")
+    (description
+     "This is a reimplementation by Byron Rakitzis of the Plan 9 shell.  It
+has a small feature set similar to a traditional Bourne shell.")
+    (home-page "http://github.com/rakitzis/rc")
+    (license zlib)))

gnu/packages/skarnet.scm

@@ -0,0 +1,92 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Claes Wallin <claes.wallin@greatsinodevelopment.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages skarnet)
+  #:use-module (gnu packages)
+  #:use-module (guix licenses)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system gnu))
+
+(define-public skalibs
+  (package
+    (name "skalibs")
+    (version "2.3.5.1")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "http://skarnet.org/software/skalibs/skalibs-"
+                          version ".tar.gz"))
+      (sha256
+       (base32
+        "1m31wph4qr4mqgv51nzwd9nw0x5vmpkcxr48i216wn3dpy3mvxwy"))))
+    (build-system gnu-build-system)
+    (arguments
+     '(#:configure-flags '("--enable-force-devr") ; do not analyze /dev/random
+       #:tests? #f)) ; no tests exist
+    (home-page "http://skarnet.org/software/skalibs/")
+    (synopsis "Platform abstraction libraries for skarnet.org software")
+    (description
+     "This package provides lightweight C libraries isolating the developer
+from portability issues, providing a unified systems API on all platforms,
+including primitive data types, cryptography, and POSIX concepts like sockets
+and file system operations.  It is used by all skarnet.org software.")
+    (license isc)))
+
+(define-public execline
+  (package
+    (name "execline")
+    (version "2.1.2.2")
+    (source
+     (origin
+      (method url-fetch)
+      (uri (string-append "http://skarnet.org/software/execline/execline-"
+                          version ".tar.gz"))
+      (sha256
+       (base32
+        "01pckac5zijf6icrhwicbmq92yq68gfkf1yl03rr2v4q3cn8r85f"))))
+    (build-system gnu-build-system)
+    (inputs `(("skalibs" ,skalibs)))
+    (arguments
+     '(#:configure-flags (list
+                          (string-append "--with-lib="
+                                         (assoc-ref %build-inputs "skalibs")
+                                         "/lib/skalibs")
+                          (string-append "--with-sysdeps="
+                                         (assoc-ref %build-inputs "skalibs")
+                                         "/lib/skalibs/sysdeps"))
+       #:phases (modify-phases %standard-phases
+                  (add-after
+                   'install 'post-install
+                   (lambda* (#:key inputs outputs #:allow-other-keys)
+                    (let* ((out (assoc-ref outputs "out"))
+                           (bin (string-append out "/bin")))
+                      (wrap-program (string-append bin "/execlineb")
+                        `("PATH" ":" prefix (,bin)))))))
+       #:tests? #f)) ; No tests exist.
+    (home-page "http://skarnet.org/software/execline/")
+    (license isc)
+    (synopsis "Non-interactive shell-like language with minimal overhead")
+    (description
+     "Execline is a (non-interactive) scripting language, separated into a
+parser (execlineb) and a set of commands meant to execute one another in a
+chain-execution fashion, storing the whole script in the argument array.
+It features conditional loops, getopt-style option handling, file name
+globbing, redirection and other shell concepts, expressed as discrete commands
+rather than in special syntax, minimizing runtime footprint and
+complexity.")))

gnu/packages/ssh.scm

@@ -122,16 +122,18 @@ a server that supports the SSH-2 protocol.")
 (define-public openssh
   (package
    (name "openssh")
-   (version "6.8p1")
+   (version "6.9p1")
    (source (origin
             (method url-fetch)
             (uri (let ((tail (string-append name "-" version ".tar.gz")))
-                   (list (string-append "ftp://ftp.fr.openbsd.org/pub/OpenBSD/OpenSSH/portable/"
+                   (list (string-append "http://openbsd.cs.fau.de/pub/OpenBSD/OpenSSH/portable/"
                                         tail)
-                         (string-append "ftp://ftp2.fr.openbsd.org/pub/OpenBSD/OpenSSH/portable/"
+                         (string-append "http://ftp.fr.openbsd.org/pub/OpenBSD/OpenSSH/portable/"
+                                        tail)
+                         (string-append "http://ftp2.fr.openbsd.org/pub/OpenBSD/OpenSSH/portable/"
                                         tail))))
             (sha256 (base32
-                     "03hnrqvjq6ghg1mp3gkarfxh6g3x1n1vjrzpbc5lh9717vklrxiz"))))
+                     "1zkci5nbpb4frmzj2vr3kv9j47x2h72kvybcpr0d8mzk73sls1vf"))))
    (build-system gnu-build-system)
    (inputs `(("groff" ,groff)
              ("openssl" ,openssl)

gnu/system/file-systems.scm

@@ -18,9 +18,13 @@
 
 (define-module (gnu system file-systems)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
   #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix store)
+  #:use-module (rnrs bytevectors)
+  #:use-module ((gnu build file-systems) #:select (uuid->string))
+  #:re-export (uuid->string)
   #:export (<file-system>
             file-system
             file-system?
@@ -35,6 +39,8 @@
             file-system-create-mount-point?
 
             file-system->spec
+            string->uuid
+            uuid
 
             %fuse-control-file-system
             %binary-format-file-system
@@ -106,6 +112,57 @@ initrd code."
     (($ <file-system> device title mount-point type flags options _ check?)
      (list device title mount-point type flags options check?))))
 
+(define %uuid-rx
+  ;; The regexp of a UUID.
+  (make-regexp "^([[:xdigit:]]{8})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{12})$"))
+
+(define (string->uuid str)
+  "Parse STR as a DCE UUID (see <https://tools.ietf.org/html/rfc4122>) and
+return its contents as a 16-byte bytevector.  Return #f if STR is not a valid
+UUID representation."
+  (and=> (regexp-exec %uuid-rx str)
+         (lambda (match)
+           (letrec-syntax ((hex->number
+                            (syntax-rules ()
+                              ((_ index)
+                               (string->number (match:substring match index)
+                                               16))))
+                           (put!
+                            (syntax-rules ()
+                              ((_ bv index (number len) rest ...)
+                               (begin
+                                 (bytevector-uint-set! bv index number
+                                                       (endianness big) len)
+                                 (put! bv (+ index len) rest ...)))
+                              ((_ bv index)
+                               bv))))
+             (let ((time-low  (hex->number 1))
+                   (time-mid  (hex->number 2))
+                   (time-hi   (hex->number 3))
+                   (clock-seq (hex->number 4))
+                   (node      (hex->number 5))
+                   (uuid      (make-bytevector 16)))
+               (put! uuid 0
+                     (time-low 4) (time-mid 2) (time-hi 2)
+                     (clock-seq 2) (node 6)))))))
+
+(define-syntax uuid
+  (lambda (s)
+    "Return the bytevector corresponding to the given UUID representation."
+    (syntax-case s ()
+      ((_ str)
+       (string? (syntax->datum #'str))
+       ;; A literal string: do the conversion at expansion time.
+       (with-syntax ((bv (string->uuid (syntax->datum #'str))))
+         #''bv))
+      ((_ str)
+       #'(string->uuid str)))))
+
+
+;;;
+;;; Common file systems.
+;;;
+
 (define %fuse-control-file-system
   ;; Control file system for Linux' file systems in user-space (FUSE).
   (file-system
@@ -208,7 +265,7 @@ initrd code."
 ;; https://github.com/docker/libcontainer/blob/master/SPEC.md#filesystem
 (define %container-file-systems
   (list
-   ;; Psuedo-terminal file system.
+   ;; Pseudo-terminal file system.
    (file-system
      (device "none")
      (mount-point "/dev/pts")

gnu/system/install.scm

@@ -342,7 +342,7 @@ Use Alt-F2 for documentation.
                      parted ddrescue
                      grub                  ;mostly so xrefs to its manual work
                      cryptsetup
-                     wireless-tools iw wpa-supplicant-light
+                     wireless-tools iw wpa-supplicant-light iproute
                      ;; XXX: We used to have GNU fdisk here, but as of version
                      ;; 2.0.0a, that pulls Guile 1.8, which takes unreasonable
                      ;; space; furthermore util-linux's fdisk is already

guix/scripts/build.scm

@@ -117,6 +117,9 @@ options handled by 'set-build-options-from-command-line', and listed in
       --fallback         fall back to building when the substituter fails"))
   (display (_ "
       --no-substitutes   build instead of resorting to pre-built substitutes"))
+  (display (_ "
+      --substitute-urls=URLS
+                         fetch substitute from URLS if they are authorized"))
   (display (_ "
       --no-build-hook    do not attempt to offload builds via the build hook"))
   (display (_ "
@@ -141,6 +144,8 @@ options handled by 'set-build-options-from-command-line', and listed in
                      #:max-build-jobs (or (assoc-ref opts 'max-jobs) 1)
                      #:fallback? (assoc-ref opts 'fallback?)
                      #:use-substitutes? (assoc-ref opts 'substitutes?)
+                     #:substitute-urls (or (assoc-ref opts 'substitute-urls)
+                                           %default-substitute-urls)
                      #:use-build-hook? (assoc-ref opts 'build-hook?)
                      #:max-silent-time (assoc-ref opts 'max-silent-time)
                      #:timeout (assoc-ref opts 'timeout)
@@ -177,6 +182,13 @@ options handled by 'set-build-options-from-command-line', and listed in
                          (alist-cons 'substitutes? #f
                                      (alist-delete 'substitutes? result))
                          rest)))
+        (option '("substitute-urls") #t #f
+                (lambda (opt name arg result . rest)
+                  (apply values
+                         (alist-cons 'substitute-urls
+                                     (string-tokenize arg)
+                                     (alist-delete 'substitute-urls result))
+                         rest)))
         (option '("no-build-hook") #f #f
                 (lambda (opt name arg result . rest)
                   (apply values

guix/scripts/lint.scm

@@ -34,8 +34,6 @@
   #:use-module (ice-9 regex)
   #:use-module (ice-9 format)
   #:use-module (web uri)
-  #:use-module (srfi srfi-34)
-  #:use-module (srfi srfi-35)
   #:use-module ((guix build download)
                 #:select (maybe-expand-mirrors
                           open-connection-for-uri))

guix/scripts/substitute.scm

@@ -25,6 +25,7 @@
   #:use-module (guix records)
   #:use-module (guix serialization)
   #:use-module (guix hash)
+  #:use-module (guix base32)
   #:use-module (guix base64)
   #:use-module (guix pk-crypto)
   #:use-module (guix pki)
@@ -184,37 +185,29 @@ to the caller without emitting an error message."
                  (setvbuf port _IONBF)))
              (http-fetch uri #:text? #f #:port port))))))))
 
-(define-record-type <cache>
+(define-record-type <cache-info>
-  (%make-cache url store-directory wants-mass-query?)
+  (%make-cache-info url store-directory wants-mass-query?)
-  cache?
+  cache-info?
-  (url               cache-url)
+  (url               cache-info-url)
-  (store-directory   cache-store-directory)
+  (store-directory   cache-info-store-directory)
-  (wants-mass-query? cache-wants-mass-query?))
+  (wants-mass-query? cache-info-wants-mass-query?))
 
-(define (open-cache url)
+(define (download-cache-info url)
-  "Open the binary cache at URL.  Return a <cache> object on success, or #f on
+  "Download the information for the cache at URL.  Return a <cache-info>
-failure."
+object on success, or #f on failure."
-  (define (download-cache-info url)
+  (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)))
            fields->alist))
 
-  (and=> (download-cache-info (string-append url "/nix-cache-info"))
+  (and=> (download (string-append url "/nix-cache-info"))
          (lambda (properties)
            (alist->record properties
-                          (cut %make-cache url <...>)
+                          (cut %make-cache-info url <...>)
                           '("StoreDir" "WantMassQuery")))))
 
-(define-syntax-rule (open-cache* url)
+
-  "Delayed variant of 'open-cache' that also lets the user know that they're
-gonna have to wait."
-  (delay (begin
-           (format (current-error-port)
-                   (_ "updating list of substitutes from '~a'...\r")
-                   url)
-           (open-cache url))))
-
 (define-record-type <narinfo>
   (%make-narinfo path uri uri-base compression file-hash file-size nar-hash nar-size
                  references deriver system signature contents)
@@ -379,20 +372,23 @@ the cache STR originates form."
           (make-time time-monotonic 0 date)))
 
 
-(define (narinfo-cache-file path)
+(define (narinfo-cache-file cache-url path)
-  "Return the name of the local file that contains an entry for PATH."
+  "Return the name of the local file that contains an entry for PATH.  The
+entry is stored in a sub-directory specific to CACHE-URL."
   (string-append %narinfo-cache-directory "/"
-                 (store-path-hash-part path)))
+                 (bytevector->base32-string (sha256 (string->utf8 cache-url)))
+                 "/" (store-path-hash-part path)))
 
-(define (cached-narinfo path)
+(define (cached-narinfo cache-url path)
-  "Check locally if we have valid info about PATH.  Return two values: a
+  "Check locally if we have valid info about PATH coming from CACHE-URL.
-Boolean indicating whether we have valid cached info, and that info, which may
+Return two values: a Boolean indicating whether we have valid cached info, and
-be either #f (when PATH is unavailable) or the narinfo for PATH."
+that info, which may be either #f (when PATH is unavailable) or the narinfo
+for PATH."
   (define now
     (current-time time-monotonic))
 
   (define cache-file
-    (narinfo-cache-file path))
+    (narinfo-cache-file cache-url path))
 
   (catch 'system-error
     (lambda ()
@@ -418,9 +414,9 @@ be either #f (when PATH is unavailable) or the narinfo for PATH."
     (lambda _
       (values #f #f))))
 
-(define (cache-narinfo! cache path narinfo)
+(define (cache-narinfo! cache-url path narinfo)
-  "Cache locally NARNIFO for PATH, which originates from CACHE.  NARINFO may
+  "Cache locally NARNIFO for PATH, which originates from CACHE-URL.  NARINFO
-be #f, in which case it indicates that PATH is unavailable at CACHE."
+may be #f, in which case it indicates that PATH is unavailable at CACHE-URL."
   (define now
     (current-time time-monotonic))
 
@@ -430,9 +426,12 @@ be #f, in which case it indicates that PATH is unavailable at CACHE."
               (date ,(time-second now))
               (value ,(and=> narinfo narinfo->string))))
 
-  (with-atomic-file-output (narinfo-cache-file path)
+  (let ((file (narinfo-cache-file cache-url path)))
-    (lambda (out)
+    (mkdir-p (dirname file))
-      (write (cache-entry (cache-url cache) narinfo) out)))
+    (with-atomic-file-output file
+      (lambda (out)
+        (write (cache-entry cache-url narinfo) out))))
+
   narinfo)
 
 (define (narinfo-request cache-url path)
@@ -491,11 +490,8 @@ if file doesn't exist, and the narinfo otherwise."
           #f
           (apply throw args)))))
 
-(define (fetch-narinfos cache paths)
+(define (fetch-narinfos url paths)
-  "Retrieve all the narinfos for PATHS from CACHE and return them."
+  "Retrieve all the narinfos for PATHS from the cache at URL and return them."
-  (define url
-    (cache-url cache))
-
   (define update-progress!
     (let ((done 0))
       (lambda ()
@@ -513,7 +509,7 @@ if file doesn't exist, and the narinfo otherwise."
       (case (response-code response)
         ((200)                                     ; hit
          (let ((narinfo (read-narinfo port url #:size len)))
-           (cache-narinfo! cache (narinfo-path narinfo) narinfo)
+           (cache-narinfo! url (narinfo-path narinfo) narinfo)
            (update-progress!)
            narinfo))
         ((404)                                     ; failure
@@ -522,7 +518,7 @@ if file doesn't exist, and the narinfo otherwise."
            (if len
                (get-bytevector-n port len)
                (read-to-eof port))
-           (cache-narinfo! cache
+           (cache-narinfo! url
                            (find (cut string-contains <> hash-part) paths)
                            #f)
            (update-progress!))
@@ -533,7 +529,12 @@ if file doesn't exist, and the narinfo otherwise."
              (read-to-eof port))
          #f))))
 
-  (and (string=? (cache-store-directory cache) (%store-prefix))
+  (define cache-info
+    (download-cache-info url))
+
+  (and cache-info
+       (string=? (cache-info-store-directory cache-info)
+                 (%store-prefix))
        (let ((uri (string->uri url)))
          (case (and=> uri uri-scheme)
            ((http)
@@ -559,7 +560,7 @@ information is available locally."
   (let-values (((cached missing)
                 (fold2 (lambda (path cached missing)
                          (let-values (((valid? value)
-                                       (cached-narinfo path)))
+                                       (cached-narinfo cache path)))
                            (if valid?
                                (values (cons value cached) missing)
                                (values cached (cons path missing)))))
@@ -568,11 +569,8 @@ information is available locally."
                        paths)))
     (if (null? missing)
         cached
-        (let* ((cache   (force cache))
+        (let ((missing (fetch-narinfos cache missing)))
-               (missing (if cache
+          (append cached (or missing '()))))))
-                            (fetch-narinfos cache missing)
-                            '())))
-          (append cached missing)))))
 
 (define (lookup-narinfo cache path)
   "Return the narinfo for PATH in CACHE, or #f when no substitute for PATH was
@@ -580,8 +578,8 @@ found."
   (match (lookup-narinfos cache (list path))
     ((answer) answer)))
 
-(define (remove-expired-cached-narinfos)
+(define (remove-expired-cached-narinfos directory)
-  "Remove expired narinfo entries from the cache.  The sole purpose of this
+  "Remove expired narinfo entries from DIRECTORY.  The sole purpose of this
 function is to make sure `%narinfo-cache-directory' doesn't grow
 indefinitely."
   (define now
@@ -605,16 +603,25 @@ indefinitely."
         #t)))
 
   (for-each (lambda (file)
-              (let ((file (string-append %narinfo-cache-directory
+              (let ((file (string-append directory "/" file)))
-                                         "/" 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
+            (scandir directory
                      (lambda (file)
                        (= (string-length file) 32)))))
 
+(define (narinfo-cache-directories)
+  "Return the list of narinfo cache directories (one per cache URL.)"
+  (map (cut string-append %narinfo-cache-directory "/" <>)
+       (scandir %narinfo-cache-directory
+                (lambda (item)
+                  (and (not (member item '("." "..")))
+                       (file-is-directory?
+                        (string-append %narinfo-cache-directory
+                                       "/" item)))))))
+
 (define (maybe-remove-expired-cached-narinfo)
   "Remove expired narinfo entries from the cache if deemed necessary."
   (define now
@@ -628,8 +635,10 @@ indefinitely."
          (call-with-input-file expiry-file read))
         0))
 
-  (when (obsolete? last-expiry-date now %narinfo-expired-cache-entry-removal-delay)
+  (when (obsolete? last-expiry-date now
-    (remove-expired-cached-narinfos)
+                   %narinfo-expired-cache-entry-removal-delay)
+    (for-each remove-expired-cached-narinfos
+              (narinfo-cache-directories))
     (call-with-output-file expiry-file
       (cute write (time-second now) <>))))
 
@@ -688,6 +697,95 @@ Internal tool to substitute a pre-built binary to a local build.\n"))
   (show-bug-report-information))
 
 
+
+;;;
+;;; Daemon/substituter protocol.
+;;;
+
+(define (display-narinfo-data narinfo)
+  "Write to the current output port the contents of NARINFO is the format
+expected by the daemon."
+  (format #t "~a\n~a\n~a\n"
+          (narinfo-path narinfo)
+          (or (and=> (narinfo-deriver narinfo)
+                     (cute string-append (%store-prefix) "/" <>))
+              "")
+          (length (narinfo-references narinfo)))
+  (for-each (cute format #t "~a/~a~%" (%store-prefix) <>)
+            (narinfo-references narinfo))
+  (format #t "~a\n~a\n"
+          (or (narinfo-file-size narinfo) 0)
+          (or (narinfo-size narinfo) 0)))
+
+(define* (process-query command
+                        #:key cache-url acl)
+  "Reply to COMMAND, a query as written by the daemon to this process's
+standard input.  Use ACL as the access-control list against which to check
+authorized substitutes."
+  (define (valid? obj)
+    (and (narinfo? obj) (valid-narinfo? obj acl)))
+
+  (match (string-tokenize command)
+    (("have" paths ..1)
+     ;; Return the subset of PATHS available in CACHE-URL.
+     (let ((substitutable (lookup-narinfos cache-url paths)))
+       (for-each (lambda (narinfo)
+                   (format #t "~a~%" (narinfo-path narinfo)))
+                 (filter valid? substitutable))
+       (newline)))
+    (("info" paths ..1)
+     ;; Reply info about PATHS if it's in CACHE-URL.
+     (let ((substitutable (lookup-narinfos cache-url paths)))
+       (for-each display-narinfo-data (filter valid? substitutable))
+       (newline)))
+    (wtf
+     (error "unknown `--query' command" wtf))))
+
+(define* (process-substitution store-item destination
+                               #:key cache-url acl)
+  "Substitute STORE-ITEM (a store file name) from CACHE-URL, and write it to
+DESTINATION as a nar file.  Verify the substitute against ACL."
+  (let* ((narinfo (lookup-narinfo cache-url store-item))
+         (uri     (narinfo-uri narinfo)))
+    ;; Make sure it is signed and everything.
+    (assert-valid-narinfo narinfo acl)
+
+    ;; Tell the daemon what the expected hash of the Nar itself is.
+    (format #t "~a~%" (narinfo-hash narinfo))
+
+    (format (current-error-port) "downloading `~a'~:[~*~; (~,1f MiB installed)~]...~%"
+            store-item
+
+            ;; Use the Nar size as an estimate of the installed size.
+            (narinfo-size narinfo)
+            (and=> (narinfo-size narinfo)
+                   (cute / <> (expt 2. 20))))
+    (let*-values (((raw download-size)
+                   ;; Note that Hydra currently generates Nars on the fly
+                   ;; and doesn't specify a Content-Length, so
+                   ;; DOWNLOAD-SIZE is #f in practice.
+                   (fetch uri #:buffered? #f #:timeout? #f))
+                  ((progress)
+                   (let* ((comp     (narinfo-compression narinfo))
+                          (dl-size  (or download-size
+                                        (and (equal? comp "none")
+                                             (narinfo-size narinfo))))
+                          (progress (progress-proc (uri-abbreviation uri)
+                                                   dl-size
+                                                   (current-error-port))))
+                     (progress-report-port progress raw)))
+                  ((input pids)
+                   (decompressed-port (and=> (narinfo-compression narinfo)
+                                             string->symbol)
+                                      progress)))
+      ;; Unpack the Nar at INPUT into DESTINATION.
+      (restore-file input destination)
+
+      ;; Skip a line after what 'progress-proc' printed.
+      (newline (current-error-port))
+
+      (every (compose zero? cdr waitpid) pids))))
+
 
 ;;;
 ;;; Entry point.
@@ -737,12 +835,15 @@ substitutes may be unavailable\n")))))
 found."
   (assoc-ref (daemon-options) option))
 
+(define-syntax-rule (or* a b)
+  (let ((first a))
+    (if (or (not first) (string-null? first))
+        b
+        first)))
+
 (define %cache-url
-  (match (and=> ;; TODO: Uncomment the following lines when multiple
+  (match (and=> (or* (find-daemon-option "untrusted-substitute-urls") ;client
-                ;; substitute sources are supported.
+                     (find-daemon-option "substitute-urls"))          ;admin
-                ;; (find-daemon-option "untrusted-substitute-urls") ;client
-                ;; " "
-                (find-daemon-option "substitute-urls")          ;admin
                 string-tokenize)
     ((url)
      url)
@@ -788,94 +889,19 @@ substituter disabled~%")
    (with-error-handling                           ; for signature errors
      (match args
        (("--query")
-        (let ((cache (open-cache* %cache-url))
+        (let ((acl (current-acl)))
-              (acl   (current-acl)))
-          (define (valid? obj)
-            (and (narinfo? obj) (valid-narinfo? obj acl)))
-
           (let loop ((command (read-line)))
             (or (eof-object? command)
                 (begin
-                  (match (string-tokenize command)
+                  (process-query command
-                    (("have" paths ..1)
+                                 #:cache-url %cache-url
-                     ;; Return the subset of PATHS available in CACHE.
+                                 #:acl acl)
-                     (let ((substitutable
-                            (if cache
-                                (lookup-narinfos cache paths)
-                                '())))
-                       (for-each (lambda (narinfo)
-                                   (format #t "~a~%" (narinfo-path narinfo)))
-                                 (filter valid? substitutable))
-                       (newline)))
-                    (("info" paths ..1)
-                     ;; Reply info about PATHS if it's in CACHE.
-                     (let ((substitutable
-                            (if cache
-                                (lookup-narinfos cache paths)
-                                '())))
-                       (for-each (lambda (narinfo)
-                                   (format #t "~a\n~a\n~a\n"
-                                           (narinfo-path narinfo)
-                                           (or (and=> (narinfo-deriver narinfo)
-                                                      (cute string-append
-                                                            (%store-prefix) "/"
-                                                            <>))
-                                               "")
-                                           (length (narinfo-references narinfo)))
-                                   (for-each (cute format #t "~a/~a~%"
-                                                   (%store-prefix) <>)
-                                             (narinfo-references narinfo))
-                                   (format #t "~a\n~a\n"
-                                           (or (narinfo-file-size narinfo) 0)
-                                           (or (narinfo-size narinfo) 0)))
-                                 (filter valid? substitutable))
-                       (newline)))
-                    (wtf
-                     (error "unknown `--query' command" wtf)))
                   (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))
+        (process-substitution store-path destination
-               (narinfo (lookup-narinfo cache store-path))
+                              #:cache-url %cache-url
-               (uri     (narinfo-uri narinfo)))
+                              #:acl (current-acl)))
-          ;; Make sure it is signed and everything.
-          (assert-valid-narinfo narinfo)
-
-          ;; Tell the daemon what the expected hash of the Nar itself is.
-          (format #t "~a~%" (narinfo-hash narinfo))
-
-          (format (current-error-port) "downloading `~a'~:[~*~; (~,1f MiB installed)~]...~%"
-                  store-path
-
-                  ;; Use the Nar size as an estimate of the installed size.
-                  (narinfo-size narinfo)
-                  (and=> (narinfo-size narinfo)
-                         (cute / <> (expt 2. 20))))
-          (let*-values (((raw download-size)
-                         ;; Note that Hydra currently generates Nars on the fly
-                         ;; and doesn't specify a Content-Length, so
-                         ;; DOWNLOAD-SIZE is #f in practice.
-                         (fetch uri #:buffered? #f #:timeout? #f))
-                        ((progress)
-                         (let* ((comp     (narinfo-compression narinfo))
-                                (dl-size  (or download-size
-                                              (and (equal? comp "none")
-                                                   (narinfo-size narinfo))))
-                                (progress (progress-proc (uri-abbreviation uri)
-                                                         dl-size
-                                                         (current-error-port))))
-                           (progress-report-port progress raw)))
-                        ((input pids)
-                         (decompressed-port (and=> (narinfo-compression narinfo)
-                                                   string->symbol)
-                                            progress)))
-            ;; Unpack the Nar at INPUT into DESTINATION.
-            (restore-file input destination)
-
-            ;; Skip a line after what 'progress-proc' printed.
-            (newline (current-error-port))
-
-            (every (compose zero? cdr waitpid) pids))))
        (("--version")
         (show-version-and-exit "guix substitute"))
        (("--help")
@@ -883,7 +909,6 @@ substituter disabled~%")
        (opts
         (leave (_ "~a: unrecognized options~%") opts))))))
 
-
 ;;; Local Variables:
 ;;; eval: (put 'with-timeout 'scheme-indent-function 1)
 ;;; End:

guix/store.scm

@@ -37,6 +37,7 @@
   #:use-module (ice-9 popen)
   #:export (%daemon-socket-file
             %gc-roots-directory
+            %default-substitute-urls
 
             nix-server?
             nix-server-major-version

guix/tests.scm

@@ -36,6 +36,7 @@
             network-reachable?
             shebang-too-long?
             mock
+            %test-substitute-urls
             %substitute-directory
             with-derivation-narinfo
             with-derivation-substitute
@@ -49,6 +50,12 @@
 ;;;
 ;;; Code:
 
+(define %test-substitute-urls
+  ;; URLs where to look for substitutes during tests.
+  (make-parameter
+   (or (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") list)
+       '())))
+
 (define (open-connection-for-tests)
   "Open a connection to the build daemon for tests purposes and return it."
   (guard (c ((nix-error? c)
@@ -57,7 +64,9 @@
              #f))
     (let ((store (open-connection)))
       ;; Make sure we build everything by ourselves.
-      (set-build-options store #:use-substitutes? #f)
+      (set-build-options store
+                         #:use-substitutes? #f
+                         #:substitute-urls (%test-substitute-urls))
 
       ;; Use the bootstrap Guile when running tests, so we don't end up
       ;; building everything in the temporary test store.

tests/derivations.scm

@@ -612,7 +612,8 @@
          (output (derivation->output-path drv)))
 
     ;; Make sure substitutes are usable.
-    (set-build-options store #:use-substitutes? #t)
+    (set-build-options store #:use-substitutes? #t
+                       #:substitute-urls (%test-substitute-urls))
 
     (with-derivation-narinfo drv
       (let-values (((build download)
@@ -634,7 +635,8 @@
          (output (derivation->output-path drv)))
 
     ;; Make sure substitutes are usable.
-    (set-build-options store #:use-substitutes? #t)
+    (set-build-options store #:use-substitutes? #t
+                       #:substitute-urls (%test-substitute-urls))
 
     (with-derivation-narinfo drv
       (let-values (((build download)
@@ -655,7 +657,8 @@
            (output (derivation->output-path drv)))
 
       ;; Make sure substitutes are usable.
-      (set-build-options store #:use-substitutes? #t)
+      (set-build-options store #:use-substitutes? #t
+                         #:substitute-urls (%test-substitute-urls))
 
       (with-derivation-narinfo drv
         (let-values (((build download)

tests/file-systems.scm

@@ -0,0 +1,46 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 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 (test-file-systems)
+  #:use-module (gnu system file-systems)
+  #:use-module (srfi srfi-64)
+  #:use-module (rnrs bytevectors))
+
+;; Test the (gnu system file-systems) module.
+
+(test-begin "file-systems")
+
+(test-equal "uuid->string"
+  "c5307e6b-d1ba-499d-89c5-cb0b143577c4"
+  (uuid->string
+   #vu8(197 48 126 107 209 186 73 157 137 197 203 11 20 53 119 196)))
+
+(test-equal "string->uuid"
+  '(16 "4dab5feb-d176-45de-b287-9b0a6e4c01cb")
+  (let ((uuid (string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))
+    (list (bytevector-length uuid) (uuid->string uuid))))
+
+(test-assert "uuid"
+  (let ((str "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))
+    (bytevector=? (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")
+                  (string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))))
+
+(test-end)
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))

tests/guix-daemon.sh

@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2014 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -54,11 +54,12 @@ EOF
 rm -f "$XDG_CACHE_HOME/guix/substitute/$hash_part"
 
 # Make sure we see the substitute.
-guile -c '
+guile -c "
   (use-modules (guix))
   (define store (open-connection))
-  (set-build-options store #:use-substitutes? #t)
+  (set-build-options store #:use-substitutes? #t
-  (exit (has-substitutes? store "'"$out"'"))'
+                     #:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\"))
+  (exit (has-substitutes? store \"$out\"))"
 
 # Now, run guix-daemon --no-substitutes.
 socket="$NIX_STATE_DIR/alternate-socket"
@@ -72,6 +73,7 @@ guile -c "
   (define store (open-connection \"$socket\"))
 
   ;; This setting MUST NOT override the daemon's --no-substitutes.
-  (set-build-options store #:use-substitutes? #t)
+  (set-build-options store #:use-substitutes? #t
+                     #:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\"))
 
   (exit (not (has-substitutes? store \"$out\")))"

tests/store.scm

@@ -25,6 +25,7 @@
   #:use-module (guix packages)
   #:use-module (guix derivations)
   #:use-module (guix serialization)
+  #:use-module (guix build utils)
   #:use-module (guix gexp)
   #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
@@ -371,13 +372,13 @@
       (with-derivation-narinfo d
         ;; Remove entry from the local cache.
         (false-if-exception
-         (delete-file (string-append (getenv "XDG_CACHE_HOME")
+         (delete-file-recursively (string-append (getenv "XDG_CACHE_HOME")
-                                     "/guix/substitute/"
+                                                 "/guix/substitute")))
-                                     (store-path-hash-part o))))
 
         ;; Make sure 'guix substitute' correctly communicates the above
         ;; data.
-        (set-build-options s #:use-substitutes? #t)
+        (set-build-options s #:use-substitutes? #t
+                           #:substitute-urls (%test-substitute-urls))
         (and (has-substitutes? s o)
              (equal? (list o) (substitutable-paths s (list o)))
              (match (pk 'spi (substitutable-path-info s (list o)))
@@ -387,6 +388,34 @@
                      (null? (substitutable-references s))
                      (equal? (substitutable-nar-size s) 1234)))))))))
 
+(test-assert "substitute query, alternating URLs"
+  (let* ((d (with-store s
+              (package-derivation s %bootstrap-guile (%current-system))))
+         (o (derivation->output-path d)))
+    (with-derivation-narinfo d
+      ;; Remove entry from the local cache.
+      (false-if-exception
+       (delete-file-recursively (string-append (getenv "XDG_CACHE_HOME")
+                                               "/guix/substitute")))
+
+      ;; Note: We reconnect to the daemon to force a new instance of 'guix
+      ;; substitute' to be used; otherwise the #:substitute-urls of
+      ;; 'set-build-options' would have no effect.
+
+      (and (with-store s                        ;the right substitute URL
+             (set-build-options s #:use-substitutes? #t
+                                #:substitute-urls (%test-substitute-urls))
+             (has-substitutes? s o))
+           (with-store s                        ;the wrong one
+             (set-build-options s #:use-substitutes? #t
+                                #:substitute-urls (list
+                                                   "http://does-not-exist"))
+             (not (has-substitutes? s o)))
+           (with-store s                        ;the right one again
+             (set-build-options s #:use-substitutes? #t
+                                #:substitute-urls (%test-substitute-urls))
+             (has-substitutes? s o))))))
+
 (test-assert "substitute"
   (with-store s
     (let* ((c   (random-text))                     ; contents of the output
@@ -400,7 +429,8 @@
                  (package-derivation s %bootstrap-guile (%current-system))))
            (o   (derivation->output-path d)))
       (with-derivation-substitute d c
-        (set-build-options s #:use-substitutes? #t)
+        (set-build-options s #:use-substitutes? #t
+                           #:substitute-urls (%test-substitute-urls))
         (and (has-substitutes? s o)
              (build-derivations s (list d))
              (equal? c (call-with-input-file o get-string-all)))))))
@@ -418,7 +448,8 @@
                  (package-derivation s %bootstrap-guile (%current-system))))
            (o   (derivation->output-path d)))
       (with-derivation-substitute d c
-        (set-build-options s #:use-substitutes? #t)
+        (set-build-options s #:use-substitutes? #t
+                           #:substitute-urls (%test-substitute-urls))
         (and (has-substitutes? s o)
              (build-things s (list o))            ;give the output path
              (valid-path? s o)
@@ -442,7 +473,8 @@
         ;; Make sure we use 'guix substitute'.
         (set-build-options s
                            #:use-substitutes? #t
-                           #:fallback? #f)
+                           #:fallback? #f
+                           #:substitute-urls (%test-substitute-urls))
         (and (has-substitutes? s o)
              (guard (c ((nix-protocol-error? c)
                         ;; XXX: the daemon writes "hash mismatch in downloaded
@@ -467,13 +499,16 @@
       ;; Create fake substituter data, to be read by 'guix substitute'.
       (with-derivation-narinfo d
         ;; Make sure we use 'guix substitute'.
-        (set-build-options s #:use-substitutes? #t)
+        (set-build-options s #:use-substitutes? #t
+                           #:substitute-urls (%test-substitute-urls))
         (and (has-substitutes? s o)
              (guard (c ((nix-protocol-error? c)
                         ;; The substituter failed as expected.  Now make
                         ;; sure that #:fallback? #t works correctly.
                         (set-build-options s
                                            #:use-substitutes? #t
+                                           #:substitute-urls
+                                             (%test-substitute-urls)
                                            #:fallback? #t)
                         (and (build-derivations s (list d))
                              (equal? t (call-with-input-file o

tests/syscalls.scm

@@ -80,6 +80,8 @@
 (define (user-namespace pid)
   (string-append "/proc/" (number->string pid) "/ns/user"))
 
+(unless (file-exists? (user-namespace (getpid)))
+  (test-skip 1))
 (test-assert "clone"
   (match (clone (logior CLONE_NEWUSER SIGCHLD))
     (0 (primitive-exit 42))
@@ -91,6 +93,8 @@
             ((_ . status)
              (= 42 (status:exit-val status))))))))
 
+(unless (file-exists? (user-namespace (getpid)))
+  (test-skip 1))
 (test-assert "setns"
   (match (clone (logior CLONE_NEWUSER SIGCHLD))
     (0 (primitive-exit 0))
@@ -118,6 +122,8 @@
              (waitpid fork-pid)
              result))))))))
 
+(unless (file-exists? (user-namespace (getpid)))
+  (test-skip 1))
 (test-assert "pivot-root"
   (match (pipe)
     ((in . out)