Merge branch 'master' into staging

17 files changed, 520 insertions, 172 deletions

diff --git a/guix/build-system/glib-or-gtk.scm b/guix/build-system/glib-or-gtk.scm
index fcd92f2334..8de7dfbfc2 100644
--- a/guix/build-system/glib-or-gtk.scm
+++ b/guix/build-system/glib-or-gtk.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch>
 ;;;
@@ -129,7 +129,8 @@
                             (system (%current-system))
                             (imported-modules %glib-or-gtk-build-system-modules)
                             (modules %default-modules)
-                            allowed-references)
+                            allowed-references
+                            disallowed-references)
   "Build SOURCE with INPUTS.  See GNU-BUILD for more details."
   (define canonicalize-reference
     (match-lambda
@@ -190,6 +191,10 @@
                                 (and allowed-references
                                      (map canonicalize-reference
                                           allowed-references))
+                                #:disallowed-references
+                                (and disallowed-references
+                                     (map canonicalize-reference
+                                          disallowed-references))
                                 #:guile-for-build guile-for-build))
 
 (define glib-or-gtk-build-system
diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm
index cf91163275..1b916af8f9 100644
--- a/guix/build-system/go.scm
+++ b/guix/build-system/go.scm
@@ -39,6 +39,7 @@
 (define %go-build-system-modules
   ;; Build-side modules imported and used by default.
   `((guix build go-build-system)
+    (guix build union)
     ,@%gnu-build-system-modules))
 
 (define (default-go)
@@ -87,6 +88,7 @@
                    (guile #f)
                    (imported-modules %go-build-system-modules)
                    (modules '((guix build go-build-system)
+                              (guix build union)
                               (guix build utils))))
   (define builder
    `(begin
diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm
index 8d49020454..370d185545 100644
--- a/guix/build-system/meson.scm
+++ b/guix/build-system/meson.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
-;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2018, 2019 Marius Bakke <mbakke@fastmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -109,9 +109,25 @@
                       (system (%current-system))
                       (imported-modules %meson-build-system-modules)
                       (modules '((guix build meson-build-system)
-                                 (guix build utils))))
+                                 (guix build utils)))
+                      allowed-references
+                      disallowed-references)
   "Build SOURCE using MESON, and with INPUTS, assuming that SOURCE
 has a 'meson.build' file."
+
+  ;; TODO: Copied from build-system/gnu, factorize this!
+  (define canonicalize-reference
+    (match-lambda
+     ((? package? p)
+      (derivation->output-path (package-derivation store p system
+                                                   #:graft? #f)))
+     (((? package? p) output)
+      (derivation->output-path (package-derivation store p system
+                                                   #:graft? #f)
+                               output))
+     ((? string? output)
+      output)))
+
   (define builder
     `(let ((build-phases (if ,glib-or-gtk?
                              ,phases
@@ -159,7 +175,15 @@ has a 'meson.build' file."
                                 #:inputs inputs
                                 #:modules imported-modules
                                 #:outputs outputs
-                                #:guile-for-build guile-for-build))
+                                #:guile-for-build guile-for-build
+                                #:allowed-references
+                                (and allowed-references
+                                     (map canonicalize-reference
+                                          allowed-references))
+                                #:disallowed-references
+                                (and disallowed-references
+                                     (map canonicalize-reference
+                                          disallowed-references))))
 
 (define meson-build-system
   (build-system
diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm
index 022d4fe16b..1a716cea77 100644
--- a/guix/build/go-build-system.scm
+++ b/guix/build/go-build-system.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Petter <petter@mykolab.ch>
-;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
+;;; Copyright © 2017, 2019 Leo Famulari <leo@famulari.name>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,6 +19,7 @@
 
 (define-module (guix build go-build-system)
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+  #:use-module (guix build union)
   #:use-module (guix build utils)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -38,24 +39,26 @@
 ;; results. [0]
 
 ;; Go software is developed and built within a particular file system hierarchy
-;; structure called a 'workspace' [1].  This workspace is found by Go
-;; via the GOPATH environment variable.  Typically, all Go source code
-;; and compiled objects are kept in a single workspace, but it is
-;; possible for GOPATH to contain a list of directories, and that is
-;; what we do in this go-build-system. [2]
+;; structure called a 'workspace' [1].  This workspace can be found by Go via
+;; the GOPATH environment variable.  Typically, all Go source code and compiled
+;; objects are kept in a single workspace, but GOPATH may be a list of
+;; directories [2].  In this go-build-system we create a filesystem union of
+;; the Go-language dependencies. Previously, we made GOPATH a list of store
+;; directories, but stopped because Go programs started keeping references to
+;; these directories in Go 1.11:
+;; <https://bugs.gnu.org/33620>.
 ;;
-;; Go software, whether a package or a command, is uniquely named using
-;; an 'import path'.  The import path is based on the URL of the
-;; software's source.  Since most source code is provided over the
-;; internet, the import path is typically a combination of the remote
-;; URL and the source repository's file system structure. For example,
-;; the Go port of the common `du` command is hosted on github.com, at
-;; <https://github.com/calmh/du>.  Thus, the import path is
-;; <github.com/calmh/du>. [3]
+;; Go software, whether a package or a command, is uniquely named using an
+;; 'import path'.  The import path is based on the URL of the software's source.
+;; Because most source code is provided over the internet, the import path is
+;; typically a combination of the remote URL and the source repository's file
+;; system structure. For example, the Go port of the common `du` command is
+;; hosted on github.com, at <https://github.com/calmh/du>.  Thus, the import
+;; path is <github.com/calmh/du>. [3]
 ;;
-;; It may be possible to programatically guess a package's import path
-;; based on the source URL, but we don't try that in this revision of
-;; the go-build-system.
+;; It may be possible to automatically guess a package's import path based on
+;; the source URL, but we don't try that in this revision of the
+;; go-build-system.
 ;;
 ;; Modules of modular Go libraries are named uniquely with their
 ;; file system paths.  For example, the supplemental but "standardized"
@@ -75,6 +78,17 @@
 ;; file system union of the required modules of such libraries.  I think
 ;; this could be improved in future revisions of the go-build-system.
 ;;
+;; TODO:
+;; * Avoid copying dependencies into the build environment and / or avoid using
+;; a tmpdir when creating the inputs union.
+;; * Use Go modules [4]
+;; * Re-use compiled packages [5]
+;; * Avoid the go-inputs hack
+;; * Stop needing remove-go-references (-trimpath ? )
+;; * Remove module packages, only offering the full Git repos? This is
+;; more idiomatic, I think, because Go downloads Git repos, not modules.
+;; What are the trade-offs?
+;;
 ;; [0] `go build`:
 ;; https://golang.org/cmd/go/#hdr-Compile_packages_and_dependencies
 ;; `go install`:
@@ -107,18 +121,44 @@
 ;;
 ;; [2] https://golang.org/doc/code.html#GOPATH
 ;; [3] https://golang.org/doc/code.html#ImportPaths
+;; [4] https://golang.org/cmd/go/#hdr-Modules__module_versions__and_more
+;; [5] https://bugs.gnu.org/32919
 ;;
 ;; Code:
 
+(define* (setup-go-environment #:key inputs outputs #:allow-other-keys)
+  "Prepare a Go build environment for INPUTS and OUTPUTS.  Build a filesystem
+union of INPUTS.  Export GOPATH, which helps the compiler find the source code
+of the package being built and its dependencies, and GOBIN, which determines
+where executables (\"commands\") are installed to.  This phase is sometimes used
+by packages that use (guix build-system gnu) but have a handful of Go
+dependencies, so it should be self-contained."
+  ;; Using the current working directory as GOPATH makes it easier for packagers
+  ;; who need to manipulate the unpacked source code.
+  (setenv "GOPATH" (getcwd))
+  (setenv "GOBIN" (string-append (assoc-ref outputs "out") "/bin"))
+  (let ((tmpdir (tmpnam)))
+    (match (go-inputs inputs)
+      (((names . directories) ...)
+       (union-build tmpdir (filter directory-exists? directories)
+                    #:create-all-directories? #t
+                    #:log-port (%make-void-port "w"))))
+    ;; XXX A little dance because (guix build union) doesn't use mkdir-p.
+    (copy-recursively tmpdir
+                      (string-append (getenv "GOPATH"))
+                      #:keep-mtime? #t)
+    (delete-file-recursively tmpdir))
+  #t)
+
 (define* (unpack #:key source import-path unpack-path #:allow-other-keys)
-  "Unpack SOURCE in the UNPACK-PATH, or the IMPORT-PATH is the UNPACK-PATH is
-unset.  When SOURCE is a directory, copy it instead of unpacking."
+  "Relative to $GOPATH, unpack SOURCE in the UNPACK-PATH, or the IMPORT-PATH is
+the UNPACK-PATH is unset.  When SOURCE is a directory, copy it instead of
+unpacking."
   (if (string-null? import-path)
       ((display "WARNING: The Go import path is unset.\n")))
   (if (string-null? unpack-path)
       (set! unpack-path import-path))
-  (mkdir "src")
-  (let ((dest (string-append "src/" unpack-path)))
+  (let ((dest (string-append (getenv "GOPATH") "/src/" unpack-path)))
     (mkdir-p dest)
     (if (file-is-directory? source)
       (begin
@@ -128,15 +168,6 @@ unset.  When SOURCE is a directory, copy it instead of unpacking."
         (invoke "unzip" "-d" dest source)
         (invoke "tar" "-C" dest "-xvf" source)))))
 
-(define* (install-source #:key install-source? outputs #:allow-other-keys)
-  "Install the source code to the output directory."
-  (let* ((out (assoc-ref outputs "out"))
-         (source "src")
-         (dest (string-append out "/" source)))
-    (when install-source?
-      (copy-recursively source dest #:keep-mtime? #t))
-    #t))
-
 (define (go-package? name)
   (string-prefix? "go-" name))
 
@@ -155,27 +186,6 @@ unset.  When SOURCE is a directory, copy it instead of unpacking."
                 (_ #f))
               inputs))))
 
-(define* (setup-environment #:key inputs outputs #:allow-other-keys)
-  "Export the variables GOPATH and GOBIN, which are based on INPUTS and OUTPUTS,
-respectively."
-  (let ((out (assoc-ref outputs "out")))
-    ;; GOPATH is where Go looks for the source code of the build's dependencies.
-    (set-path-environment-variable "GOPATH"
-                                   ;; XXX Matching "." hints that we could do
-                                   ;; something simpler here...
-                                   (list ".")
-                                   (match (go-inputs inputs)
-                                     (((_ . dir) ...)
-                                      dir)))
-
-    ;; Add the source code of the package being built to GOPATH.
-    (if (getenv "GOPATH")
-      (setenv "GOPATH" (string-append (getcwd) ":" (getenv "GOPATH")))
-      (setenv "GOPATH" (getcwd)))
-    ;; Where to install compiled executable files ('commands' in Go parlance').
-    (setenv "GOBIN" (string-append out "/bin"))
-    #t))
-
 (define* (build #:key import-path #:allow-other-keys)
   "Build the package named by IMPORT-PATH."
   (with-throw-handler
@@ -193,22 +203,26 @@ respectively."
                               "Here are the results of `go env`:\n"))
       (invoke "go" "env"))))
 
+;; Can this also install commands???
 (define* (check #:key tests? import-path #:allow-other-keys)
   "Run the tests for the package named by IMPORT-PATH."
   (when tests?
     (invoke "go" "test" import-path))
   #t)
 
-(define* (install #:key outputs #:allow-other-keys)
-  "Install the compiled libraries. `go install` installs these files to
-$GOPATH/pkg, so we have to copy them into the output directory manually.
-Compiled executable files should have already been installed to the store based
-on $GOBIN in the build phase."
-  ;; TODO: From go-1.10 onward, the pkg folder should not be needed (see
-  ;; https://lists.gnu.org/archive/html/guix-devel/2018-11/msg00208.html).
-  ;; Remove it?
-  (when (file-exists? "pkg")
-    (copy-recursively "pkg" (string-append (assoc-ref outputs "out") "/pkg")))
+(define* (install #:key install-source? outputs import-path unpack-path #:allow-other-keys)
+  "Install the source code of IMPORT-PATH to the primary output directory.
+Compiled executable files (Go \"commands\") should have already been installed
+to the store based on $GOBIN in the build phase.
+XXX We can't make us of compiled libraries (Go \"packages\")."
+  (when install-source?
+    (if (string-null? import-path)
+        ((display "WARNING: The Go import path is unset.\n")))
+    (let* ((out (assoc-ref outputs "out"))
+           (source (string-append (getenv "GOPATH") "/src/" import-path))
+           (dest (string-append out "/src/" import-path)))
+      (mkdir-p dest)
+      (copy-recursively source dest #:keep-mtime? #t)))
   #t)
 
 (define* (remove-store-reference file file-name
@@ -269,9 +283,8 @@ files in OUTPUTS."
     (delete 'bootstrap)
     (delete 'configure)
     (delete 'patch-generated-file-shebangs)
+    (add-before 'unpack 'setup-go-environment setup-go-environment)
     (replace 'unpack unpack)
-    (add-after 'unpack 'install-source install-source)
-    (add-before 'build 'setup-environment setup-environment)
     (replace 'build build)
     (replace 'check check)
     (replace 'install install)
diff --git a/guix/describe.scm b/guix/describe.scm
index 00372bbed7..893dca2640 100644
--- a/guix/describe.scm
+++ b/guix/describe.scm
@@ -21,10 +21,12 @@
   #:use-module (guix profiles)
   #:use-module (guix packages)
   #:use-module ((guix utils) #:select (location-file))
-  #:use-module ((guix store) #:select (%store-prefix))
+  #:use-module ((guix store) #:select (%store-prefix store-path?))
+  #:use-module ((guix config) #:select (%state-directory))
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:export (current-profile
+            current-profile-date
             current-profile-entries
             package-path-entries
 
@@ -55,6 +57,27 @@ or #f if this is not applicable."
               (and (file-exists? (string-append candidate "/manifest"))
                    candidate)))))))
 
+(define (current-profile-date)
+  "Return the creation date of the current profile (produced by 'guix pull'),
+as a number of seconds since the Epoch, or #f if it could not be determined."
+  ;; Normally 'current-profile' will return ~/.config/guix/current.  We need
+  ;; to 'readlink' once to get '/var/guix/…/guix-profile', whose mtime is the
+  ;; piece of information we're looking for.
+  (let loop ((profile (current-profile)))
+    (match profile
+      (#f #f)
+      ((? store-path?) #f)
+      (file
+       (if (string-prefix? %state-directory file)
+           (and=> (lstat file) stat:mtime)
+           (catch 'system-error
+             (lambda ()
+               (let ((target (readlink file)))
+                 (loop (if (string-prefix? "/" target)
+                           target
+                           (string-append (dirname file) "/" target)))))
+             (const #f)))))))
+
 (define current-profile-entries
   (mlambda ()
     "Return the list of entries in the 'guix pull' profile the calling process
diff --git a/guix/download.scm b/guix/download.scm
index 25eaefcffa..8865777818 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2019 Guy Fleury Iteriteka <hoonandon@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -360,7 +361,10 @@
        "https://openbsd.mirror.constant.com/pub/OpenBSD/"
        "https://ftp4.usa.openbsd.org/pub/OpenBSD/"
        "https://ftp5.usa.openbsd.org/pub/OpenBSD/"
-       "https://mirror.esc7.net/pub/OpenBSD/"))))
+       "https://mirror.esc7.net/pub/OpenBSD/")
+      (mate
+       "https://pub.mate-desktop.org/releases/"
+       "http://pub.mate-desktop.org/releases/"))))
 
 (define %mirror-file
   ;; Copy of the list of mirrors to a file.  This allows us to keep a single
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 48db764b3c..2a51420d14 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
 ;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2016 Nils Gillmann <ng0@n0.is>
+;;; Copyright © 2016 ng0 <ng0@n0.is>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
diff --git a/guix/import/launchpad.scm b/guix/import/launchpad.scm
new file mode 100644
index 0000000000..ffd5e9221e
--- /dev/null
+++ b/guix/import/launchpad.scm
@@ -0,0 +1,124 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import launchpad)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (web uri)
+  #:use-module ((guix download) #:prefix download:)
+  #:use-module (guix import json)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix utils)
+  #:export (%launchpad-updater))
+
+(define (find-extension url)
+  "Return the extension of the archive e.g. '.tar.gz' given a URL, or
+false if none is recognized"
+  (find (lambda (x) (string-suffix? x url))
+        (list ".tar.gz" ".tar.bz2" ".tar.xz"
+              ".zip" ".tar" ".tgz" ".tbz" ".love")))
+
+(define (updated-launchpad-url old-package new-version)
+  ;; Return a url for the OLD-PACKAGE with NEW-VERSION.  If no source url in
+  ;; the OLD-PACKAGE is a Launchpad url, then return false.
+
+  (define (updated-url url)
+    (and (string-prefix? "https://launchpad.net/" url)
+         (let ((ext (or (find-extension url) ""))
+               (name (package-name old-package))
+               (version (package-version old-package))
+               (repo (launchpad-repository url)))
+           (cond
+            ((and
+              (>= (length (string-split version #\.)) 2)
+              (string=? (string-append "https://launchpad.net/"
+                                       repo "/" (version-major+minor version)
+                                       "/" version "/+download/" repo "-" version ext)
+                        url))
+             (string-append "https://launchpad.net/"
+                            repo "/" (version-major+minor new-version)
+                            "/" new-version "/+download/" repo "-" new-version ext))
+            (#t #f))))) ; Some URLs are not recognised.
+
+  (let ((source-uri (and=> (package-source old-package) origin-uri))
+        (fetch-method (and=> (package-source old-package) origin-method)))
+    (cond
+     ((eq? fetch-method download:url-fetch)
+      (match source-uri
+             ((? string?)
+              (updated-url source-uri))
+             ((source-uri ...)
+              (find updated-url source-uri))))
+     (else #f))))
+
+(define (launchpad-package? package)
+  "Return true if PACKAGE is a package from Launchpad, else false."
+  (->bool (updated-launchpad-url package "1.0.0")))
+
+(define (launchpad-repository url)
+  "Return a string e.g. linuxdcpp of the name of the repository, from a string
+URL of the form
+'https://launchpad.net/linuxdcpp/1.1/1.1.0/+download/linuxdcpp-1.1.0.tar.bz2'"
+  (match (string-split (uri-path (string->uri url)) #\/)
+    ((_ repo . rest) repo)))
+
+(define (latest-released-version package-name)
+  "Return a string of the newest released version name given the PACKAGE-NAME,
+for example, 'linuxdcpp'. Return #f if there is no releases."
+  (define (pre-release? x)
+    ;; Versions containing anything other than digit characters and "." (for
+    ;; example, "5.1.0-rc1") are assumed to be pre-releases.
+    (not (string-every (char-set-union (char-set #\.)
+                                       char-set:digit)
+                       (hash-ref x "version"))))
+
+  (hash-ref
+   (last (remove
+          pre-release?
+          (hash-ref (json-fetch
+                     (string-append "https://api.launchpad.net/1.0/"
+                                    package-name "/releases"))
+                    "entries")))
+   "version"))
+
+(define (latest-release pkg)
+  "Return an <upstream-source> for the latest release of PKG."
+  (define (origin-github-uri origin)
+    (match (origin-uri origin)
+      ((? string? url) url) ; surely a Launchpad URL
+      ((urls ...)
+       (find (cut string-contains <> "launchpad.net") urls))))
+
+  (let* ((source-uri (origin-github-uri (package-source pkg)))
+         (name (package-name pkg))
+         (newest-version (latest-released-version name)))
+    (if newest-version
+        (upstream-source
+         (package name)
+         (version newest-version)
+         (urls (list (updated-launchpad-url pkg newest-version))))
+        #f))) ; On Launchpad but no proper releases
+
+(define %launchpad-updater
+  (upstream-updater
+   (name 'launchpad)
+   (description "Updater for Launchpad packages")
+   (pred launchpad-package?)
+   (latest latest-release)))
diff --git a/guix/licenses.scm b/guix/licenses.scm
index d22c3fa36e..676e71acdb 100644
--- a/guix/licenses.scm
+++ b/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, 2017 Nils Gillmann <ng0@n0.is>
+;;; Copyright © 2016, 2017 ng0 <ng0@n0.is>
 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2017 Petter <petter@mykolab.ch>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
diff --git a/guix/packages.scm b/guix/packages.scm
index f191327718..d20a2562c3 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -102,6 +102,7 @@
             package-transitive-supported-systems
             package-mapping
             package-input-rewriting
+            package-input-rewriting/spec
             package-source-derivation
             package-derivation
             package-cross-derivation
@@ -869,6 +870,43 @@ package and returns its new name after rewrite."
 
   (package-mapping rewrite (cut assq <> replacements)))
 
+(define (package-input-rewriting/spec replacements)
+  "Return a procedure that, given a package, applies the given REPLACEMENTS to
+all the package graph (excluding implicit inputs).  REPLACEMENTS is a list of
+spec/procedures pair; each spec is a package specification such as \"gcc\" or
+\"guile@2\", and each procedure takes a matching package and returns a
+replacement for that package."
+  (define table
+    (fold (lambda (replacement table)
+            (match replacement
+              ((spec . proc)
+               (let-values (((name version)
+                             (package-name->name+version spec)))
+                 (vhash-cons name (list version proc) table)))))
+          vlist-null
+          replacements))
+
+  (define (find-replacement package)
+    (vhash-fold* (lambda (item proc)
+                   (or proc
+                       (match item
+                         ((#f proc)
+                          proc)
+                         ((version proc)
+                          (and (version-prefix? version
+                                                (package-version package))
+                               proc)))))
+                 #f
+                 (package-name package)
+                 table))
+
+  (define (rewrite package)
+    (match (find-replacement package)
+      (#f package)
+      (proc (proc package))))
+
+  (package-mapping rewrite find-replacement))
+
 (define-syntax-rule (package/inherit p overrides ...)
   "Like (package (inherit P) OVERRIDES ...), except that the same
 transformation is done to the package replacement, if any.  P must be a bare
diff --git a/guix/scripts.scm b/guix/scripts.scm
index 5e20ecd92c..75d801a466 100644
--- a/guix/scripts.scm
+++ b/guix/scripts.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
 ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
 ;;;
@@ -27,6 +27,7 @@
   #:use-module (guix packages)
   #:use-module (guix derivations)
   #:use-module ((guix profiles) #:select (%profile-directory))
+  #:autoload   (guix describe) (current-profile-date)
   #:use-module (guix build syscalls)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
@@ -158,36 +159,25 @@ Show what and how will/would be built."
                                 #:key (suggested-command
                                        "guix package -u"))
   "Emit a warning if Guix is older than OLD seconds."
-  (let-syntax ((false-if-not-found
-                (syntax-rules ()
-                  ((_ exp)
-                   (catch 'system-error
-                     (lambda ()
-                       exp)
-                     (lambda args
-                       (if (= ENOENT (system-error-errno args))
-                           #f
-                           (apply throw args))))))))
-    (define (seconds->days seconds)
-      (round (/ seconds (* 3600 24))))
-
-    (define age
-      (match (false-if-not-found
-              (lstat (string-append %profile-directory "/current-guix")))
-        (#f    #f)
-        (stat  (- (time-second (current-time time-utc))
-                  (stat:mtime stat)))))
-
-    (when (and age (>= age old))
-      (warning (N_ "Your Guix installation is ~a day old.\n"
-                   "Your Guix installation is ~a days old.\n"
-                   (seconds->days age))
-               (seconds->days age)))
-    (when (or (not age) (>= age old))
-      (warning (G_ "Consider running 'guix pull' followed by
+  (define (seconds->days seconds)
+    (round (/ seconds (* 3600 24))))
+
+  (define age
+    (match (current-profile-date)
+      (#f    #f)
+      (date  (- (time-second (current-time time-utc))
+                date))))
+
+  (when (and age (>= age old))
+    (warning (N_ "Your Guix installation is ~a day old.\n"
+                 "Your Guix installation is ~a days old.\n"
+                 (seconds->days age))
+             (seconds->days age)))
+  (when (or (not age) (>= age old))
+    (warning (G_ "Consider running 'guix pull' followed by
 '~a' to get up-to-date packages and security updates.\n")
-               suggested-command)
-      (newline (guix-warning-port)))))
+             suggested-command)
+    (newline (guix-warning-port))))
 
 (define %disk-space-warning
   ;; The fraction (between 0 and 1) of free disk space below which a warning
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 6b29c470fb..28864435df 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -226,18 +226,21 @@ matching URIs given in SOURCES."
          obj)))))
 
 (define (evaluate-replacement-specs specs proc)
-  "Parse SPECS, a list of strings like \"guile=guile@2.1\", and invoke PROC on
-each package pair specified by SPECS.  Return the resulting list.  Raise an
-error if an element of SPECS uses invalid syntax, or if a package it refers to
-could not be found."
+  "Parse SPECS, a list of strings like \"guile=guile@2.1\" and return a list
+of package spec/procedure pairs as expected by 'package-input-rewriting/spec'.
+PROC is called with the package to be replaced and its replacement according
+to SPECS.  Raise an error if an element of SPECS uses invalid syntax, or if a
+package it refers to could not be found."
   (define not-equal
     (char-set-complement (char-set #\=)))
 
   (map (lambda (spec)
          (match (string-tokenize spec not-equal)
-           ((old new)
-            (proc (specification->package old)
-                  (specification->package new)))
+           ((spec new)
+            (cons spec
+                  (let ((new (specification->package new)))
+                    (lambda (old)
+                      (proc old new)))))
            (x
             (leave (G_ "invalid replacement specification: ~s~%") spec))))
        specs))
@@ -248,8 +251,10 @@ dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
 strings like \"guile=guile@2.1\" meaning that, any dependency on a package
 called \"guile\" must be replaced with a dependency on a version 2.1 of
 \"guile\"."
-  (let* ((replacements (evaluate-replacement-specs replacement-specs cons))
-         (rewrite      (package-input-rewriting replacements)))
+  (let* ((replacements (evaluate-replacement-specs replacement-specs
+                                                   (lambda (old new)
+                                                     new)))
+         (rewrite      (package-input-rewriting/spec replacements)))
     (lambda (store obj)
       (if (package? obj)
           (rewrite obj)
@@ -260,41 +265,47 @@ called \"guile\" must be replaced with a dependency on a version 2.1 of
 dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
 strings like \"gnutls=gnutls@3.5.4\" meaning that packages are built using the
 current 'gnutls' package, after which version 3.5.4 is grafted onto them."
-  (define (replacement-pair old new)
-    (cons old
-          (package (inherit old) (replacement new))))
+  (define (set-replacement old new)
+    (package (inherit old) (replacement new)))
 
   (let* ((replacements (evaluate-replacement-specs replacement-specs
-                                                   replacement-pair))
-         (rewrite      (package-input-rewriting replacements)))
+                                                   set-replacement))
+         (rewrite      (package-input-rewriting/spec replacements)))
     (lambda (store obj)
       (if (package? obj)
           (rewrite obj)
           obj))))
 
+(define %not-equal
+  (char-set-complement (char-set #\=)))
+
+(define (package-git-url package)
+  "Return the URL of the Git repository for package, or raise an error if
+the source of PACKAGE is not fetched from a Git repository."
+  (let ((source (package-source package)))
+    (cond ((and (origin? source)
+                (git-reference? (origin-uri source)))
+           (git-reference-url (origin-uri source)))
+          ((git-checkout? source)
+           (git-checkout-url source))
+          (else
+           (leave (G_ "the source of ~a is not a Git reference~%")
+                  (package-full-name package))))))
+
 (define (evaluate-git-replacement-specs specs proc)
   "Parse SPECS, a list of strings like \"guile=stable-2.2\", and return a list
 of package pairs, where (PROC PACKAGE URL BRANCH-OR-COMMIT) returns the
 replacement package.  Raise an error if an element of SPECS uses invalid
 syntax, or if a package it refers to could not be found."
-  (define not-equal
-    (char-set-complement (char-set #\=)))
-
   (map (lambda (spec)
-         (match (string-tokenize spec not-equal)
-           ((name branch-or-commit)
-            (let* ((old    (specification->package name))
-                   (source (package-source old))
-                   (url    (cond ((and (origin? source)
-                                       (git-reference? (origin-uri source)))
-                                  (git-reference-url (origin-uri source)))
-                                 ((git-checkout? source)
-                                  (git-checkout-url source))
-                                 (else
-                                  (leave (G_ "the source of ~a is not a Git \
-reference~%")
-                                         (package-full-name old))))))
-              (cons old (proc old url branch-or-commit))))
+         (match (string-tokenize spec %not-equal)
+           ((spec branch-or-commit)
+            (define (replace old)
+              (let* ((source (package-source old))
+                     (url    (package-git-url old)))
+                (proc old url branch-or-commit)))
+
+            (cons spec replace))
            (x
             (leave (G_ "invalid replacement specification: ~s~%") spec))))
        specs))
@@ -307,13 +318,16 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using
   (define (replace old url branch)
     (package
       (inherit old)
-      (version (string-append "git." branch))
+      (version (string-append "git." (string-map (match-lambda
+                                                   (#\/ #\-)
+                                                   (chr chr))
+                                                 branch)))
       (source (git-checkout (url url) (branch branch)
                             (recursive? #t)))))
 
   (let* ((replacements (evaluate-git-replacement-specs replacement-specs
                                                        replace))
-         (rewrite      (package-input-rewriting replacements)))
+         (rewrite      (package-input-rewriting/spec replacements)))
     (lambda (store obj)
       (if (package? obj)
           (rewrite obj)
@@ -331,16 +345,42 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using
                               (if (< (string-length commit) 7)
                                   commit
                                   (string-take commit 7))))
-      (source (git-checkout (url url) (commit commit)))))
+      (source (git-checkout (url url) (commit commit)
+                            (recursive? #t)))))
 
   (let* ((replacements (evaluate-git-replacement-specs replacement-specs
                                                        replace))
-         (rewrite      (package-input-rewriting replacements)))
+         (rewrite      (package-input-rewriting/spec replacements)))
     (lambda (store obj)
       (if (package? obj)
           (rewrite obj)
           obj))))
 
+(define (transform-package-source-git-url replacement-specs)
+  "Return a procedure that, when passed a package, replaces its dependencies
+according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of strings like
+\"guile-json=https://gitthing.com/…\" meaning that packages are built using
+a checkout of the Git repository at the given URL."
+  (define replacements
+    (map (lambda (spec)
+           (match (string-tokenize spec %not-equal)
+             ((spec url)
+              (cons spec
+                    (lambda (old)
+                      (package
+                        (inherit old)
+                        (source (git-checkout (url url)
+                                              (recursive? #t)))))))))
+         replacement-specs))
+
+  (define rewrite
+    (package-input-rewriting/spec replacements))
+
+  (lambda (store obj)
+    (if (package? obj)
+        (rewrite obj)
+        obj)))
+
 (define %transformations
   ;; Transformations that can be applied to things to build.  The car is the
   ;; key used in the option alist, and the cdr is the transformation
@@ -350,7 +390,8 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using
     (with-input  . ,transform-package-inputs)
     (with-graft  . ,transform-package-inputs/graft)
     (with-branch . ,transform-package-source-branch)
-    (with-commit . ,transform-package-source-commit)))
+    (with-commit . ,transform-package-source-commit)
+    (with-git-url . ,transform-package-source-git-url)))
 
 (define %transformation-options
   ;; The command-line interface to the above transformations.
@@ -368,7 +409,9 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using
           (option '("with-branch") #t #f
                   (parser 'with-branch))
           (option '("with-commit") #t #f
-                  (parser 'with-commit)))))
+                  (parser 'with-commit))
+          (option '("with-git-url") #t #f
+                  (parser 'with-git-url)))))
 
 (define (show-transformation-options-help)
   (display (G_ "
@@ -385,23 +428,32 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using
                          build PACKAGE from the latest commit of BRANCH"))
   (display (G_ "
       --with-commit=PACKAGE=COMMIT
-                         build PACKAGE from COMMIT")))
+                         build PACKAGE from COMMIT"))
+  (display (G_ "
+      --with-git-url=PACKAGE=URL
+                         build PACKAGE from the repository at URL")))
 
 
 (define (options->transformation opts)
   "Return a procedure that, when passed an object to build (package,
 derivation, etc.), applies the transformations specified by OPTS."
   (define applicable
-    ;; List of applicable transformations as symbol/procedure pairs.
+    ;; List of applicable transformations as symbol/procedure pairs in the
+    ;; order in which they appear on the command line.
     (filter-map (match-lambda
-                  ((key . transform)
-                   (match (filter-map (match-lambda
-                                        ((k . arg)
-                                         (and (eq? k key) arg)))
-                                      opts)
-                     (()   #f)
-                     (args (cons key (transform args))))))
-                %transformations))
+                  ((key . value)
+                   (match (any (match-lambda
+                                 ((k . proc)
+                                  (and (eq? k key) proc)))
+                               %transformations)
+                     (#f
+                      #f)
+                     (transform
+                      ;; XXX: We used to pass TRANSFORM a list of several
+                      ;; arguments, but we now pass only one, assuming that
+                      ;; transform composes well.
+                      (cons key (transform (list value)))))))
+                (reverse opts)))
 
   (lambda (store obj)
     (fold (match-lambda*
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index 7d0ecb0a4d..b6287d3a4c 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -85,7 +85,9 @@ Display information about the channels currently in use.\n"))
         (format #t "~%GUIX_PACKAGE_PATH=\"~a\"~%" string))
        ('channels
         (format #t (G_ "~%;; warning: GUIX_PACKAGE_PATH=\"~a\"~%")
-                string))))))
+                string))
+       (_
+        (warning (G_ "'GUIX_PACKAGE_PATH' is set but it is not captured~%")))))))
 
 (define (channel->sexp channel)
   `(channel
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index e2ecddfbfc..e5502ef9ca 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -28,6 +28,7 @@
   #:use-module (guix store)
   #:use-module ((guix status) #:select (with-status-verbosity))
   #:use-module (guix grafts)
+  #:autoload   (guix inferior) (inferior-package?)
   #:use-module (guix monads)
   #:use-module (guix modules)
   #:use-module (guix packages)
@@ -305,11 +306,13 @@ added to the pack."
     (with-imported-modules (source-module-closure
                             '((guix build utils)
                               (guix build store-copy)
+                              (guix build union)
                               (gnu build install))
                             #:select? not-config?)
       #~(begin
           (use-modules (guix build utils)
                        (guix build store-copy)
+                       ((guix build union) #:select (relative-file-name))
                        (gnu build install)
                        (srfi srfi-1)
                        (srfi srfi-26)
@@ -358,18 +361,25 @@ added to the pack."
                    ,@(append-map
                       (match-lambda
                         ((source '-> target)
-                         (list "-p"
-                               (string-join
-                                ;; name s mode uid gid symlink
-                                (list source
-                                      "s" "777" "0" "0"
-                                      (string-append #$profile "/" target))))))
+                         ;; Create relative symlinks to work around a bug in
+                         ;; Singularity 2.x:
+                         ;;   https://bugs.gnu.org/34913
+                         ;;   https://github.com/sylabs/singularity/issues/1487
+                         (let ((target (string-append #$profile "/" target)))
+                           (list "-p"
+                                 (string-join
+                                  ;; name s mode uid gid symlink
+                                  (list source
+                                        "s" "777" "0" "0"
+                                        (relative-file-name (dirname source)
+                                                            target)))))))
                       '#$symlinks)
 
                    ;; Create empty mount points.
                    "-p" "/proc d 555 0 0"
                    "-p" "/sys d 555 0 0"
-                   "-p" "/dev d 555 0 0"))
+                   "-p" "/dev d 555 0 0"
+                   "-p" "/home d 555 0 0"))
 
           (when database
             ;; Initialize /var/guix.
@@ -517,10 +527,14 @@ please email '~a'~%")
 ;;;
 
 (define* (wrapped-package package
-                          #:optional (compiler (c-compiler)))
+                          #:optional (compiler (c-compiler))
+                          #:key proot?)
   (define runner
     (local-file (search-auxiliary-file "run-in-namespace.c")))
 
+  (define (proot)
+    (specification->package "proot-static"))
+
   (define build
     (with-imported-modules (source-module-closure
                             '((guix build utils)
@@ -550,10 +564,19 @@ please email '~a'~%")
               (("@STORE_DIRECTORY@") (%store-directory)))
 
             (let* ((base   (strip-store-prefix program))
-                   (result (string-append #$output "/" base)))
+                   (result (string-append #$output "/" base))
+                   (proot  #$(and proot?
+                                  #~(string-drop
+                                     #$(file-append (proot) "/bin/proot")
+                                     (+ (string-length (%store-directory))
+                                        1)))))
               (mkdir-p (dirname result))
-              (invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall"
-                      "run.c" "-o" result)
+              (apply invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall"
+                     "run.c" "-o" result
+                     (if proot
+                         (list (string-append "-DPROOT_PROGRAM=\""
+                                              proot "\""))
+                         '()))
               (delete-file "run.c")))
 
           (setvbuf (current-output-port) 'line)
@@ -573,7 +596,15 @@ please email '~a'~%")
                             (find-files #$(file-append package "/sbin"))
                             (find-files #$(file-append package "/libexec")))))))
 
-  (computed-file (string-append (package-full-name package "-") "R")
+  (computed-file (string-append
+                  (cond ((package? package)
+                         (package-full-name package "-"))
+                        ((inferior-package? package)
+                         (string-append (inferior-package-name package)
+                                        "-"
+                                        (inferior-package-version package)))
+                        (else "wrapper"))
+                  "R")
                  build))
 
 (define (map-manifest-entries proc manifest)
@@ -646,7 +677,12 @@ please email '~a'~%")
                    (exit 0)))
          (option '(#\R "relocatable") #f #f
                  (lambda (opt name arg result)
-                   (alist-cons 'relocatable? #t result)))
+                   (match (assq-ref result 'relocatable?)
+                     (#f
+                      (alist-cons 'relocatable? #t result))
+                     (_
+                      (alist-cons 'relocatable? 'proot
+                                  (alist-delete 'relocatable? result))))))
          (option '(#\e "expression") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'expression arg result)))
@@ -821,11 +857,14 @@ Create a bundle of PACKAGE.\n"))
                                           #:graft? (assoc-ref opts 'graft?))))
           (let* ((dry-run?    (assoc-ref opts 'dry-run?))
                  (relocatable? (assoc-ref opts 'relocatable?))
+                 (proot?      (eq? relocatable? 'proot))
                  (manifest    (let ((manifest (manifest-from-args store opts)))
                                 ;; Note: We cannot honor '--bootstrap' here because
                                 ;; 'glibc-bootstrap' lacks 'libc.a'.
                                 (if relocatable?
-                                    (map-manifest-entries wrapped-package manifest)
+                                    (map-manifest-entries
+                                     (cut wrapped-package <> #:proot? proot?)
+                                     manifest)
                                     manifest)))
                  (pack-format (assoc-ref opts 'format))
                  (name        (string-append (symbol->string pack-format)
@@ -851,7 +890,14 @@ Create a bundle of PACKAGE.\n"))
             (run-with-store store
               (mlet* %store-monad ((profile (profile-derivation
                                              manifest
-                                             #:relative-symlinks? relocatable?
+
+                                             ;; Always produce relative
+                                             ;; symlinks for Singularity (see
+                                             ;; <https://bugs.gnu.org/34913>).
+                                             #:relative-symlinks?
+                                             (or relocatable?
+                                                 (eq? 'squashfs pack-format))
+
                                              #:hooks (if bootstrap?
                                                          '()
                                                          %default-profile-hooks)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index efff511299..b0c6a7ced7 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
 ;;; Copyright © 2016 Benz Schenk <benz.schenk@uzh.ch>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -526,14 +527,14 @@ upgrading, #f otherwise."
   (define upgrade-regexps
     (filter-map (match-lambda
                   (('upgrade . regexp)
-                   (make-regexp* (or regexp "")))
+                   (make-regexp* (or regexp "") regexp/icase))
                   (_ #f))
                 opts))
 
   (define do-not-upgrade-regexps
     (filter-map (match-lambda
                   (('do-not-upgrade . regexp)
-                   (make-regexp* regexp))
+                   (make-regexp* regexp regexp/icase))
                   (_ #f))
                 opts))
 
@@ -686,7 +687,7 @@ processed, #f otherwise."
        #t)
 
       (('list-installed regexp)
-       (let* ((regexp    (and regexp (make-regexp* regexp)))
+       (let* ((regexp    (and regexp (make-regexp* regexp regexp/icase)))
               (manifest  (profile-manifest profile))
               (installed (manifest-entries manifest)))
          (leave-on-EPIPE
@@ -702,7 +703,7 @@ processed, #f otherwise."
          #t))
 
       (('list-available regexp)
-       (let* ((regexp    (and regexp (make-regexp* regexp)))
+       (let* ((regexp    (and regexp (make-regexp* regexp regexp/icase)))
               (available (fold-available-packages
                           (lambda* (name version result
                                          #:key outputs location
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index d67b9f8185..97508f4bd6 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -808,8 +808,17 @@ and TARGET arguments."
                  #~(begin
                      (use-modules (gnu build bootloader)
                                   (guix build utils)
-                                  (ice-9 binary-ports))
-                     (#$installer #$bootloader #$device #$target)))))
+                                  (ice-9 binary-ports)
+                                  (srfi srfi-34)
+                                  (srfi srfi-35))
+
+                     (guard (c ((message-condition? c) ;XXX: i18n
+                                (format (current-error-port) "error: ~a~%"
+                                        (condition-message c))
+                                (exit 1)))
+                       (#$installer #$bootloader #$device #$target)
+                       (format #t "bootloader successfully installed on '~a'~%"
+                               #$device))))))
 
 (define* (perform-action action os
                          #:key skip-safety-checks?
diff --git a/guix/tests.scm b/guix/tests.scm
index 749a4edd7a..35ebf8464d 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -39,6 +39,8 @@
             canonical-file?
             network-reachable?
             shebang-too-long?
+            with-environment-variable
+
             mock
             %test-substitute-urls
             test-assertm
@@ -195,6 +197,19 @@ store is opened."
       (run-with-store store exp
                       #:guile-for-build (%guile-for-build)))))
 
+(define-syntax-rule (with-environment-variable variable value body ...)
+  "Run BODY with VARIABLE set to VALUE."
+  (let ((orig (getenv variable)))
+    (dynamic-wind
+      (lambda ()
+        (setenv variable value))
+      (lambda ()
+        body ...)
+      (lambda ()
+        (if orig
+            (setenv variable orig)
+            (unsetenv variable))))))
+
 
 ;;;
 ;;; Narinfo files, as used by the substituter.