Merge branch 'master' into gnome-updates

.gitignore

@@ -128,3 +128,4 @@ stamp-h[0-9]
 tmp
 /doc/os-config-lightweight-desktop.texi
 /nix/scripts/download
+/etc/indent-code.el

configure.ac

@@ -232,6 +232,10 @@ AM_MISSING_PROG([DOT], [dot])
 dnl Manual pages.
 AM_MISSING_PROG([HELP2MAN], [help2man])
 
+dnl Emacs (optional), for 'etc/indent-package.el'.
+AC_PATH_PROG([EMACS], [emacs], [/usr/bin/emacs])
+AC_SUBST([EMACS])
+
 AC_CONFIG_FILES([Makefile
                  po/guix/Makefile.in
                  po/packages/Makefile.in
@@ -241,5 +245,6 @@ AC_CONFIG_FILES([scripts/guix], [chmod +x scripts/guix])
 AC_CONFIG_FILES([test-env:build-aux/test-env.in], [chmod +x test-env])
 AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in],
   [chmod +x pre-inst-env])
+AC_CONFIG_FILES([etc/indent-code.el], [chmod +x etc/indent-code.el])
 
 AC_OUTPUT

doc/contributing.texi

@@ -237,6 +237,8 @@ especially when matching lists.
 @node Formatting Code
 @subsection Formatting Code
 
+@cindex formatting code
+@cindex coding style
 When writing Scheme code, we follow common wisdom among Scheme
 programmers.  In general, we follow the
 @url{http://mumble.net/~campbell/scheme/style.txt, Riastradh's Lisp
@@ -246,8 +248,25 @@ please do read it.
 
 Some special forms introduced in Guix, such as the @code{substitute*}
 macro, have special indentation rules.  These are defined in the
-@file{.dir-locals.el} file, which Emacs automatically uses.  If you do
+@file{.dir-locals.el} file, which Emacs automatically uses.
-not use Emacs, please make sure to let your editor know the rules.
+
+@cindex indentation, of code
+@cindex formatting, of code
+If you do not use Emacs, please make sure to let your editor knows these
+rules.  To automatically indent a package definition, you can also run:
+
+@example
+./etc/indent-code.el gnu/packages/@var{file}.scm @var{package}
+@end example
+
+@noindent
+This automatically indents the definition of @var{package} in
+@file{gnu/packages/@var{file}.scm} by running Emacs in batch mode.  To
+indent a whole file, omit the second argument:
+
+@example
+./etc/indent-code.el gnu/services/@var{file}.scm
+@end example
 
 We require all top-level procedures to carry a docstring.  This
 requirement can be relaxed for simple private procedures in the
@@ -358,6 +377,11 @@ Bundling unrelated changes together makes reviewing harder and slower.
 Examples of unrelated changes include the addition of several packages,
 or a package update along with fixes to that package.
 
+@item
+Please follow our code formatting rules, possibly running the
+@command{etc/indent-code.el} script to do that automatically for you
+(@pxref{Formatting Code}).
+
 @end enumerate
 
 When posting a patch to the mailing list, use @samp{[PATCH] @dots{}} as

doc/guix.texi

@@ -6412,6 +6412,11 @@ The one option that matters is:
 Consider @var{urls} the whitespace-separated list of substitute source
 URLs to compare to.
 
+@item --verbose
+@itemx -v
+Show details about matches (identical contents) in addition to
+information about mismatches.
+
 @end table
 
 @node Invoking guix copy
@@ -10331,6 +10336,30 @@ TCP port on which the database server listens for incoming connections.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} redis-service-type
+This is the service type for the @uref{https://redis.io/, Redis}
+key/value store, whose value is a @code{redis-configuration} object.
+@end defvr
+
+@deftp {Data Type} redis-configuration
+Data type representing the configuration of redis.
+
+@table @asis
+@item @code{redis} (default: @code{redis})
+The Redis package to use.
+
+@item @code{bind} (default: @code{"127.0.0.1"})
+Network interface on which to listen.
+
+@item @code{port} (default: @code{6379})
+Port on which to accept connections on, a value of 0 will disable
+listining on a TCP socket.
+
+@item @code{working-directory} (default: @code{"/var/lib/redis"})
+Directory in which to store the database and related files.
+@end table
+@end deftp
+
 @node Mail Services
 @subsubsection Mail Services
 

doc/local.mk

@@ -1,6 +1,6 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
-# Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2013 Andreas Enge <andreas@enge.fr>
 # Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
 # Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
@@ -37,7 +37,6 @@ DOT_VECTOR_GRAPHICS =				\
 EXTRA_DIST +=					\
   %D%/htmlxref.cnf				\
   %D%/contributing.texi				\
-  %D%/emacs.texi				\
   %D%/fdl-1.3.texi				\
   $(DOT_FILES)					\
   $(DOT_VECTOR_GRAPHICS)			\

etc/indent-code.el.in

@@ -0,0 +1,62 @@
+#!@EMACS@ --script
+;;; indent-code.el --- Run Emacs to indent a package definition.
+
+;; Copyright © 2017 Alex Kost <alezost@gmail.com>
+;; Copyright © 2017 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This scripts indents the given file or package definition in the specified
+;; file using Emacs.
+
+;;; Code:
+
+;; Load Scheme indentation rules from the current directory.
+(with-temp-buffer
+  (scheme-mode)
+  (let ((default-directory (file-name-as-directory "."))
+        (enable-local-variables :all))
+    (hack-dir-local-variables)
+    (hack-local-variables-apply)))
+
+(pcase command-line-args-left
+  (`(,file-name ,package-name)
+   ;; Indent the definition of PACKAGE-NAME in FILE-NAME.
+   (find-file file-name)
+   (goto-char (point-min))
+   (if (re-search-forward (concat "^(define\\(-public\\) +"
+                                  package-name)
+                          nil t)
+       (let ((indent-tabs-mode nil))
+         (beginning-of-defun)
+         (indent-sexp)
+         (save-buffer)
+         (message "Done!"))
+     (error "Package '%s' not found in '%s'"
+            package-name file-name)))
+  (`(,file-name)
+   ;; Indent all of FILE-NAME.
+   (find-file file-name)
+   (let ((indent-tabs-mode nil))
+     (indent-region (point-min) (point-max))
+     (save-buffer)
+     (message "Done!")))
+  (x
+   (error "Usage: indent-code.el FILE [PACKAGE]")))
+
+;;; indent-code.el ends here

gnu/packages/abiword.scm

@@ -22,6 +22,7 @@
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
+  #:use-module (guix build-system glib-or-gtk)
   #:use-module (gnu packages)
   #:use-module (gnu packages autotools)
   #:use-module (gnu packages boost)
@@ -52,11 +53,17 @@
                          "/source/" name "-" version ".tar.gz"))
         (sha256
           (base32 "1ik591rx15nn3n1297cwykl8wvrlgj78i528id9wbidgy3xzd570"))
+        (modules '((guix build utils)))
+        (snippet
+         ;; Ensure reproducibility.
+         '(substitute* "src/wp/main/xp/abi_ver.cpp"
+            (("__DATE__") "\"2017\"")
+            (("__TIME__") "\"00:00\"")))
         (patches
          (search-patches "abiword-wmf-version-lookup-fix.patch"
                          "abiword-explictly-cast-bools.patch"))))
 
-    (build-system gnu-build-system)
+    (build-system glib-or-gtk-build-system)
     (arguments                   ;; NOTE: rsvg is disabled, since Abiword
       `(#:configure-flags        ;; supports it directly, and its BS is broken.
         (list

gnu/packages/admin.scm

@@ -471,7 +471,7 @@ connection alive.")
          (bind-minor-version "9")
          (bind-patch-version "9")
          (bind-release-type "-P")         ; for patch release, use "-P"
-         (bind-release-version "4")      ; for patch release, e.g. "4"
+         (bind-release-version "5")      ; for patch release, e.g. "4"
          (bind-version (string-append bind-major-version
                                       "."
                                       bind-minor-version
@@ -587,7 +587,7 @@ connection alive.")
                                         "/bind-" bind-version ".tar.gz"))
                     (sha256
                      (base32
-                      "1qpi23lrs6jfxqx8dakbqfyg3hvrzq5ldchg6my19xcvx8515mgx"))))
+                      "1yn15chkfqf4d7961ip2x10jm27a9wqymz2xqh0a2g89arrirkaw"))))
 
                 ;; When cross-compiling, we need the cross Coreutils and sed.
                 ;; Otherwise just use those from %FINAL-INPUTS.

gnu/packages/audacity.scm

@@ -24,6 +24,7 @@
   #:use-module (gnu packages)
   #:use-module (gnu packages audio)
   #:use-module (gnu packages base)
+  #:use-module (gnu packages gettext)
   #:use-module (gnu packages gtk)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages mp3)
@@ -38,20 +39,20 @@
 (define-public audacity
   (package
     (name "audacity")
-    (version "2.1.0")
+    (version "2.1.2")
     (source
      (origin
        (method url-fetch)
-       (uri (string-append "mirror://sourceforge/audacity/audacity/" version
+       (uri (string-append "https://github.com/audacity/audacity/archive"
-                           "/audacity-minsrc-" version ".tar.xz"))
+                           "/Audacity-" version ".zip"))
        (sha256
-        (base32 "1cs2w3fwqylpqmfwkvlgdx5lhclpckfil7pqibl37qlbnf4qvndh"))
+        (base32 "1642i9d5cdmqzj6r0qdl2ldnqsvpb08znnczncysi72x6zpvb5qq"))
        (patches (search-patches "audacity-fix-ffmpeg-binding.patch"))))
     (build-system gnu-build-system)
     (inputs
      ;; TODO: Add portSMF and libwidgetextra once they're packaged.  In-tree
      ;; versions shipping with Audacity are used for now.
-     `(("wxwidgets" ,wxwidgets-2)
+     `(("wxwidgets" ,wxwidgets-gtk2)
        ("gtk" ,gtk+-2)
        ("alsa-lib" ,alsa-lib)
        ("jack" ,jack-1)
@@ -72,7 +73,8 @@
        ("lilv" ,lilv)
        ("portaudio" ,portaudio)))
     (native-inputs
-     `(("pkg-config" ,pkg-config)
+     `(("gettext" ,gettext-minimal)     ;for msgfmt
+       ("pkg-config" ,pkg-config)
        ("python" ,python-2)
        ("which" ,which)))
     (arguments

gnu/packages/bioinformatics.scm

@@ -7100,6 +7100,41 @@ musculus (Mouse) as provided by UCSC (mm10, December 2011) and stored
 in Biostrings objects.")
     (license license:artistic2.0)))
 
+(define-public r-txdb-mmusculus-ucsc-mm10-knowngene
+  (package
+    (name "r-txdb-mmusculus-ucsc-mm10-knowngene")
+    (version "3.4.0")
+    (source (origin
+              (method url-fetch)
+              ;; We cannot use bioconductor-uri here because this tarball is
+              ;; located under "data/annotation/" instead of "bioc/".
+              (uri (string-append "http://www.bioconductor.org/packages/"
+                                  "release/data/annotation/src/contrib/"
+                                  "TxDb.Mmusculus.UCSC.mm10.knownGene_"
+                                  version ".tar.gz"))
+              (sha256
+               (base32
+                "08gava9wsvpcqz51k2sni3pj03n5155v32d9riqbf305nbirqbkb"))))
+    (properties
+     `((upstream-name . "TxDb.Mmusculus.UCSC.mm10.knownGene")))
+    (build-system r-build-system)
+    ;; As this package provides little more than a very large data file it
+    ;; doesn't make sense to build substitutes.
+    (arguments `(#:substitutable? #f))
+    (propagated-inputs
+     `(("r-bsgenome" ,r-bsgenome)
+       ("r-genomicfeatures" ,r-genomicfeatures)
+       ("r-annotationdbi" ,r-annotationdbi)))
+    (home-page
+     "http://bioconductor.org/packages/TxDb.Mmusculus.UCSC.mm10.knownGene/")
+    (synopsis "Annotation package for TxDb knownGene object(s) for Mouse")
+    (description
+     "This package loads a TxDb object, which is an R interface to
+prefabricated databases contained in this package.  This package provides
+the TxDb object of Mouse data as provided by UCSC (mm10, December 2011)
+based on the knownGene track.")
+    (license license:artistic2.0)))
+
 (define-public r-bsgenome-celegans-ucsc-ce6
   (package
     (name "r-bsgenome-celegans-ucsc-ce6")
@@ -7960,3 +7995,29 @@ immunoprecipitation and target enrichment on small gene panels.  Thereby,
 CopywriteR constitutes a widely applicable alternative to available copy
 number detection tools.")
     (license license:gpl2)))
+
+(define-public r-sva
+  (package
+    (name "r-sva")
+    (version "3.22.0")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (bioconductor-uri "sva" version))
+       (sha256
+        (base32
+         "1wc1fjm6dzlsqqagm43y57w8jh8nsh0r0m8z1p6ximcb5gxqh7hn"))))
+    (build-system r-build-system)
+    (propagated-inputs
+     `(("r-genefilter" ,r-genefilter)))
+    (home-page "http://bioconductor.org/packages/sva")
+    (synopsis "Surrogate variable analysis")
+    (description
+     "This package contains functions for removing batch effects and other
+unwanted variation in high-throughput experiment.  It also contains functions
+for identifying and building surrogate variables for high-dimensional data
+sets.  Surrogate variables are covariates constructed directly from
+high-dimensional data like gene expression/RNA sequencing/methylation/brain
+imaging data that can be used in subsequent analyses to adjust for unknown,
+unmodeled, or latent sources of noise.")
+    (license license:artistic2.0)))

gnu/packages/dns.scm

@@ -76,7 +76,7 @@ and BOOTP/TFTP for network booting of diskless machines.")
 (define-public bind
   (package
     (name "bind")
-    (version "9.10.4-P4")
+    (version "9.10.4-P5")
     (source (origin
               (method url-fetch)
               (uri (string-append
@@ -84,7 +84,7 @@ and BOOTP/TFTP for network booting of diskless machines.")
                     version ".tar.gz"))
               (sha256
                (base32
-                "11lxkb7d79c75scrs28q4xmr0ii2li69zj1c650al3qxir8yf754"))))
+                "1sqg7wg05h66vdjc8j215r04f8pg7lphkb93nsqxvzhk6r0ppi49"))))
     (build-system gnu-build-system)
     (outputs `("out" "utils"))
     (inputs

gnu/packages/freedesktop.scm

@@ -854,6 +854,18 @@ software.")
                (base32
                 "05915i0bv7q62fqrs5diqwr8dz3pwqa1c1ivcgggkjyw0xk4ldp5"))))
     (build-system gnu-build-system)
+    (arguments
+     '(#:phases (modify-phases %standard-phases
+                  (add-before 'build 'set-sysconfdir
+                    (lambda* (#:key outputs #:allow-other-keys)
+                      ;; Work around a bug whereby the 'SYSCONFDIR' macro
+                      ;; expands literally to '${prefix}/etc'.
+                      (let ((out (assoc-ref outputs "out")))
+                        (substitute* "src/main.c"
+                          (("SYSCONFDIR, \"fprintd.conf\"")
+                           (string-append "\"" out "/etc\", "
+                                          "\"fprintd.conf\"")))
+                        #t))))))
     (native-inputs
      `(("pkg-config" ,pkg-config)
        ("intltool" ,intltool)))

gnu/packages/gimp.scm

@@ -38,8 +38,7 @@
   #:use-module (gnu packages pdf)
   #:use-module (gnu packages photo)
   #:use-module (gnu packages python)
-  #:use-module (gnu packages xorg)
+  #:use-module (gnu packages xorg))
-  #:use-module (gnu packages imagemagick))
 
 (define-public babl
   (package

gnu/packages/gnucash.scm

@@ -165,7 +165,7 @@ applications and libraries.  It is used by AqBanking.")
        (file-name (string-append name "-" version ".tar.gz"))
        (sha256
         (base32
-         "1x0isvpk43rq2zlyyb9p0kgjmqv7yq07vgkiprw3f5sjkykvxw6d"))))
+         "08jbwmiv6f3v8iqdr44x4szna496fqcjfi6mlx04cnbx91m70lh6"))))
     (build-system gnu-build-system)
     (arguments
      `(;; Parallel building fails because aqhbci is required before it's

gnu/packages/haskell.scm

@@ -3052,7 +3052,7 @@ use HUnit assertions as QuickCheck properties.")
 (define-public ghc-quickcheck
   (package
     (name "ghc-quickcheck")
-    (version "2.8.1")
+    (version "2.8.2")
     (outputs '("out" "doc"))
     (source
      (origin
@@ -3063,7 +3063,7 @@ use HUnit assertions as QuickCheck properties.")
              ".tar.gz"))
        (sha256
         (base32
-         "0fvnfl30fxmj5q920l13641ar896d53z0z6z66m7c1366lvalwvh"))))
+         "1ai6k5v0bibaxq8xffcblc6rwmmk6gf8vjyd9p2h3y6vwbhlvilq"))))
     (build-system haskell-build-system)
     (arguments
      `(#:tests? #f  ; FIXME: currently missing libraries used for tests.
@@ -4573,7 +4573,7 @@ just a @code{Semigroup} are added.")
 (define-public ghc-semigroups
   (package
     (name "ghc-semigroups")
-    (version "0.17.0.1")
+    (version "0.18.2")
     (source
      (origin
        (method url-fetch)
@@ -4583,7 +4583,7 @@ just a @code{Semigroup} are added.")
              ".tar.gz"))
        (sha256
         (base32
-         "0gvpfi7s6ys4qha3y9a1zl1a15gf9cgg33wjb94ghg82ivcxnc3r"))))
+         "1r6hsn3am3dpf4rprrj4m04d9318v9iq02bin0pl29dg4a3gzjax"))))
     (build-system haskell-build-system)
     (inputs
      `(("ghc-nats" ,ghc-nats)
@@ -8133,4 +8133,33 @@ Rust syntax.  It is intended to be useful for two different purposes:
 @end enumerate\n")
       (license license:gpl2+))))
 
+(define-public ghc-wave
+  (package
+    (name "ghc-wave")
+    (version "0.1.4")
+    (source (origin
+      (method url-fetch)
+      (uri (string-append
+             "https://hackage.haskell.org/package/wave/wave-"
+             version
+             ".tar.gz"))
+      (sha256
+        (base32
+          "1g5nmqfk6p25v9ismwz4i66ay91bd1qh39xwj0hm4z6a5mw8frk8"))))
+    (build-system haskell-build-system)
+    (inputs
+     `(("ghc-cereal" ,ghc-cereal)
+       ("ghc-data-default-class"
+        ,ghc-data-default-class)
+       ("ghc-quickcheck" ,ghc-quickcheck)
+       ("ghc-temporary" ,ghc-temporary)))
+    (native-inputs
+     `(("hspec-discover" ,hspec-discover)
+       ("ghc-hspec" ,ghc-hspec)))
+    (home-page "https://github.com/mrkkrp/wave")
+    (synopsis "Work with WAVE and RF64 files in Haskell")
+    (description "This package allows you to work with WAVE and RF64
+files in Haskell.")
+    (license license:bsd-3)))
+
 ;;; haskell.scm ends here

gnu/packages/linux.scm

@@ -7,7 +7,7 @@
 ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
 ;;; Copyright © 2015, 2016 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
-;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2016, 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2016 Raymond Nicholson <rain1@openmailbox.org>
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
@@ -333,14 +333,14 @@ It has been modified to remove all non-free binary blobs.")
 (define %intel-compatible-systems '("x86_64-linux" "i686-linux"))
 
 (define-public linux-libre
-  (make-linux-libre "4.9.2"
+  (make-linux-libre "4.9.3"
-                    "08gd5ja5gdhzpwzbjhipwmh4myp0hj13k1wsl1xvplszh3p9b076"
+                    "1jd2rz58lcha9ac35glr26lc6hfi49fvpiwshgpd6ygf4irrs82w"
                     %intel-compatible-systems
                     #:configuration-file kernel-config))
 
 (define-public linux-libre-4.4
-  (make-linux-libre "4.4.41"
+  (make-linux-libre "4.4.42"
-                    "1kl1m0riq90xldcf7lvjzdyz57w1wmnm93j0r0v8xz7n66m5nkp8"
+                    "1jd43yvycizgqdmwp9rpj7gpjy37mah8jlqaiskjb0hivyk495yz"
                     %intel-compatible-systems
                     #:configuration-file kernel-config))
 
@@ -351,8 +351,8 @@ It has been modified to remove all non-free binary blobs.")
                     #:configuration-file kernel-config))
 
 ;; Avoid rebuilding kernel variants when there is a minor version bump.
-(define %linux-libre-version "4.9.2")
+(define %linux-libre-version "4.9.3")
-(define %linux-libre-hash "08gd5ja5gdhzpwzbjhipwmh4myp0hj13k1wsl1xvplszh3p9b076")
+(define %linux-libre-hash "1jd2rz58lcha9ac35glr26lc6hfi49fvpiwshgpd6ygf4irrs82w")
 
 (define-public linux-libre-arm-generic
   (make-linux-libre %linux-libre-version
@@ -597,7 +597,7 @@ slabtop, and skill.")
     (build-system gnu-build-system)
     (inputs
      `(("libusb" ,libusb)
-       ("eudev" ,eudev)))
+       ("eudev" ,eudev-with-hwdb)))
     (native-inputs
      `(("pkg-config" ,pkg-config)))
     (home-page "http://www.linux-usb.org/")
@@ -1740,6 +1740,21 @@ device nodes from /dev/, handles hotplug events and loads drivers at boot
 time.")
     (license license:gpl2+)))
 
+(define-public eudev-with-hwdb
+  ;; TODO: Merge with 'eudev'.
+  (package
+    (inherit eudev)
+    (name "eudev-with-hwdb")
+    (arguments
+     '(#:phases (modify-phases %standard-phases
+                  (add-after 'install 'build-hwdb
+                    (lambda* (#:key outputs #:allow-other-keys)
+                      ;; Build OUT/etc/udev/hwdb.bin.  This allows 'lsusb' and
+                      ;; similar tools to display product names.
+                      (let ((out (assoc-ref outputs "out")))
+                        (zero? (system* (string-append out "/bin/udevadm")
+                                        "hwdb" "--update"))))))))))
+
 (define-public lvm2
   (package
     (name "lvm2")
@@ -3101,14 +3116,14 @@ the default @code{nsswitch} and the experimental @code{umich_ldap}.")
 (define-public mcelog
   (package
     (name "mcelog")
-    (version "146")
+    (version "147")
     (source (origin
               (method url-fetch)
               (uri (string-append "https://git.kernel.org/cgit/utils/cpu/mce/"
                                   "mcelog.git/snapshot/v" version ".tar.gz"))
               (sha256
                (base32
-                "0jjx4q1mfa380319cqz86nw5wv6jnbpvq2r8n0dyh87mhvrgb4wi"))
+                "10xxmqpd348ifbs7w8j0m53agp28r6imv237ha3kmhp632hmyf1d"))
               (file-name (string-append name "-" version ".tar.gz"))
               (modules '((guix build utils)))
               (snippet

gnu/packages/nano.scm

@@ -29,7 +29,7 @@
 (define-public nano
   (package
     (name "nano")
-    (version "2.7.3")
+    (version "2.7.4")
     (source
      (origin
       (method url-fetch)
@@ -37,7 +37,7 @@
                           version ".tar.gz"))
       (sha256
        (base32
-        "123si2acvfhnl2kip08bqm413yv36zy3pmj75ibkn7q59mcx8x1m"))))
+        "135wzlv77p9za8679j2jpfkpvainvyagrhkdxngp71ynabgc5zr3"))))
     (build-system gnu-build-system)
     (inputs
      `(("gettext" ,gettext-minimal)

gnu/packages/package-management.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -224,9 +224,9 @@ the Nix package manager.")
   ;;
   ;; Note: use a very short commit id; with a longer one, the limit on
   ;; hash-bang lines would be exceeded while running the tests.
-  (let ((commit "b291b3271a025dfe41e1a7fdfadd393373b0128d"))
+  (let ((commit "eefd042e60d9fc1d092b44bf80ecbfe65b291e46"))
     (package (inherit guix-0.12.0)
-      (version (string-append "0.12.0-2." (string-take commit 4)))
+      (version (string-append "0.12.0-3." (string-take commit 4)))
       (source (origin
                 (method git-fetch)
                 (uri (git-reference
@@ -236,7 +236,7 @@ the Nix package manager.")
                       (commit commit)))
                 (sha256
                  (base32
-                  "1hris387xn2wk4lcl20x1zyhiz96060w34xs1x13b4vmvkkvcpg4"))
+                  "1g0042x80q73pb9y39aqbkajl4bacls5c0im9aljmjnsb80fsh8d"))
                 (file-name (string-append "guix-" version "-checkout"))))
       (arguments
        (substitute-keyword-arguments (package-arguments guix-0.12.0)

gnu/packages/perl.scm

@@ -12,6 +12,7 @@
 ;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
 ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2017 Raoul J.P. Bonnal <ilpuccio.febo@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -5014,6 +5015,30 @@ show those variables which are in scope at the point of the call.  PadWalker
 is particularly useful for debugging.")
     (license (package-license perl))))
 
+(define-public perl-parallel-forkmanager
+  (package
+    (name "perl-parallel-forkmanager")
+    (version "1.19")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append
+             "mirror://cpan/authors/id/Y/YA/YANICK/Parallel-ForkManager-"
+             version
+             ".tar.gz"))
+       (sha256
+        (base32
+         "0wm4wp6p3ah5z212jl12728z68nmxmfr0f03z1jpvdzffnc2xppi"))))
+    (build-system perl-build-system)
+    (native-inputs
+     `(("perl-test-warn" ,perl-test-warn)))
+    (home-page "http://search.cpan.org/dist/Parallel-ForkManager")
+    (synopsis "Simple parallel processing fork manager")
+    (description "@code{Parallel::ForkManager} is intended for use in
+operations that can be done in parallel where the number of
+processes to be forked off should be limited.")
+    (license (package-license perl))))
+
 (define-public perl-params-util
   (package
     (name "perl-params-util")

gnu/packages/python.scm

@@ -1321,7 +1321,7 @@ Python 3.3+.")
     (arguments `(#:python ,python-2
                  #:tests? #f))                    ; invalid command "test"
     (home-page "https://fedorahosted.org/dogtail/")
-    (synopsis "GUI test tool and automation framework written in ​Python")
+    (synopsis "GUI test tool and automation framework written in Python")
     (description
      "Dogtail is a GUI test tool and automation framework written in Python.
 It uses Accessibility (a11y) technologies to communicate with desktop
@@ -12331,3 +12331,47 @@ possible on all supported Python versions.")
 
 (define-public python2-xopen
   (package-with-python2 python-xopen))
+
+(define-public python2-cheetah
+  (package
+    (name "python2-cheetah")
+    (version "2.4.4")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (pypi-uri "Cheetah" version))
+        (sha256
+          (base32
+            "0l5mm4lnysjkzpjr95q5ydm9xc8bv43fxmr79ypybrf1y0lq4c5y"))))
+    (build-system python-build-system)
+    (arguments
+     `(#:python ,python-2))
+    (propagated-inputs
+     `(("python2-markdown" ,python2-markdown)))
+    (home-page "https://pythonhosted.org/Cheetah/")
+    (synopsis "Template engine")
+    (description "Cheetah is a text-based template engine and Python code
+generator.
+
+Cheetah can be used as a standalone templating utility or referenced as
+a library from other Python applications.  It has many potential uses,
+but web developers looking for a viable alternative to ASP, JSP, PHP and
+PSP are expected to be its principle user group.
+
+Features:
+@enumerate
+@item Generates HTML, SGML, XML, SQL, Postscript, form email, LaTeX, or any other
+   text-based format.
+@item Cleanly separates content, graphic design, and program code.
+@item Blends the power and flexibility of Python with a simple template language
+   that non-programmers can understand.
+@item Gives template writers full access to any Python data structure, module,
+   function, object, or method in their templates.
+@item Makes code reuse easy by providing an object-orientated interface to
+   templates that is accessible from Python code or other Cheetah templates.
+   One template can subclass another and selectively reimplement sections of it.
+@item Provides a simple, yet powerful, caching mechanism that can dramatically
+   improve the performance of a dynamic website.
+@item Compiles templates into optimized, yet readable, Python code.
+@end enumerate")
+    (license (license:x11-style "file://LICENSE"))))

gnu/packages/qt.scm

@@ -2,7 +2,7 @@
 ;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2015, 2016 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2015, 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2016, 2017 ng0 <ng0@libertad.pw>
 ;;; Copyright © 2016 Thomas Danckaert <post@thomasdanckaert.be>
 ;;;
@@ -55,6 +55,7 @@
   #:use-module (gnu packages pulseaudio)
   #:use-module (gnu packages python)
   #:use-module (gnu packages ruby)
+  #:use-module (gnu packages sdl)
   #:use-module (gnu packages tls)
   #:use-module (gnu packages xdisorg)
   #:use-module (gnu packages xorg)
@@ -553,14 +554,22 @@ developers using C++ or QML, a CSS & JavaScript like language.")
          (replace 'configure
            (lambda* (#:key outputs #:allow-other-keys)
              (let ((out (assoc-ref outputs "out")))
-               (zero? (system* "qmake" (string-append "PREFIX=" out))))))
+               ;; Valid QT_BUILD_PARTS variables are:
+               ;; libs tools tests examples demos docs translations
+               (zero? (system* "qmake" "QT_BUILD_PARTS = libs tools tests"
+                               (string-append "PREFIX=" out))))))
          (add-before 'install 'fix-Makefiles
            (lambda* (#:key inputs outputs #:allow-other-keys)
              (let ((out    (assoc-ref outputs "out"))
                    (qtbase (assoc-ref inputs "qtbase")))
                (substitute* (find-files "." "Makefile")
                             (((string-append "INSTALL_ROOT)" qtbase))
-                             (string-append "INSTALL_ROOT)" out)))))))))))
+                             (string-append "INSTALL_ROOT)" out)))
+               #t)))
+            (add-before 'check 'set-display
+              (lambda _
+                (setenv "QT_QPA_PLATFORM" "offscreen")
+                #t)))))))
 
 (define-public qtimageformats
   (package (inherit qtsvg)
@@ -602,6 +611,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
              (sha256
               (base32
                "09z49jm70f5i0gcdz9a16z00pg96x8pz7vri5wpirh3fqqn0qnjz"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments qtsvg)
+       ((#:tests? _ #f) #f))) ; TODO: Enable the tests
     (native-inputs `(("perl" ,perl)))
     (inputs
      `(("mesa" ,mesa)
@@ -620,6 +632,15 @@ developers using C++ or QML, a CSS & JavaScript like language.")
              (sha256
               (base32
                "1rgqnpg64gn5agmvjwy0am8hp5fpxl3cdkixr1yrsdxi5a6961d8"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments qtsvg)
+       ((#:phases phases)
+        `(modify-phases ,phases
+           (add-after 'unpack 'disable-network-tests
+             (lambda _ (substitute* "tests/auto/auto.pro"
+                         (("qxmlquery") "# qxmlquery")
+                         (("xmlpatterns") "# xmlpatterns"))
+               #t))))))
     (native-inputs `(("perl" ,perl)))
     (inputs `(("qtbase" ,qtbase)))))
 
@@ -636,6 +657,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
              (sha256
               (base32
                "0mjxfwnplpx60jc6y94krg00isddl9bfwc7dayl981njb4qds4zx"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments qtsvg)
+       ((#:tests? _ #f) #f))) ; TODO: Enable the tests
     (native-inputs
      `(("perl" ,perl)
        ("pkg-config" ,pkg-config)
@@ -680,6 +704,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
              (sha256
               (base32
                "1laj0slwibs0bg69kgrdhc9k1s6yisq3pcsr0r9rhbkzisv7aajw"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments qtsvg)
+       ((#:tests? _ #f) #f))) ; TODO: Enable the tests
     (native-inputs
      `(("perl" ,perl)
        ("qtdeclarative" ,qtdeclarative)))
@@ -720,7 +747,13 @@ developers using C++ or QML, a CSS & JavaScript like language.")
              (snippet
               '(begin
                  (delete-file-recursively
-                   "examples/multimedia/spectrum/3rdparty")))))
+                   "examples/multimedia/spectrum/3rdparty")
+                 ;; We also prevent the spectrum example from being built.
+                 (substitute* "examples/multimedia/multimedia.pro"
+                   (("spectrum") "#"))))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments qtsvg)
+       ((#:tests? _ #f) #f))) ; TODO: Enable the tests
     (native-inputs
      `(("perl" ,perl)
        ("pkg-config" ,pkg-config)
@@ -781,6 +814,23 @@ developers using C++ or QML, a CSS & JavaScript like language.")
      `(("qtbase" ,qtbase)
        ("eudev" ,eudev)))))
 
+(define-public qtserialbus
+  (package (inherit qtsvg)
+    (name "qtserialbus")
+    (version "5.7.1")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "https://download.qt.io/official_releases/qt/"
+                                 (version-major+minor version) "/" version
+                                 "/submodules/" name "-opensource-src-"
+                                 version ".tar.xz"))
+             (sha256
+              (base32
+               "0mxi43l2inpbar8rmg21qjg33bv3f1ycxjgvzjf12ncnybhdnzkj"))))
+    (inputs
+     `(("qtbase" ,qtbase)
+       ("qtserialport" ,qtserialport)))))
+
 (define-public qtwebchannel
   (package (inherit qtsvg)
     (name "qtwebchannel")
@@ -813,6 +863,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
              (sha256
               (base32
                "17zkzffzwbg6aqhsggs23cmwzq4y45m938842lsc423hfm7fdsgr"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments qtsvg)
+       ((#:tests? _ #f) #f))) ; TODO: Enable the tests
     (native-inputs
      `(("perl" ,perl)
        ("qtdeclarative" ,qtdeclarative)
@@ -833,6 +886,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
              (sha256
               (base32
                "1b6zqa5690b8lqms7rrhb8rcq0xg5hp117v3m08qngbcd0i706b4"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments qtsvg)
+       ((#:tests? _ #f) #f))) ; TODO: Enable the tests
     (native-inputs
      `(("perl" ,perl)
        ("qtdeclarative" ,qtdeclarative)))
@@ -872,6 +928,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
              (sha256
               (base32
                "17cyfyqzjbm9dhq9pjscz36y84y16rmxwk6h826gjfprddrimsvg"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments qtsvg)
+       ((#:tests? _ #f) #f))) ; TODO: Enable the tests
     (inputs
      `(("qtbase" ,qtbase)
        ("qtdeclarative" ,qtdeclarative)))))
@@ -889,6 +948,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
              (sha256
               (base32
                "1v77ydy4k15lksp3bi2kgha2h7m79g4n7c2qhbr09xnvpb8ars7j"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments qtsvg)
+       ((#:tests? _ #f) #f))) ; TODO: Enable the tests
     (inputs
      `(("qtbase" ,qtbase)
        ("qtdeclarative" ,qtdeclarative)))))
@@ -906,6 +968,169 @@ developers using C++ or QML, a CSS & JavaScript like language.")
              (sha256
               (base32
                "1j2drnx7zp3w6cgvy7bn00fyk5v7vw1j1hidaqcg78lzb6zgls1c"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments qtsvg)
+       ((#:tests? _ #f) #f))) ; TODO: Enable the tests
+    (inputs
+     `(("qtbase" ,qtbase)
+       ("qtdeclarative" ,qtdeclarative)))))
+
+(define-public qtdeclarative-render2d
+  (package (inherit qtsvg)
+    (name "qtdeclarative-render2d")
+    (version "5.7.1")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "https://download.qt.io/official_releases/qt/"
+                                 (version-major+minor version) "/" version
+                                 "/submodules/" name "-opensource-src-"
+                                 version ".tar.xz"))
+             (sha256
+              (base32
+               "0zwch9vn17f3bpy300jcfxx6cx9qymk5j7khx0x9k1xqid4166c3"))
+             (modules '((guix build utils)))
+             (snippet
+              '(delete-file-recursively "tools/opengldummy/3rdparty"))))
+    (native-inputs `())
+    (inputs
+     `(("qtbase" ,qtbase)
+       ("qtdeclarative" ,qtdeclarative)))))
+
+(define-public qtgamepad
+  (package (inherit qtsvg)
+    (name "qtgamepad")
+    (version "5.7.1")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "https://download.qt.io/official_releases/qt/"
+                                 (version-major+minor version) "/" version
+                                 "/submodules/" name "-opensource-src-"
+                                 version ".tar.xz"))
+             (sha256
+              (base32
+               "10lijbsg9xx5ddbbjymdgl41nxz99yn1qgiww2kkggxwwdjj2axv"))))
+    (native-inputs
+     `(("perl" ,perl)
+       ("pkg-config" ,pkg-config)))
+    (inputs
+     `(("fontconfig" ,fontconfig)
+       ("freetype" ,freetype)
+       ("libxrender" ,libxrender)
+       ("sdl2" ,sdl2)
+       ("qtbase" ,qtbase)
+       ("qtdeclarative" ,qtdeclarative)))))
+
+(define-public qtscxml
+  (package (inherit qtsvg)
+    (name "qtscxml")
+    (version "5.7.1")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "https://download.qt.io/official_releases/qt/"
+                                 (version-major+minor version) "/" version
+                                 "/submodules/" name "-opensource-src-"
+                                 version ".tar.xz"))
+             (sha256
+              (base32
+               "135kknqdmib2cjryfmvfgv7a2qx9pyba3m7i7nkbc5d742r4mbcx"))
+             (modules '((guix build utils)))
+             (snippet
+              '(begin
+                 (delete-file-recursively "tests/3rdparty")
+                 ;; the scion test refers to the bundled 3rd party test code.
+                 (substitute* "tests/auto/auto.pro"
+                   (("scion") "#"))))))
+    (inputs
+     `(("qtbase" ,qtbase)
+       ("qtdeclarative" ,qtdeclarative)))))
+
+(define-public qtpurchasing
+  (package (inherit qtsvg)
+    (name "qtpurchasing")
+    (version "5.7.1")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "https://download.qt.io/official_releases/qt/"
+                                 (version-major+minor version) "/" version
+                                 "/submodules/" name "-opensource-src-"
+                                 version ".tar.xz"))
+             (sha256
+              (base32
+               "0hkvrgafz1hx9q4yc3nskv3pd3fszghvvd5a7mj33ynf55wpb57n"))))
+    (inputs
+     `(("qtbase" ,qtbase)
+       ("qtdeclarative" ,qtdeclarative)))))
+
+(define-public qtcanvas3d
+  (package (inherit qtsvg)
+    (name "qtcanvas3d")
+    (version "5.7.1")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "https://download.qt.io/official_releases/qt/"
+                                 (version-major+minor version) "/" version
+                                 "/submodules/" name "-opensource-src-"
+                                 version ".tar.xz"))
+             (sha256
+              (base32
+               "1d5xpq3mhjg4ipxzap7s2vnlfcd02d3yq720npv10xxp2ww0i1x8"))
+             (modules '((guix build utils)))
+             (snippet
+              '(delete-file-recursively "examples/canvas3d/3rdparty"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments qtsvg)
+      ;; Building the tests depends on the bundled 3rd party javascript files,
+      ;; and the test phase fails to import QtCanvas3D, causing the phase to
+      ;; fail, so we skip building them for now.
+      ((#:phases phases)
+       `(modify-phases ,phases
+         (replace 'configure
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (zero? (system* "qmake" "QT_BUILD_PARTS = libs tools"
+                               (string-append "PREFIX=" out))))))))
+       ((#:tests? _ #f) #f))) ; TODO: Enable the tests
+    (native-inputs `())
+    (inputs
+     `(("qtbase" ,qtbase)
+       ("qtdeclarative" ,qtdeclarative)))))
+
+(define-public qtcharts
+  (package (inherit qtsvg)
+    (name "qtcharts")
+    (version "5.7.1")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "https://download.qt.io/official_releases/qt/"
+                                 (version-major+minor version) "/" version
+                                 "/submodules/" name "-opensource-src-"
+                                 version ".tar.xz"))
+             (sha256
+              (base32
+               "1qrzcddwff2hxsbxrraff16j4abah2zkra2756s1mvydj9lyxzl5"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments qtsvg)
+       ((#:tests? _ #f) #f))) ; TODO: Enable the tests
+    (inputs
+     `(("qtbase" ,qtbase)
+       ("qtdeclarative" ,qtdeclarative)))))
+
+(define-public qtdatavis3d
+  (package (inherit qtsvg)
+    (name "qtdatavis3d")
+    (version "5.7.1")
+    (source (origin
+             (method url-fetch)
+             (uri (string-append "https://download.qt.io/official_releases/qt/"
+                                 (version-major+minor version) "/" version
+                                 "/submodules/" name "-opensource-src-"
+                                 version ".tar.xz"))
+             (sha256
+              (base32
+               "1y00p0wyj5cw9c2925y537vpmmg9q3kpf7qr1s7sv67dvvf8bzqv"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments qtsvg)
+       ((#:tests? _ #f) #f))) ; TODO: Enable the tests
     (inputs
      `(("qtbase" ,qtbase)
        ("qtdeclarative" ,qtdeclarative)))))

gnu/packages/shells.scm

@@ -299,14 +299,14 @@ ksh, and tcsh.")
 (define-public xonsh
   (package
     (name "xonsh")
-    (version "0.5.1")
+    (version "0.5.2")
     (source
       (origin
         (method url-fetch)
         (uri (pypi-uri "xonsh" version))
         (sha256
           (base32
-            "1a3jkvfh1xc6aw557y8zjn498q89bapyx4dxc3md7qwrmnj9pkv3"))
+            "13ndyq9cal2j93qqbjyp2jn3cshiavdxsaj2qjzm6mas0gzywmf0"))
         (modules '((guix build utils)))
         (snippet
          `(begin

gnu/packages/statistics.scm

@@ -3954,6 +3954,31 @@ such that the arrangement of points within a category reflects the density of
 data at that region, and avoids over-plotting.")
     (license license:gpl2+)))
 
+(define-public r-ggthemes
+  (package
+    (name "r-ggthemes")
+    (version "3.3.0")
+    (source (origin
+              (method url-fetch)
+              (uri (cran-uri "ggthemes" version))
+              (sha256
+               (base32
+                "1qdxg2siwsiq32fmgcxn4vihgxad9v8q0aqigl7a94c26bwxs7y2"))))
+    (build-system r-build-system)
+    (propagated-inputs
+     `(("r-assertthat" ,r-assertthat)
+       ("r-colorspace" ,r-colorspace)
+       ("r-ggplot2" ,r-ggplot2)
+       ("r-scales" ,r-scales)))
+    (home-page "https://cran.rstudio.com/web/packages/ggthemes")
+    (synopsis "Extra themes, scales and geoms for @code{ggplot2}")
+    (description "This package provides extra themes and scales for
+@code{ggplot2} that replicate the look of plots by Edward Tufte and
+Stephen Few in Fivethirtyeight, The Economist, Stata, Excel, and The
+Wall Street Journal, among others.  This package also provides
+@code{geoms} for Tufte's box plot and range frame.")
+    (license license:gpl2)))
+
 (define-public r-statmod
   (package
     (name "r-statmod")

gnu/packages/suckless.scm

@@ -2,7 +2,7 @@
 ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2015 Amirouche Boubekki <amirouche@hypermove.net>
 ;;; Copyright © 2016 Al McElrath <hello@yrns.org>
-;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
+;;; Copyright © 2016, 2017 ng0 <ng0@libertad.pw>
 ;;; Copyright © 2015 Dmitry Bogatov <KAction@gnu.org>
 ;;; Copyright © 2015 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
@@ -27,6 +27,7 @@
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix packages)
   #:use-module (guix download)
+  #:use-module (guix git-download)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system glib-or-gtk)
   #:use-module (gnu packages)
@@ -36,7 +37,15 @@
   #:use-module (gnu packages fonts)
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages webkit)
-  #:use-module (gnu packages fontutils))
+  #:use-module (gnu packages fontutils)
+  #:use-module (gnu packages mpd)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages compression)
+  #:use-module (gnu packages cups)
+  #:use-module (gnu packages ncurses)
+  #:use-module (gnu packages gawk)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages libbsd))
 
 (define-public dwm
   (package
@@ -114,6 +123,34 @@ optimising the environment for the application in use and the task performed.")
 numbers of user-defined menu items efficiently.")
     (license license:x11)))
 
+(define-public spoon
+  (package
+    (name "spoon")
+    (version "0.3")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "http://dl.2f30.org/releases/"
+                           name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "10c5i7ykpy7inzzfiw1dh0srpkljycr3blxhvd8160wsvplbws48"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f ; No tests
+       #:make-flags (list "CC=gcc"
+                          (string-append "PREFIX=" %output))))
+    (inputs
+     `(("libx11" ,libx11)
+       ("libxkbfile" ,libxkbfile)
+       ("alsa-lib" ,alsa-lib)
+       ("libmpdclient" ,libmpdclient)))
+    (home-page "http://git.2f30.org/spoon/")
+    (synopsis "Set dwm status")
+    (description
+     "Spoon can be used to set the dwm status.")
+    (license license:isc)))
+
 (define-public slock
   (package
     (name "slock")
@@ -257,3 +294,382 @@ allows you to write down the presentation for a quick lightning talk within a
 few minutes.")
     (home-page "http://tools.suckless.org/sent")
     (license license:x11)))
+
+(define-public xbattmon
+  (package
+    (name "xbattmon")
+    (version "0.9")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "http://dl.2f30.org/releases/"
+                           name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0n2rrjq03pgqrdkl7cz5snsfdanf4s58w9h6dbvnl7p8bbd3j2kn"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f ; No tests
+       #:make-flags (list "CC=gcc"
+                          (string-append "PREFIX=" %output))))
+    (inputs
+     `(("libx11" ,libx11)))
+    (home-page "http://git.2f30.org/xbattmon/")
+    (synopsis "Simple battery monitor for X")
+    (description
+     "Xbattmon is a simple battery monitor for X.")
+    (license license:isc)))
+
+(define-public wificurse
+  (package
+    (name "wificurse")
+    (version "0.3.9")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "http://dl.2f30.org/releases/"
+                           name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "067ghr1xly5ca41kc83xila1p5hpq0bxfcmc8jvxi2ggm6wrhavn"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f ; No tests
+       #:make-flags (list
+                     (string-append "PREFIX=" %output))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)))) ; No configure script
+    (home-page "http://git.2f30.org/wificurse/")
+    (synopsis "Wifi DoS attack tool")
+    (description
+     "Wificurses listens for beacons sent from wireless access points
+in the range of your wireless station.  Once received the program
+extracts the BSSID of the AP and transmits deauthentication packets
+using the broadcast MAC address.  This results to the disconnection
+of all clients connected to the AP at the time of the attack.  This
+is essencially a WiFi DoS attack tool created for educational
+purposes only.  It works only in Linux and requires wireless card
+drivers capable of injecting packets in wireless networks.")
+    (license license:gpl3+)))
+
+(define-public skroll
+  (package
+    (name "skroll")
+    (version "0.6")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "http://dl.2f30.org/releases/"
+                           name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0km6bjfz4ssb1z0xwld6iiixnn7d255ax8yjs3zkdm42z8q9yl0f"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f ; No tests
+       #:make-flags (list "CC=gcc"
+                          (string-append "PREFIX=" %output))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)))) ; No configure script
+    (home-page "http://2f30.org")
+    (synopsis "Commandline utility which scrolls text")
+    (description
+     "Skroll is a small utility that you can use to make a text scroll.
+Pipe text to it, and it will scroll a given number of letters from right to
+left.")
+    (license license:wtfpl2)))
+
+(define-public sbm
+  (package
+    (name "sbm")
+    (version "0.9")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "http://dl.2f30.org/releases/"
+                           name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "1nks5mkh5wn30kyjzlkjlgi31bv1wq52kbp0r6nzbyfnvfdlywik"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f ; No tests
+       #:make-flags (list "CC=gcc"
+                          (string-append "PREFIX=" %output))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)))) ; No configure script
+    (home-page "http://git.2f30.org/sbm/")
+    (synopsis "Simple bandwidth monitor")
+    (description
+     "Sbm is a simple bandwidth monitor.")
+    (license license:isc)))
+
+(define-public prout
+  (package
+    (name "prout")
+    (version "0.2")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "http://dl.2f30.org/releases/"
+                           name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "1s6c3ygg1h1fyxkh8gd7nzjk6qhnwsb4535d2k780kxnwns5fzas"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f ; No tests
+       #:make-flags (list "CC=gcc"
+                          (string-append "PREFIX=" %output))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)))) ; No configure script
+    (inputs
+     `(("cups-minimal" ,cups-minimal)
+       ("zlib" ,zlib)))
+    (home-page "http://git.2f30.org/prout/")
+    (synopsis "Smaller lp command")
+    (description
+     "Prout (PRint OUT) is a small utility one can use to send
+documents to a printer.
+It has no feature, and does nothing else.  Just set your default
+printer in client.conf(5) and start printing.  No need for a local
+cups server to be installed.")
+    (license license:wtfpl2)))
+
+(define-public noice
+  (package
+    (name "noice")
+    (version "0.6")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "http://dl.2f30.org/releases/"
+                           name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0ldkbb71z6k4yzj4kpg3s94ijj1c1kx9dfcjz393py09scfyg5hr"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f ; No tests
+       #:make-flags (list "CC=gcc"
+                          (string-append "PREFIX=" %output))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure) ; No configure script
+         (add-before 'build 'curses
+           (lambda _
+             (substitute* "Makefile"
+               (("lcurses") "lncurses")))))))
+    (inputs
+     `(("ncurses" ,ncurses)))
+    (home-page "http://git.2f30.org/noice/")
+    (synopsis "Small file browser")
+    (description
+     "Noice is a small curses-based file browser.")
+    (license license:bsd-2)))
+
+;;; We want some commits that are more recent than the latest release, 0.2
+(define-public human
+  (let ((commit "50c80e6ba12823184b6866e06b955dbd2ccdc5d7")
+        (revision "1"))
+    (package
+      (name "human")
+      (version (string-append "0.2-" revision "." (string-take commit 7)))
+      (source
+       (origin
+         (method git-fetch)
+         (uri (git-reference
+               (url "git://git.2f30.org/human.git")
+               (commit commit)))
+         (file-name (string-append name "-" version "-checkout"))
+         (sha256
+          (base32
+           "18xngm4h9vsyip52zwd79rrp1irzg6rs462lpbp61amf7hj955gn"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f ; No tests
+       #:make-flags (list "CC=gcc"
+                          (string-append "PREFIX=" %output))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)))) ; No configure script
+    (home-page "http://git.2f30.org/human/")
+    (synopsis "Convert bytes to human readable formats")
+    (description
+     "Human is a small program which translate numbers into a
+human readable format.  By default, it tries to detect the best
+factorisation, but you can force its output.
+You can adjust the number of decimals with the @code{SCALE}
+environment variable.")
+    (license license:wtfpl2))))
+
+(define-public fortify-headers
+  (package
+    (name "fortify-headers")
+    (version "0.8")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "http://dl.2f30.org/releases/"
+                           name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "1cacdczpjb49c4i1168g541wnl3i3gbpv2m2wbnmw5wddlyhgkdg"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f ; No tests
+       #:make-flags (list "CC=gcc"
+                          (string-append "PREFIX=" %output))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)))) ; No configure script
+    (home-page "http://git.2f30.org/fortify-headers/")
+    (synopsis "Standalone fortify-source implementation")
+    (description
+     "This is a standalone implementation of fortify source.  It provides
+compile time buffer checks.  It is libc-agnostic and simply overlays the
+system headers by using the @code{#include_next} extension found in GCC.  It was
+initially intended to be used on musl based Linux distributions.
+
+@itemize
+@item It is portable, works on *BSD, Linux, Solaris and possibly others.
+@item It will only trap non-conformant programs.  This means that fortify
+  level 2 is treated in the same way as level 1.
+@item Avoids making function calls when undefined behaviour has already been
+  invoked.  This is handled by using __builtin_trap().
+@item Support for out-of-bounds read interfaces, such as send(), write(),
+  fwrite() etc.
+@item No ABI is enforced.  All of the fortify check functions are inlined
+  into the resulting binary.
+@end itemize\n")
+    (license license:isc)))
+
+(define-public colors
+  (package
+    (name "colors")
+    (version "0.3")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "http://dl.2f30.org/releases/"
+                           name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "1lckmqpgj89841splng0sszbls2ag71ggkgr1wsv9y3v6y87589z"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f ; No tests
+       #:make-flags (list "CC=gcc"
+                          (string-append "PREFIX=" %output))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)))) ; No configure script
+    (inputs
+     `(("libpng" ,libpng)))
+    (home-page "http://git.2f30.org/colors/")
+    (synopsis "Extract colors from pictures")
+    (description
+     "Extract colors from PNG files.  It is similar to
+strings(1) but for pictures.  For a given input file it outputs a
+colormap to stdout.")
+    (license license:isc)))
+
+;; No new releases were made at github, this repository is more active than
+;; the one at http://git.suckless.org/libutf/ and it is
+;; done by the same developer.
+(define-public libutf
+  (let ((revision "1")
+        (commit "ff4c60635e1f455b0a0b4200f8183fbd5a88225b"))
+    (package
+      (name "libutf")
+      (version (string-append "0.0.0-" revision "." (string-take commit 7)))
+      (source
+       (origin
+         (method git-fetch)
+         (uri (git-reference
+               (url "https://github.com/cls/libutf")
+               (commit commit)))
+         (file-name (string-append name "-" version "-checkout"))
+         (sha256
+          (base32
+           "1ih5vjavilzggyr1j1z6w1z12c2fs5fg77cfnv7ami5ivsy3kg3d"))))
+      (build-system gnu-build-system)
+      (arguments
+       `(#:tests? #f ; No tests
+         #:make-flags (list "CC=gcc"
+                            (string-append "PREFIX=" %output))
+         #:phases
+         (modify-phases %standard-phases
+           (delete 'configure)))) ; No configure script
+      (inputs
+       `(("gawk" ,gawk)))
+      (home-page "https://github.com/cls/libutf")
+      (synopsis "Plan 9 compatible UTF-8 library")
+      (description
+       "This is a C89 UTF-8 library, with an API compatible with that of
+Plan 9's libutf, but with a number of improvements:
+
+@itemize
+@item Support for runes beyond the Basic Multilingual Plane.
+@item utflen and utfnlen cannot overflow on 32- or 64-bit machines.
+@item chartorune treats all invalid codepoints as though Runeerror.
+@item fullrune, utfecpy, and utfnlen do not overestimate the length
+of malformed runes.
+@item An extra function, charntorune(p,s,n), equivalent to
+fullrune(s,n) ? chartorune(p,s): 0.
+@item Runeerror may be set to an alternative replacement value, such
+as -1, to be used instead of U+FFFD.
+@end itemize\n")
+      (license license:expat))))
+
+;; No release tarballs so far.
+(define-public lchat
+  (let ((revision "1")
+        (commit "bbde23732f8c7769b982f0c1bda9b99fbf93f932"))
+    (package
+      (name "lchat")
+      (version (string-append "0.0.0-" revision "." (string-take commit 7)))
+      (source
+       (origin
+         (method git-fetch)
+         (uri (git-reference
+               (url "https://github.com/younix/lchat")
+               (commit commit)))
+         (file-name (string-append name "-" version "-checkout"))
+         (sha256
+          (base32
+           "00q3rc0aa5416jvjvrj71x1wnr0331kxhvjjs7pyxgnq4xf36k63"))))
+      (build-system gnu-build-system)
+      (arguments
+       `(#:tests? #f ; No tests
+         #:make-flags (list "CC=gcc"
+                            (string-append "PREFIX=" %output))
+         #:phases
+         (modify-phases %standard-phases
+           (delete 'configure) ; No configure script
+           (add-before 'build 'libbsd
+             (lambda _
+               (substitute* "Makefile"
+                 (("-lutf") "-lutf -lbsd"))))
+           (replace 'install
+             (lambda* (#:key outputs #:allow-other-keys)
+               (let* ((out (assoc-ref outputs "out"))
+                      (bin (string-append out "/bin")))
+                 (install-file "lchat" bin)
+                 #t))))))
+      (inputs
+       `(("grep" ,grep)
+         ("ncurses" ,ncurses)
+         ("libutf" ,libutf)
+         ("libbsd" ,libbsd)))
+      (home-page "https://github.com/younix/lchat")
+      (synopsis "Line chat is a frontend for the irc client ii from suckless")
+      (description
+       "Lchat (line chat) is the little and small brother of cii.
+It is a front end for ii-like chat programs.  It uses tail(1) -f to get the
+chat output in background.")
+      (license license:isc))))

gnu/packages/upnp.scm

@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
-;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2016, 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,15 +28,14 @@
 (define-public miniupnpc
   (package
     (name "miniupnpc")
-    (version "2.0")
+    (version "2.0.20161216")
     (source
      (origin
        (method url-fetch)
-       (uri (string-append
+       (uri (string-append "https://miniupnp.tuxfamily.org/files/"
-             "http://miniupnp.tuxfamily.org/files/miniupnpc-"
+                           name "-" version ".tar.gz"))
-             version ".tar.gz"))
        (sha256
-        (base32 "0fzrc6fs8vzb2yvk01bd3q5jkarysl7gjlyaqncy3yvfk2wcwd6l"))))
+        (base32 "0gpxva9jkjvqwawff5y51r6bmsmdhixl3i5bmzlqsqpwsq449q81"))))
     (build-system gnu-build-system)
     (native-inputs
      `(("python" ,python-2)))

gnu/packages/vpn.scm

@@ -5,6 +5,7 @@
 ;;; Copyright © 2015 Jeff Mickey <j@codemac.net>
 ;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -152,7 +153,7 @@ and probably others.")
 (define-public openvpn
   (package
     (name "openvpn")
-    (version "2.3.14")
+    (version "2.4.0")
     (source (origin
               (method url-fetch)
               (uri (string-append
@@ -160,7 +161,7 @@ and probably others.")
                     version ".tar.xz"))
               (sha256
                (base32
-                "167frlmmg2raffn9h7ww3agdwgfdl0wa5wm9fsgl0i6mz3md187k"))))
+                "0zpqnbhjaifdalyxwmvk5kcyd7cpxbcigbn7967nbsyvl54vl8vg"))))
     (build-system gnu-build-system)
     (arguments
      '(#:configure-flags '("--enable-iproute2=yes")))

gnu/packages/xfig.scm

@@ -34,12 +34,12 @@
     (version "3.2.5c")
     (source
      (origin
-      (method url-fetch)
+       (method url-fetch)
-      (uri (string-append "mirror://sourceforge/mcj/mcj-source/xfig."
+       (uri (string-append "mirror://sourceforge/mcj/mcj-source/xfig."
-                          version ".full.tar.gz"))
+                           version ".full.tar.gz"))
-      (sha256
+       (sha256
-       (base32
+        (base32
-        "1yd1jclvw5w3ja4jjzr1ysbn8iklh88wq84jn9d1gavrbfbqyqpa"))))
+         "1yd1jclvw5w3ja4jjzr1ysbn8iklh88wq84jn9d1gavrbfbqyqpa"))))
     (build-system gnu-build-system)
     (native-inputs
      `(("imake" ,imake)
@@ -59,51 +59,54 @@
     (arguments
      `(#:tests? #f
        #:phases
-       (alist-replace
+       (modify-phases %standard-phases
-        'configure
+         (replace 'configure
-        (lambda* (#:key inputs outputs #:allow-other-keys)
+                  (lambda* (#:key inputs outputs #:allow-other-keys)
-          (let ((imake (assoc-ref inputs "imake"))
+                    (let ((imake (assoc-ref inputs "imake"))
-                (out   (assoc-ref outputs "out")))
+                          (out   (assoc-ref outputs "out")))
-           (substitute* "Imakefile"
+                      (substitute* "Imakefile"
-             (("XCOMM (BINDIR = )[[:graph:]]*" _ front)
+                        (("XCOMM XAPPLOADDIR = /home/user/xfig *")
-              (string-append front out "/bin"))
+                         (string-append "XAPPLOADDIR = " out ,%app-defaults-dir))
-             (("(PNGLIBDIR = )[[:graph:]]*" _ front)
+                        (("XCOMM (BINDIR = )[[:graph:]]*" _ front)
-              (string-append front (assoc-ref inputs "libpng") "/lib"))
+                         (string-append front out "/bin"))
-             (("(PNGINC = -I)[[:graph:]]*" _ front)
+                        (("(PNGLIBDIR = )[[:graph:]]*" _ front)
-              (string-append front (assoc-ref inputs "libpng") "/include"))
+                         (string-append front (assoc-ref inputs "libpng") "/lib"))
-             (("(JPEGLIBDIR = )[[:graph:]]*" _ front)
+                        (("(PNGINC = -I)[[:graph:]]*" _ front)
-              (string-append front (assoc-ref inputs "libjpeg") "/lib"))
+                         (string-append front (assoc-ref inputs "libpng") "/include"))
-             (("(JPEGINC = -I)[[:graph:]]*" _ front)
+                        (("(JPEGLIBDIR = )[[:graph:]]*" _ front)
-              (string-append front (assoc-ref inputs "libjpeg") "/include"))
+                         (string-append front (assoc-ref inputs "libjpeg") "/lib"))
-             (("(ZLIBDIR = )[[:graph:]]*" _ front)
+                        (("(JPEGINC = -I)[[:graph:]]*" _ front)
-              (string-append front (assoc-ref inputs "zlib") "/lib"))
+                         (string-append front (assoc-ref inputs "libjpeg") "/include"))
-             (("(XPMLIBDIR = )[[:graph:]]*" _ front)
+                        (("(ZLIBDIR = )[[:graph:]]*" _ front)
-              (string-append front (assoc-ref inputs "libxpm") "/lib"))
+                         (string-append front (assoc-ref inputs "zlib") "/lib"))
-             (("(XPMINC = -I)[[:graph:]]*" _ front)
+                        (("(XPMLIBDIR = )[[:graph:]]*" _ front)
-              (string-append front (assoc-ref inputs "libxpm") "/include"))
+                         (string-append front (assoc-ref inputs "libxpm") "/lib"))
-             (("(XFIGLIBDIR = )[[:graph:]]*" _ front)
+                        (("(XPMINC = -I)[[:graph:]]*" _ front)
-              (string-append front out "/lib"))
+                         (string-append front (assoc-ref inputs "libxpm") "/include"))
-             (("(XFIGDOCDIR = )[[:graph:]]*" _ front)
+                        (("(XFIGLIBDIR = )[[:graph:]]*" _ front)
-              (string-append front out "/share/doc"))
+                         (string-append front out "/lib"))
-             (("XCOMM USEINLINE") "USEINLINE"))
+                        (("(XFIGDOCDIR = )[[:graph:]]*" _ front)
-           ;; The -a argument is required in order to pick up the correct paths
+                         (string-append front out "/share/doc"))
-           ;; to several X header files.
+                        (("XCOMM USEINLINE") "USEINLINE"))
-           (zero? (system* "xmkmf" "-a"))
+                      ;; The -a argument is required in order to pick up the correct paths
-           ;; Reset some variables that are inherited from imake templates
+                      ;; to several X header files.
-           (substitute* "Makefile"
+                      (zero? (system* "xmkmf" "-a"))
-             ;; These imake variables somehow remain undefined
+                      ;; Reset some variables that are inherited from imake templates
-             (("DefaultGcc2[[:graph:]]*Opt") "-O2")
+                      (substitute* "Makefile"
-             ;; Reset a few variable defaults that are set in imake templates
+                        ;; These imake variables somehow remain undefined
-             ((imake) out)
+                        (("DefaultGcc2[[:graph:]]*Opt") "-O2")
-             (("(MANPATH = )[[:graph:]]*" _ front)
+                        ;; Reset a few variable defaults that are set in imake templates
-              (string-append front out "/share/man"))
+                        ((imake) out)
-             (("(CONFDIR = )([[:graph:]]*)" _ front default)
+                        (("(MANPATH = )[[:graph:]]*" _ front)
-              (string-append front out default)))))
+                         (string-append front out "/share/man"))
-        (alist-cons-after
+                        (("(CONFDIR = )([[:graph:]]*)" _ front default)
-         'install 'install/libs
+                         (string-append front out default))))
-         (lambda _
+                    #t))
-           (zero? (system* "make" "install.libs")))
+         (add-after
-         (alist-cons-after
+          'install 'install/libs
+          (lambda _
+            (zero? (system* "make" "install.libs"))))
+         (add-after
           'install 'install/doc
           (lambda _
             (begin
@@ -118,15 +121,7 @@
                   (dump-port in out)
                   (close-pipe in)
                   (close-port out)))
-              (zero? (system* "make" "install.doc"))))
+              (zero? (system* "make" "install.doc"))))))))
-          (alist-cons-after
-           'install 'wrap-xfig
-           (lambda* (#:key outputs #:allow-other-keys)
-             (let ((out (assoc-ref outputs "out")))
-               (wrap-program (string-append out "/bin/xfig")
-                             `("XAPPLRESDIR" suffix
-                               (,(string-append out "/etc/X11/app-defaults"))))))
-           %standard-phases))))))
     (home-page "http://xfig.org/")
     (synopsis "Interactive drawing tool")
     (description
@@ -144,12 +139,12 @@ selected in various ways.  For text, 35 fonts are available.")
     (version "3.2.5e")
     (source
      (origin
-      (method url-fetch)
+       (method url-fetch)
-      (uri (string-append "mirror://sourceforge/mcj/mcj-source/transfig."
+       (uri (string-append "mirror://sourceforge/mcj/mcj-source/transfig."
-                          version ".tar.gz"))
+                           version ".tar.gz"))
-      (sha256
+       (sha256
-       (base32
+        (base32
-        "0i3p7qmg2w8qrad3pn42b0miwarql7yy0gpd49b1bpal6bqsiicf"))))
+         "0i3p7qmg2w8qrad3pn42b0miwarql7yy0gpd49b1bpal6bqsiicf"))))
     (build-system gnu-build-system)
     (native-inputs
      `(("imake" ,imake)
@@ -183,20 +178,20 @@ selected in various ways.  For text, 35 fonts are available.")
               (("(XPMINC = -I)[[:graph:]]*" _ front)
                (string-append front (assoc-ref inputs "libxpm") "/include/X11"))
               (("/usr/local/lib/fig2dev") (string-append out "/lib")))
-           ;; The -a argument is required in order to pick up the correct paths
+            ;; The -a argument is required in order to pick up the correct paths
-           ;; to several X header files.
+            ;; to several X header files.
-           (zero? (system* "xmkmf" "-a"))
+            (zero? (system* "xmkmf" "-a"))
-           (substitute* '("Makefile"
+            (substitute* '("Makefile"
-                          "fig2dev/Makefile"
+                           "fig2dev/Makefile"
-                          "transfig/Makefile")
+                           "transfig/Makefile")
-             ;; These imake variables somehow remain undefined
+              ;; These imake variables somehow remain undefined
-             (("DefaultGcc2[[:graph:]]*Opt") "-O2")
+              (("DefaultGcc2[[:graph:]]*Opt") "-O2")
-             ;; Reset a few variable defaults that are set in imake templates
+              ;; Reset a few variable defaults that are set in imake templates
-             ((imake) out)
+              ((imake) out)
-             (("(MANPATH = )[[:graph:]]*" _ front)
+              (("(MANPATH = )[[:graph:]]*" _ front)
-              (string-append front out "/share/man"))
+               (string-append front out "/share/man"))
-             (("(CONFDIR = )([[:graph:]]*)" _ front default)
+              (("(CONFDIR = )([[:graph:]]*)" _ front default)
-              (string-append front out default)))))
+               (string-append front out default)))))
         (alist-cons-after
          'install 'install/doc
          (lambda _

gnu/packages/xorg.scm

@@ -10,7 +10,7 @@
 ;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
-;;; Copyright © 2016 John Darrington <jmd@gnu.org>
+;;; Copyright © 2016, 2017 John Darrington <jmd@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -335,6 +335,7 @@ provided.")
     (license (license:x11-style "file://dri3proto.h"
                                 "See 'dri3proto.h' in the distribution."))))
 
+(define-public %app-defaults-dir "/lib/X11/app-defaults")
 
 (define-public editres
   (package
@@ -354,7 +355,7 @@ provided.")
     (arguments
      `(#:configure-flags
        (list (string-append "--with-appdefaultdir="
-                            %output "/lib/X11/app-defaults"))))
+                            %output ,%app-defaults-dir))))
     (inputs
      `(("libxaw" ,libxaw)
        ("libxmu" ,libxmu)
@@ -3982,23 +3983,9 @@ protocol.")
                 "1grir464hy52a71r3mpm9mzvkf7nwr3vk0b1vc27pd3gp588a38p"))))
     (build-system gnu-build-system)
     (arguments
-     ;; By default, it tries to install XFontSel file in
+     `(#:configure-flags
-     ;; "/gnu/store/<libxt>/share/X11/app-defaults": it defines this
+       (list (string-append "--with-appdefaultdir="
-     ;; directory from 'libxt' (using 'pkg-config').  To put this file
+                            %output ,%app-defaults-dir))))
-     ;; inside output dir and to use it properly, we need to configure
-     ;; --with-appdefaultdir and to wrap 'xfontsel' binary.
-     (let ((app-defaults-dir "/share/X11/app-defaults"))
-       `(#:configure-flags
-         (list (string-append "--with-appdefaultdir="
-                              %output ,app-defaults-dir))
-         #:phases
-         (modify-phases %standard-phases
-           (add-after 'install 'wrap-xfontsel
-             (lambda* (#:key outputs #:allow-other-keys)
-               (let ((out (assoc-ref outputs "out")))
-                 (wrap-program (string-append out "/bin/xfontsel")
-                   `("XAPPLRESDIR" =
-                     (,(string-append out ,app-defaults-dir)))))))))))
     (inputs
      `(("libx11" ,libx11)
        ("libxaw" ,libxaw)
@@ -4028,19 +4015,9 @@ Font Description (XLFD) full name for a font.")
                 "0n97iqqap9wyxjan2n520vh4rrf5bc0apsw2k9py94dqzci258y1"))))
     (build-system gnu-build-system)
     (arguments
-     ;; The same 'app-defaults' problem as with 'xfontsel' package.
-     (let ((app-defaults-dir "/share/X11/app-defaults"))
        `(#:configure-flags
          (list (string-append "--with-appdefaultdir="
-                              %output ,app-defaults-dir))
+                              %output ,%app-defaults-dir))))
-         #:phases
-         (modify-phases %standard-phases
-           (add-after 'install 'wrap-xfd
-             (lambda* (#:key outputs #:allow-other-keys)
-               (let ((out (assoc-ref outputs "out")))
-                 (wrap-program (string-append out "/bin/xfd")
-                   `("XAPPLRESDIR" =
-                     (,(string-append out ,app-defaults-dir)))))))))))
     (inputs
      `(("fontconfig" ,fontconfig)
        ("libx11" ,libx11)
@@ -5358,6 +5335,36 @@ draggable titlebars and borders.")
 Intrinsics (Xt) Library.")
     (license license:x11)))
 
+(define-public twm
+  (package
+    (name "twm")
+    (version "1.0.9")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append
+             "mirror://xorg/individual/app/" name "-"
+             version
+             ".tar.gz"))
+       (sha256
+        (base32
+         "1s1r00x8add3f27xjqxg6q7mwplwrb72gakbh4y6j052as25wchw"))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("libxt" ,libxt)
+       ("libxmu" ,libxmu)
+       ("libxext" ,libxext)
+       ("xproto" ,xproto)))
+    (native-inputs
+     `(("bison" ,bison)
+       ("pkg-config" ,pkg-config)))
+    (home-page "https://www.x.org/wiki/")
+    (synopsis "Tab Window Manager for the X Window System")
+    (description "Twm is a window manager for the X Window System.
+It provides titlebars, shaped windows, several forms of icon management,
+user-defined macro functions, click-to-type and pointer-driven
+keyboard focus, and user-specified key and pointer button bindings.")
+    (license license:x11)))
 
 (define-public xcb-util
   (package
@@ -5617,6 +5624,66 @@ user-friendly mechanism to start the X server.")
 Intrinsics (Xt) Library.")
     (license license:x11)))
 
+(define-public xmag
+  (package
+    (name "xmag")
+    (version "1.0.6")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append
+             "mirror://xorg/individual/app/" name "-"
+             version
+             ".tar.gz"))
+       (sha256
+        (base32
+         "19bsg5ykal458d52v0rvdx49v54vwxwqg8q36fdcsv9p2j8yri87"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:configure-flags
+       (list (string-append "--with-appdefaultdir="
+                            %output ,%app-defaults-dir))))
+    (inputs
+     `(("libxaw" ,libxaw)))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (home-page "https://www.x.org/wiki/")
+    (synopsis "Display or capture a magnified part of a X11 screen")
+    (description "Xmag displays and captures a magnified snapshot of a portion
+of an X11 screen.")
+    (license license:x11)))
+
+(define-public xmessage
+  (package
+    (name "xmessage")
+    (version "1.0.4")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append
+             "mirror://xorg/individual/app/" name "-"
+             version
+             ".tar.gz"))
+       (sha256
+        (base32
+         "1jmcac1xbwplbxfl75sr6w3zqhx1khpdzlqippjsr31cjp1rjc48"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:configure-flags
+       (list (string-append "--with-appdefaultdir="
+                            %output ,%app-defaults-dir))))
+    (inputs
+     `(("libxaw" ,libxaw)))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (home-page "https://www.x.org/wiki/")
+    (synopsis "Displays a message or query in a window")
+    (description
+     "Xmessage displays a message or query in a window.   The user can click
+on a button to dismiss it or can select one of several buttons
+to answer a question.  Xmessage can also exit after a specified time.")
+    (license license:x11)))
+
 (define-public xterm
   (package
     (name "xterm")

gnu/services/databases.scm

@@ -2,6 +2,7 @@
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -35,7 +36,11 @@
             mysql-service
             mysql-service-type
             mysql-configuration
-            mysql-configuration?))
+            mysql-configuration?
+
+            redis-configuration
+            redis-configuration?
+            redis-service-type))
 
 ;;; Commentary:
 ;;;
@@ -287,3 +292,77 @@ database server.
 The optional @var{config} argument specifies the configuration for
 @command{mysqld}, which should be a @code{<mysql-configuration>} object."
   (service mysql-service-type config))
+
+
+;;;
+;;; Redis
+;;;
+
+(define-record-type* <redis-configuration>
+  redis-configuration make-redis-configuration
+  redis-configuration?
+  (redis             redis-configuration-redis ;<package>
+                     (default redis))
+  (bind              redis-configuration-bind
+                     (default "127.0.0.1"))
+  (port              redis-configuration-port
+                     (default 6379))
+  (working-directory redis-configuration-working-directory
+                     (default "/var/lib/redis"))
+  (config-file       redis-configuration-config-file
+                     (default #f)))
+
+(define (default-redis.conf bind port working-directory)
+  (mixed-text-file "redis.conf"
+                   "bind " bind "\n"
+                   "port " (number->string port) "\n"
+                   "dir " working-directory "\n"
+                   "daemonize no\n"))
+
+(define %redis-accounts
+  (list (user-group (name "redis") (system? #t))
+        (user-account
+         (name "redis")
+         (group "redis")
+         (system? #t)
+         (comment "Redis server user")
+         (home-directory "/var/empty")
+         (shell (file-append shadow "/sbin/nologin")))))
+
+(define redis-activation
+  (match-lambda
+    (($ <redis-configuration> redis bind port working-directory config-file)
+     #~(begin
+         (use-modules (guix build utils)
+                      (ice-9 match))
+
+         (let ((user (getpwnam "redis")))
+           (mkdir-p #$working-directory)
+           (chown #$working-directory (passwd:uid user) (passwd:gid user)))))))
+
+(define redis-shepherd-service
+  (match-lambda
+    (($ <redis-configuration> redis bind port working-directory config-file)
+     (let ((config-file
+            (or config-file
+                (default-redis.conf bind port working-directory))))
+       (list (shepherd-service
+              (provision '(redis))
+              (documentation "Run the Redis daemon.")
+              (requirement '(user-processes syslogd))
+              (start #~(make-forkexec-constructor
+                        '(#$(file-append redis "/bin/redis-server")
+                          #$config-file)
+                        #:user "redis"
+                        #:group "redis"))
+              (stop #~(make-kill-destructor))))))))
+
+(define redis-service-type
+  (service-type (name 'redis)
+                (extensions
+                 (list (service-extension shepherd-root-service-type
+                                          redis-shepherd-service)
+                       (service-extension activation-service-type
+                                          redis-activation)
+                       (service-extension account-service-type
+                                          (const %redis-accounts))))))

guix/derivations.scm

@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -120,7 +121,7 @@
 ;;; Nix derivations, as implemented in Nix's `derivations.cc'.
 ;;;
 
-(define-record-type <derivation>
+(define-immutable-record-type <derivation>
   (make-derivation outputs inputs sources system builder args env-vars
                    file-name)
   derivation?
@@ -817,14 +818,6 @@ output should not be used."
             e
             outputs)))
 
-  (define (set-file-name drv file)
-    ;; Set FILE as the 'file-name' field of DRV.
-    (match drv
-      (($ <derivation> outputs inputs sources system builder
-          args env-vars)
-       (make-derivation outputs inputs sources system builder
-                        args env-vars file))))
-
   (define input->derivation-input
     (match-lambda
       (((? derivation? drv))
@@ -872,9 +865,9 @@ output should not be used."
     (let* ((file (add-text-to-store store (string-append name ".drv")
                                     (derivation->string drv)
                                     (map derivation-input-path inputs)))
-           (drv  (set-file-name drv file)))
+           (drv* (set-field drv (derivation-file-name) file)))
-      (hash-set! %derivation-cache file drv)
+      (hash-set! %derivation-cache file drv*)
-      drv)))
+      drv*)))
 
 (define* (map-derivation store drv mapping
                          #:key (system (%current-system)))

guix/git-download.scm

@@ -109,8 +109,7 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                       #:hash-algo hash-algo
                       #:hash hash
                       #:recursive? #t
-                      #:guile-for-build guile
+                      #:guile-for-build guile)))
-                      #:local-build? #t)))
 
 (define (git-version version revision commit)
   "Return the version string for packages using git-download."

guix/http-client.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
 ;;;
@@ -223,13 +223,14 @@ or if EOF is reached."
                 'shutdown (const #f))
 
 (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
-                     keep-alive? (verify-certificate? #t))
+                     keep-alive? (verify-certificate? #t)
+                     (headers '((user-agent . "GNU Guile"))))
   "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.  When BUFFERED? is #f, return an
 unbuffered port, suitable for use in `filtered-port'.  When KEEP-ALIVE? is
 true, send a 'Connection: keep-alive' HTTP header, in which case PORT may be
-reused for future HTTP requests.
+reused for future HTTP requests.  HEADERS is an alist of extra HTTP headers.
 
 When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates.
 
@@ -240,13 +241,14 @@ Raise an '&http-get-error' condition if downloading fails."
     (let ((port (or port (open-connection-for-uri uri
                                                   #:verify-certificate?
                                                   verify-certificate?)))
-          (auth-header (match (uri-userinfo uri)
+          (headers (match (uri-userinfo uri)
-                         ((? string? str)
+                     ((? string? str)
-                          (list (cons 'Authorization
+                      (cons (cons 'Authorization
-                                      (string-append "Basic "
+                                  (string-append "Basic "
-                                                     (base64-encode
+                                                 (base64-encode
-                                                      (string->utf8 str))))))
+                                                  (string->utf8 str))))
-                         (_ '()))))
+                            headers))
+                     (_ headers))))
       (unless (or buffered? (not (file-port? port)))
         (setvbuf port _IONBF))
       (let*-values (((resp data)
@@ -254,10 +256,10 @@ Raise an '&http-get-error' condition if downloading fails."
                      (if (guile-version>? "2.0.7")
                          (http-get uri #:streaming? #t #:port port
                                    #:keep-alive? #t
-                                   #:headers auth-header) ; 2.0.9+
+                                   #:headers headers)        ; 2.0.9+
                          (http-get* uri #:decode-body? text?        ; 2.0.7
                                     #:keep-alive? #t
-                                    #:port port #:headers auth-header)))
+                                    #:port port #:headers headers)))
                     ((code)
                      (response-code resp)))
         (case code

guix/import/github.scm

@@ -19,16 +19,29 @@
 (define-module (guix import github)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
   #:use-module (json)
   #:use-module (guix utils)
   #:use-module ((guix download) #:prefix download:)
   #:use-module (guix import utils)
-  #:use-module (guix import json)
   #:use-module (guix packages)
   #:use-module (guix upstream)
+  #:use-module (guix http-client)
   #:use-module (web uri)
   #:export (%github-updater))
 
+(define (json-fetch* url)
+  "Return a representation of the JSON resource URL (a list or hash table), or
+#f if URL returns 404."
+  (guard (c ((and (http-get-error? c)
+                  (= 404 (http-get-error-code c)))
+             #f))                       ;"expected" if package is unknown
+    ;; Note: github.com returns 403 if we omit a 'User-Agent' header.
+    (let* ((port   (http-fetch url))
+           (result (json->scm port)))
+      (close-port port)
+      result)))
+
 (define (find-extension url)
   "Return the extension of the archive e.g. '.tar.gz' given a URL, or
 false if none is recognized"
@@ -125,7 +138,7 @@ the package e.g. 'bedtools2'.  Return #f if there is no releases"
                    "https://api.github.com/repos/"
                    (github-user-slash-repository url)
                    "/releases"))
-         (json (json-fetch
+         (json (json-fetch*
                 (if token
                     (string-append api-url "?access_token=" token)
                     api-url))))

guix/licenses.scm

@@ -8,7 +8,7 @@
 ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2016 Fabian Harfert <fhmgufs@web.de>
 ;;; Copyright © 2016 Rene Saavedra <rennes@openmailbox.org>
-;;; Copyright © 2016 ng0 <ngillmann@runbox.com>
+;;; Copyright © 2016, 2017 ng0 <ng0@libertad.pw>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -74,7 +74,8 @@
             x11 x11-style
             zpl2.1
             zlib
-            fsf-free))
+            fsf-free
+            wtfpl2))
 
 (define-record-type <license>
   (license name uri comment)
@@ -450,6 +451,11 @@ at URI, which may be a file:// URI pointing the package's tree."
            "https://unlicense.org/"
            "https://www.gnu.org/licenses/license-list.html#Unlicense"))
 
+(define wtfpl2
+  (license "WTFPL 2"
+           "http://www.wtfpl.net"
+           "http://www.wtfpl.net/about/"))
+
 (define x11
   (license "X11"
            "http://directory.fsf.org/wiki/License:X11"

guix/scripts/challenge.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,12 +37,17 @@
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 format)
   #:use-module (web uri)
-  #:export (discrepancies
+  #:export (compare-contents
 
-            discrepancy?
+            comparison-report?
-            discrepancy-item
+            comparison-report-item
-            discrepancy-local-sha256
+            comparison-report-result
-            discrepancy-narinfos
+            comparison-report-local-sha256
+            comparison-report-narinfos
+
+            comparison-report-match?
+            comparison-report-mismatch?
+            comparison-report-inconclusive?
 
             guix-challenge))
 
@@ -61,13 +66,38 @@
 (define ensure-store-item                         ;XXX: move to (guix ui)?
   (@@ (guix scripts size) ensure-store-item))
 
-;; Representation of a hash mismatch for ITEM.
+;; Representation of a comparison report for ITEM.
-(define-record-type <discrepancy>
+(define-record-type <comparison-report>
-  (discrepancy item local-sha256 narinfos)
+  (%comparison-report item result local-sha256 narinfos)
-  discrepancy?
+  comparison-report?
-  (item         discrepancy-item)                   ;string, /gnu/store/… item
+  (item         comparison-report-item)    ;string, /gnu/store/… item
-  (local-sha256 discrepancy-local-sha256)           ;bytevector | #f
+  (result       comparison-report-result)  ;'match | 'mismatch | 'inconclusive
-  (narinfos     discrepancy-narinfos))              ;list of <narinfo>
+  (local-sha256 comparison-report-local-sha256)   ;bytevector | #f
+  (narinfos     comparison-report-narinfos))      ;list of <narinfo>
+
+(define-syntax comparison-report
+  ;; Some sort of a an enum to make sure 'result' is correct.
+  (syntax-rules (match mismatch inconclusive)
+    ((_ item 'match rest ...)
+     (%comparison-report item 'match rest ...))
+    ((_ item 'mismatch rest ...)
+     (%comparison-report item 'mismatch rest ...))
+    ((_ item 'inconclusive rest ...)
+     (%comparison-report item 'inconclusive rest ...))))
+
+(define (comparison-report-predicate result)
+  "Return a predicate that returns true when pass a REPORT that has RESULT."
+  (lambda (report)
+    (eq? (comparison-report-result report) result)))
+
+(define comparison-report-mismatch?
+  (comparison-report-predicate 'mismatch))
+
+(define comparison-report-match?
+  (comparison-report-predicate 'match))
+
+(define comparison-report-inconclusive?
+  (comparison-report-predicate 'inconclusive))
 
 (define (locally-built? store item)
   "Return true if ITEM was built locally."
@@ -88,10 +118,10 @@ Otherwise return #f."
 (define-syntax-rule (report args ...)
   (format (current-error-port) args ...))
 
-(define (discrepancies items servers)
+(define (compare-contents items servers)
   "Challenge the substitute servers whose URLs are listed in SERVERS by
 comparing the hash of the substitutes of ITEMS that they serve.  Return the
-list of discrepancies.
+list of <comparison-report> objects.
 
 This procedure does not authenticate narinfos from SERVERS, nor does it verify
 that they are signed by an authorized public keys.  The reason is that, by
@@ -100,11 +130,7 @@ taken since we do not import the archives."
   (define (compare item reference)
     ;; Return a procedure to compare the hash of ITEM with REFERENCE.
     (lambda (narinfo url)
-      (if (not narinfo)
+      (or (not narinfo)
-          (begin
-            (warning (_ "~a: no substitute at '~a'~%")
-                     item url)
-            #t)
           (let ((value (narinfo-hash->sha256 (narinfo-hash narinfo))))
             (bytevector=? reference value)))))
 
@@ -116,9 +142,7 @@ taken since we do not import the archives."
          ((url urls ...)
           (if (not first)
               (select-reference item narinfos urls)
-              (narinfo-hash->sha256 (narinfo-hash first))))))
+              (narinfo-hash->sha256 (narinfo-hash first))))))))
-      (()
-       (leave (_ "no substitutes for '~a'~%") item))))
 
   (mlet* %store-monad ((local     (mapm %store-monad
                                         query-locally-built-hash items))
@@ -130,42 +154,61 @@ taken since we do not import the archives."
                                                         vhash))
                                           vlist-null
                                           remote)))
-    (return (filter-map (lambda (item local)
+    (return (map (lambda (item local)
-                          (let ((narinfos (vhash-fold* cons '() item narinfos)))
+                   (match (vhash-fold* cons '() item narinfos)
-                            (define reference
+                     (()                          ;no substitutes
-                              (or local
+                      (comparison-report item 'inconclusive local '()))
-                                  (begin
+                     ((narinfo)
-                                    (warning (_ "no local build for '~a'~%") item)
+                      (if local
-                                    (select-reference item narinfos servers))))
+                          (if ((compare item local) narinfo (first servers))
+                              (comparison-report item 'match
+                                                 local (list narinfo))
+                              (comparison-report item 'mismatch
+                                                 local (list narinfo)))
+                          (comparison-report item 'inconclusive
+                                             local (list narinfo))))
+                     ((narinfos ...)
+                      (let ((reference
+                             (or local (select-reference item narinfos
+                                                         servers))))
+                        (if (every (compare item reference) narinfos servers)
+                            (comparison-report item 'match
+                                               local narinfos)
+                            (comparison-report item 'mismatch
+                                               local narinfos))))))
+                 items
+                 local))))
 
-                            (if (every (compare item reference)
+(define* (summarize-report comparison-report
-                                       narinfos servers)
+                           #:key
-                                #f
+                           (hash->string bytevector->nix-base32-string)
-                                (discrepancy item local narinfos))))
+                           verbose?)
-                        items
+  "Write to the current error port a summary of REPORT, a <comparison-report>
-                        local))))
+object.  When VERBOSE?, display matches in addition to mismatches and
+inconclusive reports."
+  (define (report-hashes item local narinfos)
+    (if local
+        (report (_ "  local hash: ~a~%") (hash->string local))
+        (report (_ "  no local build for '~a'~%") item))
+    (for-each (lambda (narinfo)
+                (report (_ "  ~50a: ~a~%")
+                        (uri->string (narinfo-uri narinfo))
+                        (hash->string
+                         (narinfo-hash->sha256 (narinfo-hash narinfo)))))
+              narinfos))
 
-(define* (summarize-discrepancy discrepancy
+  (match comparison-report
-                                #:key (hash->string
+    (($ <comparison-report> item 'mismatch local (narinfos ...))
-                                       bytevector->nix-base32-string))
-  "Write to the current error port a summary of DISCREPANCY, a <discrepancy>
-object that denotes a hash mismatch."
-  (match discrepancy
-    (($ <discrepancy> item local (narinfos ...))
      (report (_ "~a contents differ:~%") item)
-     (if local
+     (report-hashes item local narinfos))
-         (report (_ "  local hash: ~a~%") (hash->string local))
+    (($ <comparison-report> item 'inconclusive #f narinfos)
-         (warning (_ "no local build for '~a'~%") item))
+     (warning (_ "could not challenge '~a': no local build~%") item))
-
+    (($ <comparison-report> item 'inconclusive locals ())
-     (for-each (lambda (narinfo)
+     (warning (_ "could not challenge '~a': no substitutes~%") item))
-                 (if narinfo
+    (($ <comparison-report> item 'match local (narinfos ...))
-                     (report (_ "  ~50a: ~a~%")
+     (when verbose?
-                             (uri->string (narinfo-uri narinfo))
+       (report (_ "~a contents match:~%") item)
-                             (hash->string
+       (report-hashes item local narinfos)))))
-                              (narinfo-hash->sha256 (narinfo-hash narinfo))))
-                     (report (_ "  ~50a: unavailable~%")
-                             (uri->string (narinfo-uri narinfo)))))
-               narinfos))))
 
 
 ;;;
@@ -178,6 +221,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
   (display (_ "
       --substitute-urls=URLS
                          compare build results with those at URLS"))
+  (display (_ "
+      -v, --verbose      show details about successful comparisons"))
   (newline)
   (display (_ "
   -h, --help             display this help and exit"))
@@ -201,6 +246,11 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
                           (alist-cons 'substitute-urls
                                       (string-tokenize arg)
                                       (alist-delete 'substitute-urls result))
+                          rest)))
+         (option '("verbose" #\v) #f #f
+                 (lambda (opt name arg result . rest)
+                   (apply values
+                          (alist-cons 'verbose? #t result)
                           rest)))))
 
 (define %default-options
@@ -220,7 +270,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
                                    (_ #f))
                                  opts))
            (system   (assoc-ref opts 'system))
-           (urls     (assoc-ref opts 'substitute-urls)))
+           (urls     (assoc-ref opts 'substitute-urls))
+           (verbose? (assoc-ref opts 'verbose?)))
       (leave-on-EPIPE
        (with-store store
          ;; Disable grafts since substitute servers normally provide only
@@ -236,13 +287,15 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
                                 #:use-substitutes? #f)
 
              (run-with-store store
-               (mlet* %store-monad ((items  (mapm %store-monad
+               (mlet* %store-monad ((items   (mapm %store-monad
-                                                  ensure-store-item files))
+                                                   ensure-store-item files))
-                                    (issues (discrepancies items urls)))
+                                    (reports (compare-contents items urls)))
-                 (for-each summarize-discrepancy issues)
+                 (for-each (cut summarize-report <> #:verbose? verbose?)
-                 (unless (null? issues)
+                           reports)
-                   (exit 2))
+
-                 (return (null? issues)))
+                 (exit (cond ((any comparison-report-mismatch? reports) 2)
+                             ((every comparison-report-match? reports) 0)
+                             (else 1))))
                #:system system))))))))
 
 ;;; challenge.scm ends here

guix/scripts/perform-download.scm

@@ -41,20 +41,23 @@
     (module-use! module (resolve-interface '(guix base32)))
     module))
 
-(define (perform-download drv output)
+(define* (perform-download drv #:optional output)
   "Perform the download described by DRV, a fixed-output derivation, to
 OUTPUT.
 
-Note: We don't read the value of 'out' in DRV since the actual output is
+Note: Unless OUTPUT is #f, we don't read the value of 'out' in DRV since the
-different from that when we're doing a 'bmCheck' or 'bmRepair' build."
+actual output is different from that when we're doing a 'bmCheck' or
+'bmRepair' build."
   (derivation-let drv ((url "url")
+                       (output* "out")
                        (executable "executable")
                        (mirrors "mirrors")
                        (content-addressed-mirrors "content-addressed-mirrors"))
     (unless url
       (leave (_ "~a: missing URL~%") (derivation-file-name drv)))
 
-    (let* ((url        (call-with-input-string url read))
+    (let* ((output     (or output output*))
+           (url        (call-with-input-string url read))
            (drv-output (assoc-ref (derivation-outputs drv) "out"))
            (algo       (derivation-output-hash-algo drv-output))
            (hash       (derivation-output-hash drv-output)))
@@ -94,17 +97,20 @@ the daemon and not explicitly described as an input of the derivation.  This
 allows us to sidestep bootstrapping problems, such downloading the source code
 of GnuTLS over HTTPS, before we have built GnuTLS.  See
 <http://bugs.gnu.org/22774>."
+
+  ;; This program must be invoked by guix-daemon under an unprivileged UID to
+  ;; prevent things downloading from 'file:///etc/shadow' or arbitrary code
+  ;; execution via the content-addressed mirror procedures.  (That means we
+  ;; exclude users who did not pass '--build-users-group'.)
   (with-error-handling
     (match args
       (((? derivation-path? drv) (? store-path? output))
-       ;; This program must be invoked by guix-daemon under an unprivileged
-       ;; UID to prevent things downloading from 'file:///etc/shadow' or
-       ;; arbitrary code execution via the content-addressed mirror
-       ;; procedures.  (That means we exclude users who did not pass
-       ;; '--build-users-group'.)
        (assert-low-privileges)
        (perform-download (call-with-input-file drv read-derivation)
                          output))
+      (((? derivation-path? drv))                 ;backward compatibility
+       (assert-low-privileges)
+       (perform-download (call-with-input-file drv read-derivation)))
       (("--version")
        (show-version-and-exit))
       (x

guix/ui.scm

@@ -332,39 +332,39 @@ Report bugs to: ~a.") %guix-bug-report-address)
 General help using GNU software: <http://www.gnu.org/gethelp/>"))
   (newline))
 
+(define (augmented-system-error-handler file)
+  "Return a 'system-error' handler that mentions FILE in its message."
+  (lambda (key proc fmt args errno)
+    ;; Augment the FMT and ARGS with information about TARGET (this
+    ;; information is missing as of Guile 2.0.11, making the exception
+    ;; uninformative.)
+    (apply throw key proc "~A: ~S"
+           (list (strerror (car errno)) file)
+           (list errno))))
+
+(define-syntax-rule (error-reporting-wrapper proc (args ...) file)
+  "Wrap PROC such that its 'system-error' exceptions are augmented to mention
+FILE."
+  (let ((real-proc (@ (guile) proc)))
+    (lambda (args ...)
+      (catch 'system-error
+        (lambda ()
+          (real-proc args ...))
+        (augmented-system-error-handler file)))))
+
 (set! symlink
   ;; We 'set!' the global binding because (gnu build ...) modules and similar
   ;; typically don't use (guix ui).
-  (let ((real-symlink (@ (guile) symlink)))
+  (error-reporting-wrapper symlink (source target) target))
-    (lambda (target link)
-      "This is a 'symlink' replacement that provides proper error reporting."
-      (catch 'system-error
-        (lambda ()
-          (real-symlink target link))
-        (lambda (key proc fmt args errno)
-          ;; Augment the FMT and ARGS with information about LINK (this
-          ;; information is missing as of Guile 2.0.11, making the exception
-          ;; uninformative.)
-          (apply throw key proc "~A: ~S"
-                 (list (strerror (car errno)) link)
-                 (list errno)))))))
 
 (set! copy-file
   ;; Note: here we use 'set!', not #:replace, because UIs typically use
   ;; 'copy-recursively', which doesn't use (guix ui).
-  (let ((real-copy-file (@ (guile) copy-file)))
+  (error-reporting-wrapper copy-file (source target) target))
-    (lambda (source target)
+
-      "This is a 'copy-file' replacement that provides proper error reporting."
+(set! canonicalize-path
-      (catch 'system-error
+  (error-reporting-wrapper canonicalize-path (file) file))
-        (lambda ()
+
-          (real-copy-file source target))
-        (lambda (key proc fmt args errno)
-          ;; Augment the FMT and ARGS with information about TARGET (this
-          ;; information is missing as of Guile 2.0.11, making the exception
-          ;; uninformative.)
-          (apply throw key proc "~A: ~S"
-                 (list (strerror (car errno)) target)
-                 (list errno)))))))
 
 (define (make-regexp* regexp . flags)
   "Like 'make-regexp' but error out if REGEXP is invalid, reporting the error

tests/challenge.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -69,8 +69,15 @@
         (built-derivations (list drv))
         (mlet %store-monad ((hash (query-path-hash* out)))
           (with-derivation-narinfo* drv (sha256 => hash)
-            (>>= (discrepancies (list out) (%test-substitute-urls))
+            (>>= (compare-contents (list out) (%test-substitute-urls))
-                 (lift1 null? %store-monad))))))))
+                 (match-lambda
+                   ((report)
+                    (return
+                     (and (string=? out (comparison-report-item report))
+                          (bytevector=?
+                           (comparison-report-local-sha256 report)
+                           hash)
+                          (comparison-report-match? report))))))))))))
 
 (test-assertm "one discrepancy"
   (let ((text (random-text)))
@@ -90,20 +97,57 @@
                                                        (modulo (+ b 1) 128))
                                    w)))
           (with-derivation-narinfo* drv (sha256 => wrong-hash)
-            (>>= (discrepancies (list out) (%test-substitute-urls))
+            (>>= (compare-contents (list out) (%test-substitute-urls))
                  (match-lambda
-                   ((discrepancy)
+                   ((report)
                     (return
-                     (and (string=? out (discrepancy-item discrepancy))
+                     (and (string=? out (comparison-report-item (pk report)))
+                          (eq? 'mismatch (comparison-report-result report))
                           (bytevector=? hash
-                                        (discrepancy-local-sha256
+                                        (comparison-report-local-sha256
-                                         discrepancy))
+                                         report))
-                          (match (discrepancy-narinfos discrepancy)
+                          (match (comparison-report-narinfos report)
                             ((bad)
                              (bytevector=? wrong-hash
                                            (narinfo-hash->sha256
                                             (narinfo-hash bad))))))))))))))))
 
+(test-assertm "inconclusive: no substitutes"
+  (mlet* %store-monad ((drv  (gexp->derivation "foo" #~(mkdir #$output)))
+                       (out -> (derivation->output-path drv))
+                       (_    (built-derivations (list drv)))
+                       (hash (query-path-hash* out)))
+    (>>= (compare-contents (list out) (%test-substitute-urls))
+         (match-lambda
+           ((report)
+            (return
+             (and (string=? out (comparison-report-item report))
+                  (comparison-report-inconclusive? report)
+                  (null? (comparison-report-narinfos report))
+                  (bytevector=? (comparison-report-local-sha256 report)
+                                hash))))))))
+
+(test-assertm "inconclusive: no local build"
+  (let ((text (random-text)))
+    (mlet* %store-monad ((drv (gexp->derivation "something"
+                                                #~(list #$output #$text)))
+                         (out -> (derivation->output-path drv))
+                         (hash -> (sha256 #vu8())))
+      (with-derivation-narinfo* drv (sha256 => hash)
+        (>>= (compare-contents (list out) (%test-substitute-urls))
+             (match-lambda
+               ((report)
+                (return
+                 (and (string=? out (comparison-report-item report))
+                      (comparison-report-inconclusive? report)
+                      (not (comparison-report-local-sha256 report))
+                      (match (comparison-report-narinfos report)
+                        ((narinfo)
+                         (bytevector=? (narinfo-hash->sha256
+                                        (narinfo-hash narinfo))
+                                       hash))))))))))))
+
+
 (test-end)
 
 ;;; Local Variables: