Merge branch 'master' into staging.

With conflicts resolved in:
	gnu/packages/version-control.scm

24 files changed, 229 insertions, 88 deletions

diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm
index 60c35eed07..912400a191 100644
--- a/guix/build-system/cargo.scm
+++ b/guix/build-system/cargo.scm
@@ -123,6 +123,7 @@ to NAME and VERSION."
   (gexp->derivation name builder
                     #:system system
                     #:target #f
+                    #:graft? #f
                     #:guile-for-build guile))
 
 (define (package-cargo-inputs p)
diff --git a/guix/build-system/copy.scm b/guix/build-system/copy.scm
index 4894ba46fb..6efc2b2766 100644
--- a/guix/build-system/copy.scm
+++ b/guix/build-system/copy.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2020 Pierre Neidhardt <mail@ambrevar.xyz>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2023 Jonathan Brielmaier <jonathan.brielmaier@web.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -94,6 +95,7 @@
                                  %standard-phases))
                      (system (%current-system))
                      (target #f)
+                     (substitutable? #t)
                      (imported-modules %copy-build-system-modules)
                      (modules '((guix build copy-build-system)
                                 (guix build utils))))
@@ -129,6 +131,8 @@
     (gexp->derivation name builder
                       #:system system
                       #:target #f
+                      #:substitutable? substitutable?
+                      #:graft? #f
                       #:guile-for-build guile)))
 
 (define copy-build-system
diff --git a/guix/build-system/dune.scm b/guix/build-system/dune.scm
index 12100fd8e8..3f81d21441 100644
--- a/guix/build-system/dune.scm
+++ b/guix/build-system/dune.scm
@@ -157,6 +157,7 @@ provides a 'setup.ml' file as its build system."
   (gexp->derivation name builder
                     #:system system
                     #:target #f
+                    #:graft? #f
                     #:guile-for-build guile))
 
 (define dune-build-system
diff --git a/guix/build-system/font.scm b/guix/build-system/font.scm
index 74dc80b5db..a99f76c66b 100644
--- a/guix/build-system/font.scm
+++ b/guix/build-system/font.scm
@@ -112,6 +112,7 @@
     (gexp->derivation name builder
                       #:system system
                       #:target #f
+                      #:graft? #f
                       #:guile-for-build guile)))
 
 (define font-build-system
diff --git a/guix/build-system/guile.scm b/guix/build-system/guile.scm
index 36a88e181a..ffc892260a 100644
--- a/guix/build-system/guile.scm
+++ b/guix/build-system/guile.scm
@@ -114,6 +114,7 @@
     (gexp->derivation name builder
                       #:system system
                       #:target #f
+                      #:graft? #f
                       #:guile-for-build guile)))
 
 (define* (guile-cross-build name
@@ -170,6 +171,7 @@
     (gexp->derivation name builder
                       #:system system
                       #:target target
+                      #:graft? #f
                       #:guile-for-build guile)))
 
 (define guile-build-system
diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm
index 9fee6c4570..b0bf8cb6e6 100644
--- a/guix/build-system/meson.scm
+++ b/guix/build-system/meson.scm
@@ -55,6 +55,7 @@ for TRIPLET."
                          ((target-x86-64? triplet) "x86_64")
                          ((target-arm32? triplet) "arm")
                          ((target-aarch64? triplet) "aarch64")
+                         ((target-mips64el? triplet) "mips64")
                          ((target-powerpc? triplet)
                           (if (target-64bit? triplet)
                               "ppc64"
diff --git a/guix/build-system/ocaml.scm b/guix/build-system/ocaml.scm
index b08985cd4d..921c1f8629 100644
--- a/guix/build-system/ocaml.scm
+++ b/guix/build-system/ocaml.scm
@@ -310,6 +310,7 @@ provides a 'setup.ml' file as its build system."
   (gexp->derivation name builder
                     #:system system
                     #:target #f
+                    #:graft? #f
                     #:guile-for-build guile))
 
 (define ocaml-build-system
diff --git a/guix/build-system/ruby.scm b/guix/build-system/ruby.scm
index 342daf7978..0aa273b4f4 100644
--- a/guix/build-system/ruby.scm
+++ b/guix/build-system/ruby.scm
@@ -114,6 +114,7 @@ NAME and VERSION."
     (gexp->derivation name build
                       #:system system
                       #:target #f
+                      #:graft? #f
                       #:modules imported-modules
                       #:guile-for-build guile)))
 
diff --git a/guix/build-system/scons.scm b/guix/build-system/scons.scm
index 7a02fa8a0f..9af24d40f8 100644
--- a/guix/build-system/scons.scm
+++ b/guix/build-system/scons.scm
@@ -121,6 +121,7 @@ provides a 'SConstruct' file as its build system."
   (gexp->derivation name builder
                     #:system system
                     #:target #f
+                    #:graft? #f
                     #:guile-for-build guile))
 
 (define scons-build-system
diff --git a/guix/build-system/texlive.scm b/guix/build-system/texlive.scm
index dbb72cd24a..336e192d83 100644
--- a/guix/build-system/texlive.scm
+++ b/guix/build-system/texlive.scm
@@ -182,6 +182,7 @@ level package ID."
     (gexp->derivation name builder
                       #:system system
                       #:target #f
+                      #:graft? #f
                       #:substitutable? substitutable?
                       #:guile-for-build guile)))
 
diff --git a/guix/build-system/waf.scm b/guix/build-system/waf.scm
index e8cd5520b8..1d520050f6 100644
--- a/guix/build-system/waf.scm
+++ b/guix/build-system/waf.scm
@@ -111,6 +111,7 @@ as its build system."
     (gexp->derivation name build
                       #:system system
                       #:target #f
+                      #:graft? #f
                       #:modules imported-modules
                       #:guile-for-build guile)))
 
diff --git a/guix/build/debug-link.scm b/guix/build/debug-link.scm
index f3284f74c4..80941df2fc 100644
--- a/guix/build/debug-link.scm
+++ b/guix/build/debug-link.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2023 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -175,7 +175,15 @@ directories."
                 outputs))
 
   (append-map (lambda (directory)
-                (filter elf-file?
+                (filter (lambda (file)
+                          (catch 'system-error
+                            (lambda ()
+                              (elf-file? file))
+                            (lambda args
+                              ;; FILE might be a dangling symlink.
+                              (if (= ENOENT (system-error-errno args))
+                                  #f
+                                  (apply throw args)))))
                         (with-error-to-port (%make-void-port "w")
                           (lambda ()
                             (find-files directory)))))
diff --git a/guix/build/dune-build-system.scm b/guix/build/dune-build-system.scm
index e9ccc71057..f311cd37f1 100644
--- a/guix/build/dune-build-system.scm
+++ b/guix/build/dune-build-system.scm
@@ -42,13 +42,13 @@
                    build-flags)))
   #t)
 
-(define* (check #:key (test-flags '()) (test-target "test") tests?
+(define* (check #:key (test-flags '()) tests?
                 (jbuild? #f) (package #f) (dune-release-flags '())
                 #:allow-other-keys)
   "Test the given package."
   (when tests?
     (let ((program (if jbuild? "jbuilder" "dune")))
-      (apply invoke program "runtest" test-target
+      (apply invoke program "runtest"
              (append (if package (list "-p" package)
                          dune-release-flags)
                      test-flags))))
diff --git a/guix/channels.scm b/guix/channels.scm
index d84228c47e..40cbc4bb3a 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
@@ -1057,7 +1057,9 @@ true, include its introduction, if any."
       (name ',(channel-name channel))
       (url ,(channel-url channel))
       (branch ,(channel-branch channel))
-      (commit ,(channel-commit channel))
+      ,@(if (channel-commit channel)
+            `((commit ,(channel-commit channel)))
+            '())
       ,@(if intro
             `((introduction (make-channel-introduction
                              ,(channel-introduction-first-signed-commit intro)
diff --git a/guix/download.scm b/guix/download.scm
index 2e9ecb43fc..fff54d7a17 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -112,22 +112,16 @@
       (sourceforge ; https://sourceforge.net/p/forge/documentation/Mirrors/
        "http://downloads.sourceforge.net/project/"
        "http://ufpr.dl.sourceforge.net/project/"
-       "http://heanet.dl.sourceforge.net/project/"
        "http://freefr.dl.sourceforge.net/project/"
        "http://internode.dl.sourceforge.net/project/"
        "http://jaist.dl.sourceforge.net/project/"
-       "http://kent.dl.sourceforge.net/project/"
        "http://liquidtelecom.dl.sourceforge.net/project/"
        ;; "http://nbtelecom.dl.sourceforge.net/project/"  ;never returns 404s
        "http://nchc.dl.sourceforge.net/project/"
-       "http://ncu.dl.sourceforge.net/project/"
        "http://netcologne.dl.sourceforge.net/project/"
        "http://netix.dl.sourceforge.net/project/"
        "http://pilotfiber.dl.sourceforge.net/project/"
-       "http://superb-sea2.dl.sourceforge.net/project/"
-       "http://tenet.dl.sourceforge.net/project/"
-       "http://vorboss.dl.sourceforge.net/project/"
-       "http://netassist.dl.sourceforge.net/project/")
+       "http://tenet.dl.sourceforge.net/project/")
       (netfilter.org ; https://www.netfilter.org/mirrors.html
        "http://ftp.netfilter.org/pub/"
        "ftp://ftp.es.netfilter.org/mirrors/netfilter/"
diff --git a/guix/import/opam.scm b/guix/import/opam.scm
index 29b2b886bf..938a88f69d 100644
--- a/guix/import/opam.scm
+++ b/guix/import/opam.scm
@@ -382,8 +382,8 @@ or #f on failure."
                       ,(list 'quasiquote `((upstream-name . ,name))))))
               (home-page ,(metadata-ref opam-content "homepage"))
               (synopsis ,(metadata-ref opam-content "synopsis"))
-              (description ,(beautify-description
-                             (metadata-ref opam-content "description")))
+              (description ,(and=> (metadata-ref opam-content "description")
+                                   beautify-description))
               (license ,(spdx-string->license
                          (metadata-ref opam-content "license"))))
            (filter
diff --git a/guix/inferior.scm b/guix/inferior.scm
index defdcc4e48..5dfd30a6c8 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018-2023 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -149,33 +149,47 @@ custom binary port)."
   ;; the REPL process wouldn't get EOF on standard input.
   (match (socketpair AF_UNIX (logior SOCK_STREAM SOCK_CLOEXEC) 0)
     ((parent . child)
-     (match (primitive-fork)
-       (0
-        (dynamic-wind
-          (lambda ()
-            #t)
-          (lambda ()
-            (close-port parent)
-            (close-fdes 0)
-            (close-fdes 1)
-            (close-fdes 2)
-            (dup2 (fileno child) 0)
-            (dup2 (fileno child) 1)
-            ;; Mimic 'open-pipe*'.
-            (if (file-port? (current-error-port))
-                (let ((error-port-fileno
-                       (fileno (current-error-port))))
-                  (unless (eq? error-port-fileno 2)
-                    (dup2 error-port-fileno
-                          2)))
-                (dup2 (open-fdes "/dev/null" O_WRONLY)
-                      2))
-            (apply execlp command command args))
-          (lambda ()
-            (primitive-_exit 127))))
-       (pid
-        (close-port child)
-        (values parent pid))))))
+     (if (defined? 'spawn)
+         (let* ((void (open-fdes "/dev/null" O_WRONLY))
+                (pid  (catch 'system-error
+                        (lambda ()
+                          (spawn command (cons command args)
+                                 #:input child
+                                 #:output child
+                                 #:error (if (file-port? (current-error-port))
+                                             (current-error-port)
+                                             void)))
+                        (const #f))))         ;can't exec, for instance ENOENT
+           (close-fdes void)
+           (close-port child)
+           (values parent pid))
+         (match (primitive-fork)                  ;Guile < 3.0.9
+           (0
+            (dynamic-wind
+              (lambda ()
+                #t)
+              (lambda ()
+                (close-port parent)
+                (close-fdes 0)
+                (close-fdes 1)
+                (close-fdes 2)
+                (dup2 (fileno child) 0)
+                (dup2 (fileno child) 1)
+                ;; Mimic 'open-pipe*'.
+                (if (file-port? (current-error-port))
+                    (let ((error-port-fileno
+                           (fileno (current-error-port))))
+                      (unless (eq? error-port-fileno 2)
+                        (dup2 error-port-fileno
+                              2)))
+                    (dup2 (open-fdes "/dev/null" O_WRONLY)
+                          2))
+                (apply execlp command command args))
+              (lambda ()
+                (primitive-_exit 127))))
+           (pid
+            (close-port child)
+            (values parent pid)))))))
 
 (define* (inferior-pipe directory command error-port)
   "Return two values: an input/output pipe on the Guix instance in DIRECTORY
diff --git a/guix/platform.scm b/guix/platform.scm
index f873913fe0..a2d95ab507 100644
--- a/guix/platform.scm
+++ b/guix/platform.scm
@@ -22,6 +22,8 @@
   #:use-module (guix records)
   #:use-module (guix ui)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:export (platform
             platform?
             platform-target
@@ -29,6 +31,10 @@
             platform-linux-architecture
             platform-glibc-dynamic-linker
 
+            &platform-not-found-error
+            platform-not-found-error?
+            false-if-platform-not-found
+
             platform-modules
             platforms
             lookup-platform-by-system
@@ -72,6 +78,20 @@
 
 
 ;;;
+;;; Exceptions.
+;;;
+(define-condition-type &platform-not-found-error &error
+  platform-not-found-error?
+  (target-or-system platform-not-found-error-target-or-system))
+
+(define-syntax-rule (false-if-platform-not-found exp)
+  "Evaluate EXP but return #f if it raises a platform-not-found-error?
+exception."
+  (guard (ex ((platform-not-found-error? ex) #f))
+    exp))
+
+
+;;;
 ;;; Platforms.
 ;;;
 
@@ -94,23 +114,32 @@
                                    (platform-modules)))))
 
 (define (lookup-platform-by-system system)
-  "Return the platform corresponding to the given SYSTEM."
-  (find (lambda (platform)
-          (let ((s (platform-system platform)))
-            (and (string? s) (string=? s system))))
-        (platforms)))
+  "Return the platform corresponding to the given SYSTEM.  Raise
+&PLATFORM-NOT-FOUND-ERROR when no platform could be found."
+  (or (find (lambda (platform)
+              (let ((s (platform-system platform)))
+                (and (string? s) (string=? s system))))
+            (platforms))
+      (raise-exception (condition (&platform-not-found-error
+                                   (target-or-system system))))))
 
 (define (lookup-platform-by-target target)
-  "Return the platform corresponding to the given TARGET."
-  (find (lambda (platform)
-          (let ((t (platform-target platform)))
-            (and (string? t) (string=? t target))))
-        (platforms)))
+  "Return the platform corresponding to the given TARGET.  Raise
+&PLATFORM-NOT-FOUND-ERROR when no platform could be found."
+  (or (find (lambda (platform)
+              (let ((t (platform-target platform)))
+                (and (string? t) (string=? t target))))
+            (platforms))
+      (raise-exception (condition (&platform-not-found-error
+                                   (target-or-system target))))))
 
 (define (lookup-platform-by-target-or-system target-or-system)
-  "Return the platform corresponding to the given TARGET or SYSTEM."
-  (or (lookup-platform-by-target target-or-system)
-      (lookup-platform-by-system target-or-system)))
+  "Return the platform corresponding to the given TARGET or SYSTEM.  Raise
+&PLATFORM-NOT-FOUND-ERROR when no platform could be found."
+  (or (false-if-platform-not-found (lookup-platform-by-target target-or-system))
+      (false-if-platform-not-found (lookup-platform-by-system target-or-system))
+      (raise-exception (condition (&platform-not-found-error
+                                   (target-or-system target-or-system))))))
 
 (define (platform-system->target system)
   "Return the target matching the given SYSTEM if it exists or false
diff --git a/guix/scripts/container/exec.scm b/guix/scripts/container/exec.scm
index 51b616b384..3e70b1d3c2 100644
--- a/guix/scripts/container/exec.scm
+++ b/guix/scripts/container/exec.scm
@@ -102,4 +102,12 @@ and the other containing arguments for the command to be executed."
                                        environment)
                              (apply execlp program program program-args)))))))
           (unless (zero? result)
-            (leave (G_ "exec failed with status ~d~%") result)))))))
+            (match (status:exit-val result)
+              (#f
+               (if (status:term-sig result)
+                   (leave (G_ "process terminated with signal ~a~%")
+                          (status:term-sig result))
+                   (leave (G_ "process stopped with signal ~a~%")
+                          (status:stop-sig result))))
+              (code
+               (leave (G_ "process exited with status ~d~%") code)))))))))
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index c7fd8fd340..46435ae48e 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -1,8 +1,8 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2018 David Thompson <davet@gnu.org>
-;;; Copyright © 2015-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org>
-;;; Copyright © 2022 John Kehayias <john.kehayias@protonmail.com>
+;;; Copyright © 2022, 2023 John Kehayias <john.kehayias@protonmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -475,10 +475,13 @@ cache."
      (catch 'system-error
        (lambda ()
          (when emulate-fhs?
-           ;; When running in a container with EMULATE-FHS?, override $PATH
+           ;; When running in a container with EMULATE-FHS?, augment $PATH
            ;; (optional, but to better match FHS expectations), and generate
            ;; /etc/ld.so.cache.
-           (setenv "PATH" "/bin:/usr/bin:/sbin:/usr/sbin")
+           (setenv "PATH" (string-append "/bin:/usr/bin:/sbin:/usr/sbin"
+                                         (if (getenv "PATH")
+                                             (string-append ":" (getenv "PATH"))
+                                             "")))
            (invoke "ldconfig" "-X"))
          (apply execlp program program args))
        (lambda _
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 2f102180c9..6847dd1962 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -569,6 +569,12 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
   (category packaging)
   (synopsis "view and query package dependency graphs")
 
+  (define (shorter? str1 str2)
+    (< (string-length str1) (string-length str2)))
+
+  (define length-sorted
+    (cut sort <> shorter?))
+
   (with-error-handling
     (define opts
       (parse-command-line args %options
@@ -598,13 +604,17 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
 
         (run-with-store store
           ;; XXX: Since grafting can trigger unsolicited builds, disable it.
-          (mlet %store-monad ((_     (set-grafting #f))
+          (mlet %store-monad ((_g    (set-grafting #f))
                               (nodes (mapm %store-monad
                                            (node-type-convert type)
                                            (reverse items))))
             (if (assoc-ref opts 'path?)
+                ;; Sort by string length such that, in case of multiple
+                ;; outputs, the shortest one (which corresponds to "out") is
+                ;; picked (yup, a hack).
                 (match nodes
-                  (((node1 _ ...) (node2 _ ...))
+                  (((= length-sorted (node1 _ ...))
+                    (= length-sorted (node2 _ ...)))
                    (display-path node1 node2 type))
                   (_
                    (leave (G_ "'--path' option requires exactly two \
diff --git a/guix/scripts/repl.scm b/guix/scripts/repl.scm
index 50d18c7760..787c63d48e 100644
--- a/guix/scripts/repl.scm
+++ b/guix/scripts/repl.scm
@@ -52,12 +52,19 @@
         (option '(#\t "type") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'type (string->symbol arg) result)))
+        (option '("list-types") #f #f
+                (lambda (opt name arg result)
+                  (display (string-join '("guile" "machine") "\n" 'suffix))
+                  (exit 0)))
         (option '("listen") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'listen arg result)))
         (option '(#\q) #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'ignore-dot-guile? #t result)))
+        (option '(#\i "interactive") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'interactive? #t result)))
         (option '(#\L "load-path") #t #f
                 (lambda (opt name arg result)
                   ;; XXX: Imperatively modify the search paths.
@@ -71,6 +78,8 @@
 In the Guix execution environment, run FILE as a Guile script with
 command-line arguments ARGS.  If no FILE is given, start a Guile REPL.\n"))
   (display (G_ "
+      --list-types       display REPL types and exit"))
+  (display (G_ "
   -t, --type=TYPE        start a REPL of the given TYPE"))
   (display (G_ "
       --listen=ENDPOINT  listen to ENDPOINT instead of standard input"))
@@ -78,6 +87,9 @@ command-line arguments ARGS.  If no FILE is given, start a Guile REPL.\n"))
   -q                     inhibit loading of ~/.guile"))
   (newline)
   (display (G_ "
+  -i, --interactive      launch REPL after evaluating FILE"))
+  (newline)
+  (display (G_ "
   -L, --load-path=DIR    prepend DIR to the package module search path"))
   (newline)
   (display (G_ "
@@ -190,7 +202,7 @@ call THUNK."
          ;; file in %LOAD-PATH.  Thus, pass (getcwd) instead of ".".
          (load-in-vicinity (getcwd) (car script)))))
 
-    (when (null? script)
+    (when (or (null? script) (assoc-ref opts 'interactive?))
       ;; Start REPL
       (let ((type (assoc-ref opts 'type)))
         (call-with-connection (assoc-ref opts 'listen)
diff --git a/guix/transformations.scm b/guix/transformations.scm
index bf9639020b..8ff472ad21 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -757,35 +757,72 @@ additional patches."
         (rewrite obj)
         obj)))
 
+(define* (package-with-upstream-version p #:optional version)
+  "Return package P changed to use the given upstream VERSION or, if VERSION
+is #f, the latest known upstream version."
+  (let ((source (package-latest-release p #:version version)))
+    (cond ((not source)
+           (if version
+               (warning
+                (G_ "could not find version ~a of '~a' upstream~%")
+                version (package-name p))
+               (warning
+                (G_ "could not determine latest upstream release of '~a'~%")
+                (package-name p)))
+           p)
+          ((string=? (upstream-source-version source)
+                     (package-version p))
+           (unless version
+             (info (G_ "~a is already the latest version of '~a'~%")
+                   (package-version p) (package-name p)))
+           p)
+          (else
+           (when (version>? (package-version p)
+                            (upstream-source-version source))
+             (warning (G_ "using ~a ~a, which is older than the packaged \
+version (~a)~%")
+                      (package-name p)
+                      (upstream-source-version source)
+                      (package-version p)))
+
+           (unless (pair? (upstream-source-signature-urls source))
+             (warning (G_ "cannot authenticate source of '~a', version ~a~%")
+                      (package-name p)
+                      (upstream-source-version source)))
+
+           ;; TODO: Take 'upstream-source-input-changes' into account.
+           (package
+             (inherit p)
+             (version (upstream-source-version source))
+             (source source))))))
+
 (define (transform-package-latest specs)
   "Return a procedure that rewrites package graphs such that those in SPECS
 are replaced by their latest upstream version."
-  (define (package-with-latest-upstream p)
-    (let ((source (package-latest-release p)))
-      (cond ((not source)
-             (warning
-              (G_ "could not determine latest upstream release of '~a'~%")
-              (package-name p))
-             p)
-            ((string=? (upstream-source-version source)
-                       (package-version p))
-             p)
-            (else
-             (unless (pair? (upstream-source-signature-urls source))
-               (warning (G_ "cannot authenticate source of '~a', version ~a~%")
-                        (package-name p)
-                        (upstream-source-version source)))
-
-             ;; TODO: Take 'upstream-source-input-changes' into account.
-             (package
-               (inherit p)
-               (version (upstream-source-version source))
-               (source source))))))
+  (define rewrite
+    (package-input-rewriting/spec
+     (map (lambda (spec)
+            (cons spec package-with-upstream-version))
+          specs)))
 
+  (lambda (obj)
+    (if (package? obj)
+        (rewrite obj)
+        obj)))
+
+(define (transform-package-version specs)
+  "Return a procedure that rewrites package graphs such that those in SPECS
+are replaced by the specified upstream version."
   (define rewrite
     (package-input-rewriting/spec
      (map (lambda (spec)
-            (cons spec package-with-latest-upstream))
+            (match (string-tokenize spec %not-equal)
+              ((spec version)
+               (cons spec (cut package-with-upstream-version <> version)))
+              (_
+               (raise (formatted-message
+                       (G_ "~a: invalid upstream version specification")
+                       spec)))))
           specs)))
 
   (lambda (obj)
@@ -809,7 +846,8 @@ are replaced by their latest upstream version."
     (with-debug-info . ,transform-package-with-debug-info)
     (without-tests . ,transform-package-tests)
     (with-patch  . ,transform-package-patches)
-    (with-latest . ,transform-package-latest)))
+    (with-latest . ,transform-package-latest)
+    (with-version . ,transform-package-version)))
 
 (define (transformation-procedure key)
   "Return the transformation procedure associated with KEY, a symbol such as
@@ -881,6 +919,8 @@ building for ~a instead of ~a, so tuning cannot be guessed~%")
                   (parser 'with-patch))
           (option '("with-latest") #t #f
                   (parser 'with-latest))
+          (option '("with-version") #t #f
+                  (parser 'with-version))
 
           (option '("help-transform") #f #f
                   (lambda _
@@ -916,6 +956,9 @@ building for ~a instead of ~a, so tuning cannot be guessed~%")
       --with-latest=PACKAGE
                          use the latest upstream release of PACKAGE"))
   (display (G_ "
+      --with-version=PACKAGE=VERSION
+                         use the given upstream VERSION of PACKAGE"))
+  (display (G_ "
       --with-c-toolchain=PACKAGE=TOOLCHAIN
                          build PACKAGE and its dependents with TOOLCHAIN"))
   (display (G_ "
diff --git a/guix/ui.scm b/guix/ui.scm
index f26c4534aa..9f81ff3b8e 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -591,6 +591,9 @@ FILE."
 (set! execlp
   (error-reporting-wrapper execlp (filename . args) filename))
 
+(set! mkdir
+  (error-reporting-wrapper mkdir (directory . args) directory))
+
 (define (make-regexp* regexp . flags)
   "Like 'make-regexp' but error out if REGEXP is invalid, reporting the error
 nicely."