Merge branch 'master' into gnome-team

15 files changed, 192 insertions, 68 deletions

diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm
index f52e3f7af5..7d1b0e0e23 100644
--- a/guix/build/qt-utils.scm
+++ b/guix/build/qt-utils.scm
@@ -90,7 +90,7 @@
     '("XDG_CONFIG_DIRS" suffix directory "/etc/xdg")
     `("QT_PLUGIN_PATH" prefix directory
       ,(format #f "/lib/qt~a/plugins" qt-major-version))
-    `("QML2_IMPORT_PATH" = directory
+    `("QML2_IMPORT_PATH" prefix directory
       ,(format #f "/lib/qt~a/qml" qt-major-version))
     ;; QTWEBENGINEPROCESS_PATH accepts a single value, which makes 'exact the
     ;; most suitable environment variable type for it.
diff --git a/guix/git.scm b/guix/git.scm
index be20cde019..dbc3b7caa7 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -439,7 +439,7 @@ could not be fetched from Software Heritage~%")
                                    #:recursive? recursive?)))
   "Update the cached checkout of URL to REF in CACHE-DIRECTORY.  Return three
 values: the cache directory name, and the SHA1 commit (a string) corresponding
-to REF, and the relation of the new commit relative to STARTING-COMMIT (if
+to REF, and the relation of STARTING-COMMIT relative to the new commit (if
 provided) as returned by 'commit-relation'.
 
 REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value
diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm
index b5a812b34e..7e79c77884 100644
--- a/guix/import/texlive.scm
+++ b/guix/import/texlive.scm
@@ -101,6 +101,7 @@
     ("cc-by-sa-3" 'cc-by-sa3.0)
     ("cc-by-sa-4" 'cc-by-sa4.0)
     ("mit" 'expat)
+    ("x11" 'x11)
     ("fdl" 'fdl1.3+)
     ;; The GUST Font Nosource License, which is legally equivalent to
     ;; lppl1.3c+, is no longer in use (per
@@ -298,7 +299,7 @@ When TEXLIVE-ONLY is true, only TeX Live packages are returned."
 (define (linked-scripts name package-database)
   "Return a list of script names to symlink from \"bin/\" directory for
 package NAME according to PACKAGE-DATABASE.  Consider as scripts files with
-\".lua\", \".pl\", \".py\", \".sh\", \".tcl\", \".texlua\", \".tlu\"
+\".lua\", \".pl\", \".py\", \".rb\", \".sh\", \".tcl\", \".texlua\", \".tlu\"
 extensions, and files without extension."
   (and-let* ((data (assoc-ref package-database name))
              ;; Check if binaries are associated to the package.
@@ -317,7 +318,8 @@ extensions, and files without extension."
     (filter-map (lambda (script)
                   (and (any (lambda (ext)
                               (member (basename script ext) binaries))
-                            '(".lua" ".pl" ".py" ".sh" ".tcl" ".texlua" ".tlu"))
+                            '(".lua" ".pl" ".py" ".rb" ".sh" ".tcl" ".texlua"
+                              ".tlu"))
                        (basename script)))
                 ;; Get the right (alphabetic) order.
                 (reverse scripts))))
@@ -476,6 +478,7 @@ of those files are returned that are unexpectedly installed."
           ,@(match (append-map (lambda (s)
                                  (cond ((string-suffix? ".pl" s) '(perl))
                                        ((string-suffix? ".py" s) '(python))
+                                       ((string-suffix? ".rb" s) '(ruby))
                                        ((string-suffix? ".tcl" s) '(tcl tk))
                                        (else '())))
                                (or scripts '()))
@@ -499,7 +502,7 @@ of those files are returned that are unexpectedly installed."
           (license
            ,(cond
              (meta-package?
-              '(license:fsf-free "https://www.tug.org/texlive/copying.html"))
+              '(fsf-free "https://www.tug.org/texlive/copying.html"))
              ((assoc-ref data 'catalogue-license) => string->license)
              (else #f))))
        (translate-depends depends #t)))))
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 257570e95b..fcd7707482 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -179,6 +179,7 @@ thrown."
     ("AGPL-3.0"                   . license:agpl3)
     ("AGPL-3.0-only"              . license:agpl3)
     ("AGPL-3.0-or-later"          . license:agpl3+)
+    ("Arphic-1999"                . license:arphic-1999)
     ("Apache-1.1"                 . license:asl1.1)
     ("Apache-2.0"                 . license:asl2.0)
     ("APSL-2.0"                   . license:apsl2)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 5dfd30a6c8..fca6fb4b22 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -871,11 +871,15 @@ prefix, resolve it; and if 'commit' is unset, fetch CHANNEL's branch tip."
                                   #:key
                                   (authenticate? #t)
                                   (cache-directory (%inferior-cache-directory))
-                                  (ttl (* 3600 24 30)))
+                                  (ttl (* 3600 24 30))
+                                  validate-channels)
   "Return a directory containing a guix filetree defined by CHANNELS, a list of channels.
-The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds.
-This procedure opens a new connection to the build daemon.  AUTHENTICATE?
-determines whether CHANNELS are authenticated."
+The directory is a subdirectory of CACHE-DIRECTORY, where entries can be
+reclaimed after TTL seconds.  This procedure opens a new connection to the
+build daemon.  AUTHENTICATE? determines whether CHANNELS are authenticated.
+VALIDATE-CHANNELS, if specified, must be a one argument procedure accepting a
+list of channels that can be used to validate the channels; it should raise an
+exception in case of problems."
   (define commits
     ;; Since computing the instances of CHANNELS is I/O-intensive, use a
     ;; cheaper way to get the commit list of CHANNELS.  This limits overhead
@@ -923,27 +927,30 @@ determines whether CHANNELS are authenticated."
 
   (if (file-exists? cached)
       cached
-      (run-with-store store
-        (mlet* %store-monad ((instances
-                              -> (latest-channel-instances store channels
-                                                           #:authenticate?
-                                                           authenticate?))
-                             (profile
-                              (channel-instances->derivation instances)))
-          (mbegin %store-monad
-            ;; It's up to the caller to install a build handler to report
-            ;; what's going to be built.
-            (built-derivations (list profile))
-
-            ;; Cache if and only if AUTHENTICATE? is true.
-            (if authenticate?
-                (mbegin %store-monad
-                  (symlink* (derivation->output-path profile) cached)
-                  (add-indirect-root* cached)
-                  (return cached))
-                (mbegin %store-monad
-                  (add-temp-root* (derivation->output-path profile))
-                  (return (derivation->output-path profile)))))))))
+      (begin
+        (when (procedure? validate-channels)
+          (validate-channels channels))
+        (run-with-store store
+          (mlet* %store-monad ((instances
+                                -> (latest-channel-instances store channels
+                                                             #:authenticate?
+                                                             authenticate?))
+                               (profile
+                                (channel-instances->derivation instances)))
+            (mbegin %store-monad
+              ;; It's up to the caller to install a build handler to report
+              ;; what's going to be built.
+              (built-derivations (list profile))
+
+              ;; Cache if and only if AUTHENTICATE? is true.
+              (if authenticate?
+                  (mbegin %store-monad
+                    (symlink* (derivation->output-path profile) cached)
+                    (add-indirect-root* cached)
+                    (return cached))
+                  (mbegin %store-monad
+                    (add-temp-root* (derivation->output-path profile))
+                    (return (derivation->output-path profile))))))))))
 
 (define* (inferior-for-channels channels
                                 #:key
diff --git a/guix/licenses.scm b/guix/licenses.scm
index 10f36b02f9..d200614d91 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -42,6 +42,7 @@
             afl2.1
             agpl1 agpl3 agpl3+
             apsl2
+            arphic-1999
             asl1.1 asl2.0
             boost1.0
             bsd-0 bsd-1 bsd-2 bsd-3 bsd-4
@@ -197,6 +198,14 @@ cases, reduces to #t at macro-expansion time."
            "https://directory.fsf.org/wiki/License:APSL-2.0"
            "https://www.gnu.org/licenses/license-list.html#apsl2"))
 
+;; This is a copyleft free software license, incompatible with the GPL.  Its
+;; normal use is for fonts, and in that use, the incompatibility does not
+;; cause a problem.
+(define arphic-1999
+  (license "Arphic Public License"
+           "https://directory.fsf.org/wiki/License:Arphic-PL"
+           "https://www.gnu.org/licenses/license-list.html#Arphic"))
+
 (define asl1.1
   (license "ASL 1.1"
            "http://directory.fsf.org/wiki/License:Apache1.1"
diff --git a/guix/platforms/powerpc.scm b/guix/platforms/powerpc.scm
index 9d0b343bc3..1c7141ab42 100644
--- a/guix/platforms/powerpc.scm
+++ b/guix/platforms/powerpc.scm
@@ -20,6 +20,7 @@
   #:use-module (guix platform)
   #:use-module (guix records)
   #:export (powerpc-linux
+            powerpc64-linux
             powerpc64le-linux))
 
 (define powerpc-linux
@@ -29,6 +30,13 @@
    (linux-architecture "powerpc")
    (glibc-dynamic-linker "/lib/ld.so.1")))
 
+(define powerpc64-linux
+  (platform
+   (target "powerpc64-linux-gnu")
+   (system #f)                                    ;not supported
+   (linux-architecture "powerpc")
+   (glibc-dynamic-linker "/lib/ld64.so.1")))
+
 (define powerpc64le-linux
   (platform
    (target "powerpc64le-linux-gnu")
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 4835def536..6fa68fc6ac 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1787,6 +1787,11 @@ MANIFEST."
            (cons (gexp-input thing output)
                  (append-map entry->texlive-input deps))
            '()))))
+  (define texlive-scripts-entry?
+    (match-lambda
+      (($ <manifest-entry> name version output thing deps)
+       (or (string=? "texlive-scripts" name)
+           (any texlive-scripts-entry? deps)))))
   (define texlive-inputs
     (append-map entry->texlive-input (manifest-entries manifest)))
   (define texlive-scripts
@@ -1815,9 +1820,12 @@ MANIFEST."
                        #:create-all-directories? #t
                        #:log-port (%make-void-port "w"))
 
-          ;; Clear files that are going to be regenerated.
+          ;; Clear files that are going to be regenerated, or copied from
+          ;; a different place, in order to prevent failures during profile
+          ;; generation.
           (with-directory-excursion "/tmp/texlive/share/texmf-dist"
-            (for-each delete-file
+            (for-each (lambda (file)
+                        (when (file-exists? file) (delete-file file)))
                       (list "fonts/map/dvipdfmx/updmap/kanjix.map"
                             "fonts/map/dvips/updmap/builtin35.map"
                             "fonts/map/dvips/updmap/download35.map"
@@ -1884,9 +1892,11 @@ MANIFEST."
               (copy-recursively a b)
               (invoke mktexlsr b)
               (install-file (string-append b "/ls-R") a))))))
-
   (with-monad %store-monad
-    (if (pair? texlive-inputs)
+    ;; `texlive-scripts' brings essential files to generate font maps.
+    ;; Therefore, it must be present in the profile.  This check prevents
+    ;; incomplete modular TeX Live installations to generate errors.
+    (if (any texlive-scripts-entry? (manifest-entries manifest))
         (gexp->derivation "texlive-font-maps" build
                           #:substitutable? #f
                           #:local-build? #t
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index fbd5689be8..e0800bc062 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -330,6 +330,10 @@ immediately.  Return the exit status of the process in the container."
                  (display "127.0.0.1 localhost\n" port)
                  (chmod port #o444))))
 
+           ;; Create /tmp; bits of code expect it, such as
+           ;; 'least-authority-wrapper'.
+           (mkdir-p "/tmp")
+
            ;; Set PATH for things that the activation script might expect, such
            ;; as "env".
            (load-profile #$system-profile)
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index ecd264d3fa..759c3a94a3 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -85,6 +85,9 @@ Download and deploy the latest version of Guix.\n"))
   (display (G_ "
   -C, --channels=FILE    deploy the channels defined in FILE"))
   (display (G_ "
+  -q, --no-channel-files
+                         inhibit loading of user and system 'channels.scm'"))
+  (display (G_ "
       --url=URL          download \"guix\" channel from the Git repository at URL"))
   (display (G_ "
       --commit=COMMIT    download the specified \"guix\" channel COMMIT"))
@@ -133,6 +136,9 @@ Download and deploy the latest version of Guix.\n"))
   (cons* (option '(#\C "channels") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'channel-file arg result)))
+         (option '(#\q "no-channel-files") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'ignore-channel-files? #t result)))
          (option '(#\l "list-generations") #f #t
                  (lambda (opt name arg result)
                    (cons `(query list-generations ,arg)
@@ -166,7 +172,7 @@ Download and deploy the latest version of Guix.\n"))
                                (alist-delete 'repository-url result))))
          (option '("commit") #t #f
                  (lambda (opt name arg result)
-                   (alist-cons 'ref `(commit . ,arg) result)))
+                   (alist-cons 'ref `(tag-or-commit . ,arg) result)))
          (option '("branch") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'ref `(branch . ,arg) result)))
@@ -735,6 +741,9 @@ transformations specified in OPTS (resulting from '--url', '--commit', or
   (define file
     (assoc-ref opts 'channel-file))
 
+  (define ignore-channel-files?
+    (assoc-ref opts 'ignore-channel-files?))
+
   (define default-file
     (string-append (config-directory) "/channels.scm"))
 
@@ -750,9 +759,11 @@ transformations specified in OPTS (resulting from '--url', '--commit', or
   (define channels
     (cond (file
            (load-channels file))
-          ((file-exists? default-file)
+          ((and (not ignore-channel-files?)
+                (file-exists? default-file))
            (load-channels default-file))
-          ((file-exists? global-file)
+          ((and (not ignore-channel-files?)
+                (file-exists? global-file))
            (load-channels global-file))
           (else
            %default-channels)))
@@ -774,7 +785,8 @@ Use '~/.config/guix/channels.scm' instead."))
                (if (guix-channel? c)
                    (let ((url (or url (channel-url c))))
                      (match ref
-                       (('commit . commit)
+                       ((or ('commit . commit)
+                            ('tag-or-commit . commit))
                         (channel (inherit c)
                                  (url url) (commit commit) (branch #f)))
                        (('branch . branch)
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index a9241aa20d..f39dc743b1 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -10,6 +10,7 @@
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2023 Maxim Cournoyer maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -106,6 +107,9 @@
         (option '(#\m "manifest") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'manifest arg result)))
+        (option '("target-version") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'target-version arg result)))
         (option '(#\e "expression") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'expression arg result)))
@@ -165,6 +169,9 @@ specified with `--select'.\n"))
   (display (G_ "
   -m, --manifest=FILE    select all the packages from the manifest in FILE"))
   (display (G_ "
+      --target-version=VERSION
+                         update the package or packages to VERSION"))
+  (display (G_ "
   -t, --type=UPDATER,... restrict to updates from the specified updaters
                          (e.g., 'gnu')"))
   (display (G_ "
@@ -213,17 +220,20 @@ specified with `--select'.\n"))
 (define* (update-spec package #:optional version)
   (%update-spec package version))
 
-(define (update-specification->update-spec spec)
+(define (update-specification->update-spec spec fallback-version)
   "Given SPEC, a package name like \"guile@2.0=2.0.8\", return a <update>
-record with two fields: the package to upgrade, and the target version."
+record with two fields: the package to upgrade, and the target version.  When
+SPEC lacks a version, use FALLBACK-VERSION."
   (match (string-rindex spec #\=)
-    (#f  (update-spec (specification->package spec) #f))
+    (#f  (update-spec (specification->package spec) fallback-version))
     (idx (update-spec (specification->package (substring spec 0 idx))
                       (substring spec (1+ idx))))))
 
 (define (options->update-specs opts)
   "Return the list of <update-spec> records requested by OPTS, honoring
 options like '--recursive'."
+  (define target-version (assoc-ref opts 'target-version))
+
   (define core-package?
     (let* ((input->package (match-lambda
                              ((name (? package? package) _ ...) package)
@@ -263,13 +273,18 @@ update would trigger a complete rebuild."
     ;; Update specs explicitly passed as command-line arguments.
     (match (append-map (match-lambda
                          (('argument . spec)
-                          ;; Take either the specified version or the
-                          ;; latest one.
-                          (list (update-specification->update-spec spec)))
+                          ;; Take either the specified version or the latest
+                          ;; one.  The version specified as part of a spec
+                          ;; takes precedence, with the command-line specified
+                          ;; --target-version used as a fallback.
+                          (list (update-specification->update-spec
+                                 spec target-version)))
                          (('expression . exp)
-                          (list (update-spec (read/eval-package-expression exp))))
+                          (list (update-spec (read/eval-package-expression exp)
+                                             target-version)))
                          (('manifest . manifest)
-                          (map update-spec (packages-from-manifest manifest)))
+                          (map (cut update-spec <> target-version)
+                               (packages-from-manifest manifest)))
                          (_
                           '()))
                        opts)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index f1154dad33..acbe3dab2c 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -686,7 +686,10 @@ checking this by themselves in their 'check' procedure."
          (find-partition-by-label (file-system-label->string device))))))
 
   (define file-systems
-    (filter file-system-needed-for-boot?
+    (filter (lambda (file-system)
+              (and (file-system-needed-for-boot? file-system)
+                   (not (member (file-system-type file-system)
+                                %pseudo-file-system-types))))
             (operating-system-file-systems os)))
 
   (for-each (lambda (fs)
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 9948df0ca6..ff6242ffb4 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -186,22 +186,22 @@ services as defined by OS."
                      #:target-type shepherd-root-service-type))))
 
   (mlet* %store-monad ((live-services (running-services eval)))
-    (let ((to-unload to-restart
-                     (shepherd-service-upgrade live-services target-services)))
-      (let* ((to-unload  (map live-service-canonical-name to-unload))
-             (to-restart (map shepherd-service-canonical-name to-restart))
-             (running    (map live-service-canonical-name
-                              (filter live-service-running live-services)))
-             (to-start   (lset-difference eqv?
-                                          (map shepherd-service-canonical-name
-                                               target-services)
-                                          running))
-             (service-files (map shepherd-service-file target-services)))
-        (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
-                  (primitive-load #$(upgrade-services-program service-files
-                                                              to-start
-                                                              to-unload
-                                                              to-restart))))))))
+    (let* ((to-unload to-restart
+                      (shepherd-service-upgrade live-services target-services))
+           (to-unload  (map live-service-canonical-name to-unload))
+           (to-restart (map shepherd-service-canonical-name to-restart))
+           (running    (map live-service-canonical-name
+                            (filter live-service-running live-services)))
+           (to-start   (lset-difference eqv?
+                                        (map shepherd-service-canonical-name
+                                             target-services)
+                                        running))
+           (service-files (map shepherd-service-file target-services)))
+      (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
+                (primitive-load #$(upgrade-services-program service-files
+                                                            to-start
+                                                            to-unload
+                                                            to-restart)))))))
 
 
 ;;;
diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm
index d7c71ef705..87000d82ec 100644
--- a/guix/scripts/time-machine.scm
+++ b/guix/scripts/time-machine.scm
@@ -1,7 +1,8 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Konrad Hinsen <konrad.hinsen@fastmail.net>
-;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2021, 2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,13 +20,15 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix scripts time-machine)
+  #:use-module (guix channels)
+  #:use-module (guix diagnostics)
   #:use-module (guix ui)
   #:use-module (guix scripts)
   #:use-module (guix inferior)
   #:use-module (guix store)
   #:use-module (guix status)
   #:use-module ((guix git)
-                #:select (with-git-error-handling))
+                #:select (update-cached-checkout with-git-error-handling))
   #:use-module ((guix utils)
                 #:select (%current-system))
   #:use-module ((guix scripts pull)
@@ -38,9 +41,17 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-71)
   #:export (guix-time-machine))
 
+;;; The required inferiors mechanism relied on by 'guix time-machine' was
+;;; firmed up in v1.0.0; it is the oldest, safest commit that can be travelled
+;;; to.
+(define %oldest-possible-commit
+  "6298c3ffd9654d3231a6f25390b056483e8f407c") ;v1.0.0
+
 
 ;;;
 ;;; Command-line options.
@@ -52,6 +63,9 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
   (display (G_ "
   -C, --channels=FILE    deploy the channels defined in FILE"))
   (display (G_ "
+  -q, --no-channel-files
+                         inhibit loading of user and system 'channels.scm'"))
+  (display (G_ "
       --url=URL          use the Git repository at URL"))
   (display (G_ "
       --commit=COMMIT    use the specified COMMIT"))
@@ -75,13 +89,16 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
   (cons* (option '(#\C "channels") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'channel-file arg result)))
+         (option '(#\q "no-channel-files") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'ignore-channel-files? #t result)))
          (option '("url") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'repository-url arg
                                (alist-delete 'repository-url result))))
          (option '("commit") #t #f
                  (lambda (opt name arg result)
-                   (alist-cons 'ref `(commit . ,arg) result)))
+                   (alist-cons 'ref `(tag-or-commit . ,arg) result)))
          (option '("branch") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'ref `(branch . ,arg) result)))
@@ -140,8 +157,27 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
      (let* ((opts         (parse-args args))
             (channels     (channel-list opts))
             (command-line (assoc-ref opts 'exec))
+            (ref          (assoc-ref opts 'ref))
             (substitutes?  (assoc-ref opts 'substitutes?))
             (authenticate? (assoc-ref opts 'authenticate-channels?)))
+
+       (define (validate-guix-channel channels)
+         "Finds the Guix channel among CHANNELS, and validates that REF as
+captured from the closure, a git reference specification such as a commit hash
+or tag associated to CHANNEL, is valid and new enough to satisfy the 'guix
+time-machine' requirements.  A `formatted-message' condition is raised
+otherwise."
+         (let* ((guix-channel (find guix-channel? channels))
+                (checkout commit relation (update-cached-checkout
+                                           (channel-url guix-channel)
+                                           #:ref (or ref '())
+                                           #:starting-commit
+                                           %oldest-possible-commit)))
+           (unless (memq relation '(ancestor self))
+             (raise (formatted-message
+                     (G_ "cannot travel past commit `~a' from May 1st, 2019")
+                     (string-take %oldest-possible-commit 12))))))
+
        (when command-line
          (let* ((directory
                  (with-store store
@@ -153,6 +189,8 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
                                                          #:dry-run? #f)
                        (set-build-options-from-command-line store opts)
                        (cached-channel-instance store channels
-                                                #:authenticate? authenticate?)))))
+                                                #:authenticate? authenticate?
+                                                #:validate-channels
+                                                validate-guix-channel)))))
                 (executable (string-append directory "/bin/guix")))
            (apply execl (cons* executable executable command-line))))))))
diff --git a/guix/ui.scm b/guix/ui.scm
index 47a118364a..6f2d4fe245 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -200,6 +200,20 @@ information, or #f if it could not be found."
   (parameterize (((@ (system base compile) default-optimization-level) 1))
     exp))
 
+(define (try-canonicalize-path file)
+  "Like 'canonicalize-path', but return FILE as-is if 'canonicalize-path'
+throws.
+
+This is necessary for corner cases where 'canonicalize-path' fails.  One
+example is on Linux when a /dev/fd/N file denotes a pipe, represented as a
+symlink to a non-existent file like 'pipe:[1234]', as in this example:
+
+  sh -c 'stat $(readlink -f /dev/fd/1)' | cat"
+  (catch 'system-error
+    (lambda ()
+      (canonicalize-path file))
+    (const file)))
+
 (define* (load* file user-module
                 #:key (on-error 'nothing-special))
   "Load the user provided Scheme source code FILE."
@@ -230,7 +244,7 @@ information, or #f if it could not be found."
                ;; 'primitive-load', so that FILE is compiled, which then allows
                ;; us to provide better error reporting with source line numbers.
                (without-compiler-optimizations
-                (load (canonicalize-path file))))
+                (load (try-canonicalize-path file))))
              (const #f))))))
     (lambda _
       ;; XXX: Errors are reported from the pre-unwind handler below, but