Merge remote-tracking branch 'origin/master' into core-updates-frozen

5 files changed, 853 insertions, 345 deletions

diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 6958bd6238..cca0ad991b 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -34,23 +34,32 @@
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module (guix transformations)
-  #:use-module (gnu build linux-container)
-  #:use-module (gnu build accounts)
-  #:use-module ((guix build syscalls) #:select (set-network-interface-up))
-  #:use-module (gnu system linux-container)
+  #:autoload   (gnu build linux-container) (call-with-container %namespaces
+                                            user-namespace-supported?
+                                            unprivileged-user-namespace-supported?
+                                            setgroups-supported?)
+  #:autoload   (gnu build accounts) (password-entry group-entry
+                                     password-entry-name password-entry-directory
+                                     write-passwd write-group)
+  #:autoload   (guix build syscalls) (set-network-interface-up openpty login-tty)
   #:use-module (gnu system file-systems)
-  #:use-module (gnu packages)
-  #:use-module (gnu packages bash)
-  #:use-module ((gnu packages bootstrap)
-                #:select (bootstrap-executable %bootstrap-guile))
+  #:autoload   (gnu packages) (specification->package+output)
+  #:autoload   (gnu packages bash) (bash)
+  #:autoload   (gnu packages bootstrap) (bootstrap-executable %bootstrap-guile)
   #:use-module (ice-9 match)
+  #:autoload   (ice-9 rdelim) (read-line)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:use-module (srfi srfi-98)
   #:export (assert-container-features
-            guix-environment))
+            guix-environment
+            guix-environment*
+            show-environment-options-help
+            (%options . %environment-options)
+            (%default-options . %environment-default-options)))
 
 (define %default-shell
   (or (getenv "SHELL") "/bin/sh"))
@@ -66,41 +75,18 @@ do not augment existing environment variables with additional search paths."
                (newline)))
             (profile-search-paths profile manifest)))
 
-(define (input->manifest-entry input)
-  "Return a manifest entry for INPUT, or #f if INPUT does not correspond to a
-package."
-  (match input
-    ((_ (? package? package))
-     (package->manifest-entry package))
-    ((_ (? package? package) output)
-     (package->manifest-entry package output))
-    (_
-     #f)))
-
-(define (package-environment-inputs package)
-  "Return a list of manifest entries corresponding to the transitive input
-packages for PACKAGE."
-  ;; Remove non-package inputs such as origin records.
-  (filter-map input->manifest-entry
-              (bag-transitive-inputs (package->bag package))))
-
-(define (show-help)
-  (display (G_ "Usage: guix environment [OPTION]... PACKAGE... [-- COMMAND...]
-Build an environment that includes the dependencies of PACKAGE and execute
-COMMAND or an interactive shell in that environment.\n"))
+(define (show-environment-options-help)
+  "Print help about options shared between 'guix environment' and 'guix
+shell'."
   (display (G_ "
   -e, --expression=EXPR  create environment for the package that EXPR
                          evaluates to"))
   (display (G_ "
-  -l, --load=FILE        create environment for the package that the code within
-                         FILE evaluates to"))
-  (display (G_ "
   -m, --manifest=FILE    create environment with the manifest from FILE"))
   (display (G_ "
   -p, --profile=PATH     create environment from profile at PATH"))
   (display (G_ "
-      --ad-hoc           include all specified packages in the environment instead
-                         of only their inputs"))
+      --check            check if the shell clobbers environment variables"))
   (display (G_ "
       --pure             unset existing environment variables"))
   (display (G_ "
@@ -136,7 +122,24 @@ COMMAND or an interactive shell in that environment.\n"))
   (display (G_ "
   -v, --verbosity=LEVEL  use the given verbosity LEVEL"))
   (display (G_ "
-      --bootstrap        use bootstrap binaries to build the environment"))
+      --bootstrap        use bootstrap binaries to build the environment")))
+
+(define (show-help)
+  (display (G_ "Usage: guix environment [OPTION]... PACKAGE... [-- COMMAND...]
+Build an environment that includes the dependencies of PACKAGE and execute
+COMMAND or an interactive shell in that environment.\n"))
+  (warning (G_ "This command is deprecated in favor of 'guix shell'.\n"))
+  (newline)
+
+  ;; These two options are left out in 'guix shell'.
+  (display (G_ "
+  -l, --load=FILE        create environment for the package that the code within
+                         FILE evaluates to"))
+  (display (G_ "
+      --ad-hoc           include all specified packages in the environment instead
+                         of only their inputs"))
+
+  (show-environment-options-help)
   (newline)
   (show-build-options-help)
   (newline)
@@ -179,6 +182,9 @@ COMMAND or an interactive shell in that environment.\n"))
          (option '(#\V "version") #f #f
                  (lambda args
                    (show-version-and-exit "guix environment")))
+         (option '("check") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'check? #t result)))
          (option '("pure") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'pure #t result)))
@@ -297,11 +303,11 @@ for the corresponding packages."
       ((? package? package)
        (if (eq? mode 'ad-hoc-package)
            (list (package->manifest-entry* package))
-           (package-environment-inputs package)))
+           (manifest-entries (package->development-manifest package))))
       (((? package? package) (? string? output))
        (if (eq? mode 'ad-hoc-package)
            (list (package->manifest-entry* package output))
-           (package-environment-inputs package)))
+           (manifest-entries (package->development-manifest package))))
       ((lst ...)
        (append-map (cut packages->outputs <> mode) lst))))
 
@@ -313,8 +319,9 @@ for the corresponding packages."
                                  (specification->package+output spec)))
                      (list (package->manifest-entry* package output))))
                   (('package 'package (? string? spec))
-                   (package-environment-inputs
-                    (transform (specification->package+output spec))))
+                   (manifest-entries
+                    (package->development-manifest
+                     (transform (specification->package+output spec)))))
                   (('expression mode str)
                    ;; Add all the outputs of the package STR evaluates to.
                    (packages->outputs (read/eval str) mode))
@@ -396,6 +403,155 @@ regexps in WHITE-LIST."
     ((program . args)
      (apply execlp program program args))))
 
+(define (child-shell-environment shell profile manifest)
+  "Create a child process, load PROFILE and MANIFEST, and then run SHELL in
+interactive mode in it.  Return a name/value vhash for all the variables shown
+by running 'set' in the shell."
+  (define-values (controller inferior)
+    (openpty))
+
+  (define script
+    ;; Script to obtain the list of environment variable values.  On a POSIX
+    ;; shell we can rely on 'set', but on fish we have to use 'env' (fish's
+    ;; 'set' truncates values and prints them in a different format.)
+    "env || /usr/bin/env || set; echo GUIX-CHECK-DONE; read x; exit\n")
+
+  (define lines
+    (match (primitive-fork)
+      (0
+       (catch #t
+         (lambda ()
+           (load-profile profile manifest #:pure? #t)
+           (setenv "GUIX_ENVIRONMENT" profile)
+           (close-fdes controller)
+           (login-tty inferior)
+           (execl shell shell))
+         (lambda _
+           (primitive-exit 127))))
+      (pid
+       (close-fdes inferior)
+       (let* ((port   (fdopen controller "r+l"))
+              (result (begin
+                        (display script port)
+                        (let loop ((lines '()))
+                          (match (read-line port)
+                            ((? eof-object?) (reverse lines))
+                            ("GUIX-CHECK-DONE\r"
+                             (display "done\n" port)
+                             (reverse lines))
+                            (line
+                             ;; Drop the '\r' from LINE.
+                             (loop (cons (string-drop-right line 1)
+                                         lines))))))))
+         (close-port port)
+         (waitpid pid)
+         result))))
+
+  (fold (lambda (line table)
+          ;; Note: 'set' in fish outputs "NAME VALUE" instead of "NAME=VALUE"
+          ;; but it also truncates values anyway, so don't try to support it.
+          (let ((index (string-index line #\=)))
+            (if index
+                (vhash-cons (string-take line index)
+                            (string-drop line (+ 1 index))
+                            table)
+                table)))
+        vlist-null
+        lines))
+
+(define* (validate-child-shell-environment profile manifest
+                                           #:optional (shell %default-shell))
+  "Run SHELL in interactive mode in an environment for PROFILE and MANIFEST
+and report clobbered environment variables."
+  (define warned? #f)
+  (define-syntax-rule (warn exp ...)
+    (begin
+      (set! warned? #t)
+      (warning exp ...)))
+
+  (info (G_ "checking the environment variables visible from shell '~a'...~%")
+        shell)
+  (let ((actual (child-shell-environment shell profile manifest)))
+    (when (vlist-null? actual)
+      (leave (G_ "failed to determine environment of shell '~a'~%")
+             shell))
+    (for-each (match-lambda
+                ((spec . expected)
+                 (let ((name (search-path-specification-variable spec)))
+                   (match (vhash-assoc name actual)
+                     (#f
+                      (warn (G_ "variable '~a' is missing from shell \
+environment~%")
+                            name))
+                     ((_ . actual)
+                      (cond ((string=? expected actual)
+                             #t)
+                            ((string-prefix? expected actual)
+                             (warn (G_ "variable '~a' has unexpected \
+suffix '~a'~%")
+                                   name
+                                   (string-drop actual
+                                                (string-length expected))))
+                            (else
+                             (warn (G_ "variable '~a' is clobbered: '~a'~%")
+                                   name actual))))))))
+              (profile-search-paths profile manifest))
+
+    ;; Special case.
+    (match (vhash-assoc "GUIX_ENVIRONMENT" actual)
+      (#f
+       (warn (G_ "'GUIX_ENVIRONMENT' is missing from the shell \
+environment~%")))
+      ((_ . value)
+       (unless (string=? value profile)
+         (warn (G_ "'GUIX_ENVIRONMENT' is set to '~a' instead of '~a'~%")
+               value profile))))
+
+    ;; Check the prompt unless we have more important warnings.
+    (unless warned?
+      (match (vhash-assoc "PS1" actual)
+        (#f #f)
+        (str
+         (when (and (getenv "PS1") (string=? str (getenv "PS1")))
+           (warning (G_ "'PS1' is the same in sub-shell~%"))
+           (display-hint (G_ "Consider setting a different prompt for
+environment shells to make them distinguishable.
+
+If you are using Bash, you can do that by adding these lines to
+@file{~/.bashrc}:
+
+@example
+if [ -n \"$GUIX_ENVIRONMENT\" ]
+then
+  export PS1=\"\\u@@\\h \\w [env]\\$ \"
+fi
+@end example
+"))))))
+
+    (if warned?
+        (begin
+          (display-hint (G_ "One or more environment variables have a
+different value in the shell than the one we set.  This means that you may
+find yourself running code in an environment different from the one you asked
+Guix to prepare.
+
+This usually indicates that your shell startup files are unexpectedly
+modifying those environment variables.  For example, if you are using Bash,
+make sure that environment variables are set or modified in
+@file{~/.bash_profile} and @emph{not} in @file{~/.bashrc}.  For more
+information on Bash startup files, run:
+
+@example
+info \"(bash) Bash Startup Files\"
+@end example
+
+Alternatively, you can avoid the problem by passing the @option{--container}
+or @option{-C} option.  That will give you a fully isolated environment
+running in a \"container\", immune to the issue described above."))
+          (exit 1))
+        (info (G_ "All is good!  The shell gets correct environment \
+variables.~%")))))
+
 (define* (launch-environment/fork command profile manifest
                                   #:key pure? (white-list '()))
   "Run COMMAND in a new process with an environment containing PROFILE, with
@@ -666,11 +822,15 @@ message if any test fails."
 
 (define-command (guix-environment . args)
   (category development)
-  (synopsis "spawn one-off software environments")
+  (synopsis "spawn one-off software environments (deprecated)")
+
+  (guix-environment* (parse-args args)))
 
+(define (guix-environment* opts)
+  "Run the 'guix environment' command on OPTS, an alist resulting for
+command-line option processing with 'parse-command-line'."
   (with-error-handling
-    (let* ((opts       (parse-args args))
-           (pure?      (assoc-ref opts 'pure))
+    (let* ((pure?      (assoc-ref opts 'pure))
            (container? (assoc-ref opts 'container?))
            (link-prof? (assoc-ref opts 'link-profile?))
            (network?   (assoc-ref opts 'network?))
@@ -690,6 +850,26 @@ message if any test fails."
            (mappings   (pick-all opts 'file-system-mapping))
            (white-list (pick-all opts 'inherit-regexp)))
 
+      (define store-needed?
+        ;; Whether connecting to the daemon is needed.
+        (or container? (not profile)))
+
+      (define-syntax-rule (with-store/maybe store exp ...)
+        ;; Evaluate EXP... with STORE bound to a connection, unless
+        ;; STORE-NEEDED? is false, in which case STORE is bound to #f.
+        (let ((proc (lambda (store) exp ...)))
+          (if store-needed?
+              (with-store s
+                (set-build-options-from-command-line s opts)
+                (with-build-handler (build-notifier #:use-substitutes?
+                                                    (assoc-ref opts 'substitutes?)
+                                                    #:verbosity
+                                                    (assoc-ref opts 'verbosity)
+                                                    #:dry-run?
+                                                    (assoc-ref opts 'dry-run?))
+                  (proc s)))
+              (proc #f))))
+
       (when container? (assert-container-features))
 
       (when (and (not container?) link-prof?)
@@ -700,85 +880,89 @@ message if any test fails."
         (leave (G_ "--no-cwd cannot be used without --container~%")))
 
 
-      (with-store store
-        (with-build-handler (build-notifier #:use-substitutes?
-                                            (assoc-ref opts 'substitutes?)
-                                            #:verbosity
-                                            (assoc-ref opts 'verbosity)
-                                            #:dry-run?
-                                            (assoc-ref opts 'dry-run?))
-          (with-status-verbosity (assoc-ref opts 'verbosity)
-            (define manifest-from-opts
-              (options/resolve-packages store opts))
-
-            (define manifest
-              (if profile
-                  (profile-manifest profile)
-                  manifest-from-opts))
-
-            (when (and profile
-                       (> (length (manifest-entries manifest-from-opts)) 0))
-              (leave (G_ "'--profile' cannot be used with package options~%")))
-
-            (when (null? (manifest-entries manifest))
-              (warning (G_ "no packages specified; creating an empty environment~%")))
-
-            (set-build-options-from-command-line store opts)
-
-            ;; Use the bootstrap Guile when requested.
-            (parameterize ((%graft? (assoc-ref opts 'graft?))
-                           (%guile-for-build
-                            (package-derivation
-                             store
-                             (if bootstrap?
-                                 %bootstrap-guile
-                                 (default-guile)))))
-              (run-with-store store
-                ;; Containers need a Bourne shell at /bin/sh.
-                (mlet* %store-monad ((bash       (environment-bash container?
-                                                                   bootstrap?
-                                                                   system))
-                                     (prof-drv   (manifest->derivation
-                                                  manifest system bootstrap?))
-                                     (profile -> (if profile
+      (with-store/maybe store
+        (with-status-verbosity (assoc-ref opts 'verbosity)
+          (define manifest-from-opts
+            (options/resolve-packages store opts))
+
+          (define manifest
+            (if profile
+                (profile-manifest profile)
+                manifest-from-opts))
+
+          (when (and profile
+                     (> (length (manifest-entries manifest-from-opts)) 0))
+            (leave (G_ "'--profile' cannot be used with package options~%")))
+
+          (when (null? (manifest-entries manifest))
+            (warning (G_ "no packages specified; creating an empty environment~%")))
+
+          ;; Use the bootstrap Guile when requested.
+          (parameterize ((%graft? (assoc-ref opts 'graft?))
+                         (%guile-for-build
+                          (and store-needed?
+                               (package-derivation
+                                store
+                                (if bootstrap?
+                                    %bootstrap-guile
+                                    (default-guile))))))
+            (run-with-store store
+              ;; Containers need a Bourne shell at /bin/sh.
+              (mlet* %store-monad ((bash       (environment-bash container?
+                                                                 bootstrap?
+                                                                 system))
+                                   (prof-drv   (if profile
+                                                   (return #f)
+                                                   (manifest->derivation
+                                                    manifest system bootstrap?)))
+                                   (profile -> (if profile
                                                    (readlink* profile)
                                                    (derivation->output-path prof-drv)))
-                                     (gc-root -> (assoc-ref opts 'gc-root)))
-
-                  ;; First build the inputs.  This is necessary even for
-                  ;; --search-paths.  Additionally, we might need to build bash for
-                  ;; a container.
-                  (mbegin %store-monad
-                    (built-derivations (if (derivation? bash)
-                                           (list prof-drv bash)
-                                           (list prof-drv)))
-                    (mwhen gc-root
-                      (register-gc-root profile gc-root))
-
-                    (cond
-                     ((assoc-ref opts 'search-paths)
-                      (show-search-paths profile manifest #:pure? pure?)
-                      (return #t))
-                     (container?
-                      (let ((bash-binary
-                             (if bootstrap?
-                                 (derivation->output-path bash)
-                                 (string-append (derivation->output-path bash)
-                                                "/bin/sh"))))
-                        (launch-environment/container #:command command
-                                                      #:bash bash-binary
-                                                      #:user user
-                                                      #:user-mappings mappings
-                                                      #:profile profile
-                                                      #:manifest manifest
-                                                      #:white-list white-list
-                                                      #:link-profile? link-prof?
-                                                      #:network? network?
-                                                      #:map-cwd? (not no-cwd?))))
-
-                     (else
-                      (return
-                       (exit/status
-                        (launch-environment/fork command profile manifest
-                                                 #:white-list white-list
-                                                 #:pure? pure?)))))))))))))))
+                                   (gc-root -> (assoc-ref opts 'gc-root)))
+
+                ;; First build the inputs.  This is necessary even for
+                ;; --search-paths.  Additionally, we might need to build bash for
+                ;; a container.
+                (mbegin %store-monad
+                  (mwhen store-needed?
+                    (built-derivations (append
+                                           (if prof-drv (list prof-drv) '())
+                                           (if (derivation? bash) (list bash) '()))))
+                  (mwhen gc-root
+                    (register-gc-root profile gc-root))
+
+                  (mwhen (assoc-ref opts 'check?)
+                    (return
+                     (validate-child-shell-environment profile manifest)))
+
+                  (cond
+                   ((assoc-ref opts 'search-paths)
+                    (show-search-paths profile manifest #:pure? pure?)
+                    (return #t))
+                   (container?
+                    (let ((bash-binary
+                           (if bootstrap?
+                               (derivation->output-path bash)
+                               (string-append (derivation->output-path bash)
+                                              "/bin/sh"))))
+                      (launch-environment/container #:command command
+                                                    #:bash bash-binary
+                                                    #:user user
+                                                    #:user-mappings mappings
+                                                    #:profile profile
+                                                    #:manifest manifest
+                                                    #:white-list white-list
+                                                    #:link-profile? link-prof?
+                                                    #:network? network?
+                                                    #:map-cwd? (not no-cwd?))))
+
+                   (else
+                    (return
+                     (exit/status
+                      (launch-environment/fork command profile manifest
+                                               #:white-list white-list
+                                               #:pure? pure?))))))))))))))
+
+;;; Local Variables:
+;;; eval: (put 'with-store/maybe 'scheme-indent-function 1)
+;;; End:
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 55e7b436c1..3f48b98ed4 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -40,6 +40,7 @@
   #:autoload   (guix scripts pull) (channel-commit-hyperlink)
   #:use-module (guix scripts home import)
   #:use-module ((guix status) #:select (with-status-verbosity))
+  #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module (guix gexp)
   #:use-module (guix monads)
   #:use-module (srfi srfi-1)
@@ -260,15 +261,20 @@ argument list and OPTS is the option alist."
      (apply search args))
     ((import)
      (let* ((profiles (delete-duplicates
-                      (match (filter-map (match-lambda
-                                           (('profile . p) p)
-                                           (_              #f))
-                                         opts)
-                        (() (list %current-profile))
-                        (lst (reverse lst)))))
-           (manifest (concatenate-manifests
-                      (map profile-manifest profiles))))
-       (import-manifest manifest (current-output-port))))
+                       (match (filter-map (match-lambda
+                                            (('profile . p) p)
+                                            (_              #f))
+                                          opts)
+                         (() (list %current-profile))
+                         (lst (reverse lst)))))
+            (manifest (concatenate-manifests
+                       (map profile-manifest profiles)))
+            (destination (match args
+                           ((destination) destination)
+                           (_ (leave (G_ "wrong number of arguments~%"))))))
+       (unless (file-exists? destination)
+         (mkdir-p destination))
+       (import-manifest manifest destination (current-output-port))))
     ((describe)
      (match (generation-number %guix-home)
        (0
diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm
index 611f580e85..7a7712dd96 100644
--- a/guix/scripts/home/import.scm
+++ b/guix/scripts/home/import.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,12 +23,16 @@
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix packages)
+  #:autoload   (guix scripts package) (manifest-entry-version-prefix)
   #:use-module (gnu packages)
   #:use-module (ice-9 match)
   #:use-module (ice-9 pretty-print)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
-  #:export (import-manifest))
+  #:export (import-manifest
+
+            ;; For tests.
+            manifest+configuration-files->code))
 
 ;;; Commentary:
 ;;;
@@ -36,200 +41,114 @@
 ;;;
 ;;; Code:
 
-
-(define (generate-bash-module+configuration)
-  (let ((rc (string-append (getenv "HOME") "/.bashrc"))
-        (profile (string-append (getenv "HOME") "/.bash_profile"))
-        (logout (string-append (getenv "HOME") "/.bash_logout")))
-    `((gnu home services bash)
-      (service home-bash-service-type
-                 (home-bash-configuration
-                  ,@(if (file-exists? rc)
-                        `((bashrc
-                           (list (local-file ,rc))))
-                        '())
-                  ,@(if (file-exists? profile)
-                        `((bash-profile
-                           (list (local-file ,profile))))
-                        '())
-                  ,@(if (file-exists? logout)
-                        `((bash-logout
-                           (list (local-file ,logout))))
-                        '()))))))
-
-
-(define %files-configurations-alist
-  `((".bashrc" . ,generate-bash-module+configuration)
-    (".bash_profile" . ,generate-bash-module+configuration)
-    (".bash_logout" . ,generate-bash-module+configuration)))
-
-(define (modules+configurations)
-  (let ((configurations (delete-duplicates
-                         (filter-map (match-lambda
-                                ((file . proc)
-                                 (if (file-exists?
-                                      (string-append (getenv "HOME") "/" file))
-                                     proc
-                                     #f)))
-                                     %files-configurations-alist)
-                         (lambda (x y)
-                           (equal? (procedure-name x) (procedure-name y))))))
-    (map (lambda (proc) (proc)) configurations)))
-
-;; Based on `manifest->code' from (guix profiles)
-;; MAYBE: Upstream it?
-(define* (manifest->code manifest
-                         #:key
-                         (entry-package-version (const ""))
-                         (home-environment? #f))
-  "Return an sexp representing code to build an approximate version of
-MANIFEST; the code is wrapped in a top-level 'begin' form.  If
-HOME-ENVIRONMENT? is #t, return an <home-environment> definition.
-Call ENTRY-PACKAGE-VERSION to determine the version number to use in
-the spec for a given entry; it can be set to 'manifest-entry-version'
-for fully-specified version numbers, or to some other procedure to
-disambiguate versions for packages for which several versions are
-available."
-  (define (entry-transformations entry)
-    ;; Return the transformations that apply to ENTRY.
-    (assoc-ref (manifest-entry-properties entry) 'transformations))
-
-  (define transformation-procedures
-    ;; List of transformation options/procedure name pairs.
-    (let loop ((entries (manifest-entries manifest))
-               (counter 1)
-               (result  '()))
-      (match entries
-        (() result)
-        ((entry . tail)
-         (match (entry-transformations entry)
-           (#f
-            (loop tail counter result))
-           (options
-            (if (assoc-ref result options)
-                (loop tail counter result)
-                (loop tail (+ 1 counter)
-                      (alist-cons options
-                                  (string->symbol
-                                   (format #f "transform~a" counter))
-                                  result)))))))))
-
-  (define (qualified-name entry)
-    ;; Return the name of ENTRY possibly with "@" followed by a version.
-    (match (entry-package-version entry)
-      (""      (manifest-entry-name entry))
-      (version (string-append (manifest-entry-name entry)
-                              "@" version))))
-
-  (if (null? transformation-procedures)
-      (let ((specs (map (lambda (entry)
-                          (match (manifest-entry-output entry)
-                            ("out"  (qualified-name entry))
-                            (output (string-append (qualified-name entry)
-                                                   ":" output))))
-                        (manifest-entries manifest))))
-        (if home-environment?
-            (let ((modules+configurations (modules+configurations)))
-              `(begin
-               (use-modules (gnu home)
-                            (gnu packages)
-                            ,@(map first modules+configurations))
-               ,(home-environment-template
-                 #:specs specs
-                 #:services (map second modules+configurations))))
-            `(begin
-               (use-modules (gnu packages))
-
-               (specifications->manifest
-                (list ,@specs)))))
-      (let* ((transform (lambda (options exp)
-                         (if (not options)
-                             exp
-                             (let ((proc (assoc-ref transformation-procedures
-                                                    options)))
-                               `(,proc ,exp)))))
-            (packages (map (lambda (entry)
-                                   (define options
-                                     (entry-transformations entry))
-
-                                   (define name
-                                     (qualified-name entry))
-
-                                   (match (manifest-entry-output entry)
-                                     ("out"
-                                      (transform options
-                                                 `(specification->package ,name)))
-                                     (output
-                                      `(list ,(transform
-                                               options
-                                               `(specification->package ,name))
-                                             ,output))))
-                           (manifest-entries manifest)))
-            (transformations (map (match-lambda
-                         ((options . name)
-                          `(define ,name
-                             (options->transformation ',options))))
-                       transformation-procedures)))
-        (if home-environment?
-            (let ((modules+configurations (modules+configurations)))
-              `(begin
-                 (use-modules (guix transformations)
-                              (gnu home)
-                              (gnu packages)
-                              ,@(map first modules+configurations))
-
-                 ,@transformations
-
-                 ,(home-environment-template
-                   #:packages packages
-                   #:services (map second modules+configurations))))
-            `(begin
-               (use-modules (guix transformations)
-                            (gnu packages))
-
-                ,@transformations
-
-                (packages->manifest
-                 (list ,@packages)))))))
-
-(define* (home-environment-template #:key (packages #f) (specs #f) services)
-  "Return an S-exp containing a <home-environment> declaration
-containing PACKAGES, or SPECS (package specifications), and SERVICES."
-  `(home-environment
-     (packages
-      ,@(if packages
-            `((list ,@packages))
-            `((map specification->package
-                   (list ,@specs)))))
-     (services (list ,@services))))
+(define (basename+remove-dots file-name)
+  "Remove the dot from the dotfile FILE-NAME; replace the other dots in
+FILE-NAME with \"-\", and return the basename of it."
+  (string-map (match-lambda
+                (#\. #\-)
+                (c c))
+              (let ((base (basename file-name)))
+                (if (string-prefix? "." base)
+                    (string-drop base 1)
+                    base))))
+
+(define (generate-bash-configuration+modules destination-directory)
+  (define (destination-append path)
+    (string-append destination-directory "/" path))
+
+  (let ((rc (destination-append ".bashrc"))
+        (profile (destination-append ".bash_profile"))
+        (logout (destination-append ".bash_logout")))
+    `((service home-bash-service-type
+               (home-bash-configuration
+                ,@(if (file-exists? rc)
+                      `((bashrc
+                         (list (local-file ,rc
+                                           ,(basename+remove-dots rc)))))
+                      '())
+                ,@(if (file-exists? profile)
+                      `((bash-profile
+                         (list (local-file ,profile
+                                           ,(basename+remove-dots profile)))))
+                      '())
+                ,@(if (file-exists? logout)
+                      `((bash-logout
+                         (list (local-file ,logout
+                                           ,(basename+remove-dots logout)))))
+                      '())))
+      (guix gexp)
+      (gnu home services shells))))
+
+(define %files+configurations-alist
+  `((".bashrc" . ,generate-bash-configuration+modules)
+    (".bash_profile" . ,generate-bash-configuration+modules)
+    (".bash_logout" . ,generate-bash-configuration+modules)))
+
+(define (configurations+modules configuration-directory)
+  "Return a list of procedures which when called, generate code for a home
+service declaration.  Copy configuration files to CONFIGURATION-DIRECTORY; the
+generated service declarations will refer to those files that have been saved
+in CONFIGURATION-DIRECTORY."
+  (define configurations
+    (delete-duplicates
+     (filter-map (match-lambda
+                   ((file . proc)
+                    (let ((absolute-path (string-append (getenv "HOME")
+                                                        "/" file)))
+                      (and (file-exists? absolute-path)
+                           (begin
+                             (copy-file absolute-path
+                                        (string-append
+                                         configuration-directory "/" file))
+                             proc)))))
+                 %files+configurations-alist)
+     eq?))
+
+  (map (lambda (proc) (proc configuration-directory)) configurations))
+
+(define (manifest+configuration-files->code manifest
+                                            configuration-directory)
+  "Read MANIFEST and the user's configuration files listed in
+%FILES+CONFIGURATIONS-ALIST, and return a 'home-environment' sexp.  Copy the
+user's files to CONFIGURATION-DIRECTORY; the generated sexp refers to them."
+  (match (manifest->code manifest
+                         #:entry-package-version
+                         manifest-entry-version-prefix)
+    (('begin ('use-modules profile-modules ...)
+             definitions ... ('packages->manifest packages))
+     (match (configurations+modules configuration-directory)
+       (((services . modules) ...)
+        `(begin
+           (use-modules (gnu home)
+                        (gnu packages)
+                        (gnu services)
+                        ,@(delete-duplicates
+                           (append profile-modules (concatenate modules))))
+
+           ,@definitions
+
+           (home-environment
+            (packages ,packages)
+            (services (list ,@services)))))))
+    (('begin ('specifications->manifest packages))
+     (match (configurations+modules configuration-directory)
+       (((services . modules) ...)
+        `(begin
+           (use-modules (gnu home)
+                        (gnu packages)
+                        (gnu services)
+                        ,@(delete-duplicates (concatenate modules)))
+
+           (home-environment
+            (packages (map specification->package ,packages))
+            (services (list ,@services)))))))))
 
 (define* (import-manifest
-          manifest
+          manifest destination-directory
           #:optional (port (current-output-port)))
   "Write to PORT a <home-environment> corresponding to MANIFEST."
-  (define (version-spec entry)
-    (let ((name (manifest-entry-name entry)))
-      (match (map package-version (find-packages-by-name name))
-        ((_)
-         ;; A single version of NAME is available, so do not specify the
-         ;; version number, even if the available version doesn't match ENTRY.
-         "")
-        (versions
-         ;; If ENTRY uses the latest version, don't specify any version.
-         ;; Otherwise return the shortest unique version prefix.  Note that
-         ;; this is based on the currently available packages, which could
-         ;; differ from the packages available in the revision that was used
-         ;; to build MANIFEST.
-         (let ((current (manifest-entry-version entry)))
-           (if (every (cut version>? current <>)
-                      (delete current versions))
-               ""
-               (version-unique-prefix (manifest-entry-version entry)
-                                      versions)))))))
-
-  (match (manifest->code manifest
-                         #:entry-package-version version-spec
-                         #:home-environment? #t)
+  (match (manifest+configuration-files->code manifest
+                                             destination-directory)
     (('begin exp ...)
      (format port (G_ "\
 ;; This \"home-environment\" file can be passed to 'guix home reconfigure'
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index a34ecdcb54..4b9c5f210d 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -68,6 +68,7 @@
             guix-package
 
             search-path-environment-variables
+            manifest-entry-version-prefix
 
             transaction-upgrade-entry             ;mostly for testing
 
@@ -327,31 +328,35 @@ Alternately, see @command{guix package --search-paths -p ~s}.")
 ;;; Export a manifest.
 ;;;
 
+(define (manifest-entry-version-prefix entry)
+  "Search among all the versions of ENTRY's package that are available, and
+return the shortest unambiguous version prefix for this package.  If only one
+version of ENTRY's package is available, return the empty string."
+  (let ((name (manifest-entry-name entry)))
+    (match (map package-version (find-packages-by-name name))
+      ((_)
+       ;; A single version of NAME is available, so do not specify the
+       ;; version number, even if the available version doesn't match ENTRY.
+       "")
+      (versions
+       ;; If ENTRY uses the latest version, don't specify any version.
+       ;; Otherwise return the shortest unique version prefix.  Note that
+       ;; this is based on the currently available packages, which could
+       ;; differ from the packages available in the revision that was used
+       ;; to build MANIFEST.
+       (let ((current (manifest-entry-version entry)))
+         (if (every (cut version>? current <>)
+                    (delete current versions))
+             ""
+             (version-unique-prefix (manifest-entry-version entry)
+                                    versions)))))))
+
 (define* (export-manifest manifest
                           #:optional (port (current-output-port)))
   "Write to PORT a manifest corresponding to MANIFEST."
-  (define (version-spec entry)
-    (let ((name (manifest-entry-name entry)))
-      (match (map package-version (find-packages-by-name name))
-        ((_)
-         ;; A single version of NAME is available, so do not specify the
-         ;; version number, even if the available version doesn't match ENTRY.
-         "")
-        (versions
-         ;; If ENTRY uses the latest version, don't specify any version.
-         ;; Otherwise return the shortest unique version prefix.  Note that
-         ;; this is based on the currently available packages, which could
-         ;; differ from the packages available in the revision that was used
-         ;; to build MANIFEST.
-         (let ((current (manifest-entry-version entry)))
-           (if (every (cut version>? current <>)
-                      (delete current versions))
-               ""
-               (version-unique-prefix (manifest-entry-version entry)
-                                      versions)))))))
-
   (match (manifest->code manifest
-                         #:entry-package-version version-spec)
+                         #:entry-package-version
+                         manifest-entry-version-prefix)
     (('begin exp ...)
      (format port (G_ "\
 ;; This \"manifest\" file can be passed to 'guix package -m' to reproduce
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
new file mode 100644
index 0000000000..5749485a44
--- /dev/null
+++ b/guix/scripts/shell.scm
@@ -0,0 +1,394 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts shell)
+  #:use-module (guix ui)
+  #:use-module ((guix diagnostics) #:select (location))
+  #:use-module (guix scripts environment)
+  #:autoload   (guix scripts build) (show-build-options-help)
+  #:autoload   (guix transformations) (show-transformation-options-help)
+  #:use-module (guix scripts)
+  #:use-module (guix packages)
+  #:use-module (guix profiles)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-71)
+  #:use-module (ice-9 match)
+  #:autoload   (ice-9 rdelim) (read-line)
+  #:autoload   (guix base32) (bytevector->base32-string)
+  #:autoload   (rnrs bytevectors) (string->utf8)
+  #:autoload   (guix utils) (config-directory cache-directory)
+  #:autoload   (guix describe) (current-channels)
+  #:autoload   (guix channels) (channel-commit)
+  #:autoload   (gcrypt hash) (sha256)
+  #:use-module ((guix build utils) #:select (mkdir-p))
+  #:use-module (guix cache)
+  #:use-module ((ice-9 ftw) #:select (scandir))
+  #:export (guix-shell))
+
+(define (show-help)
+  (display (G_ "Usage: guix shell [OPTION] PACKAGES... [-- COMMAND...]
+Build an environment that includes PACKAGES and execute COMMAND or an
+interactive shell in that environment.\n"))
+  (newline)
+
+  ;; These two options differ from 'guix environment'.
+  (display (G_ "
+  -D, --development      include the development inputs of the next package"))
+  (display (G_ "
+  -f, --file=FILE        create environment for the package that the code within
+                         FILE evaluates to"))
+  (display (G_ "
+  -q                     inhibit loading of 'guix.scm' and 'manifest.scm'"))
+  (display (G_ "
+      --rebuild-cache    rebuild cached environment, if any"))
+
+  (show-environment-options-help)
+  (newline)
+  (show-build-options-help)
+  (newline)
+  (show-transformation-options-help)
+  (newline)
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define (tag-package-arg opts arg)
+  "Return a two-element list with the form (TAG ARG) that tags ARG with either
+'ad-hoc' in OPTS has the 'ad-hoc?' key set to #t, or 'inputs' otherwise."
+  (if (assoc-ref opts 'ad-hoc?)
+      `(ad-hoc-package ,arg)
+      `(package ,arg)))
+
+(define (ensure-ad-hoc alist)
+  (if (assq-ref alist 'ad-hoc?)
+      alist
+      `((ad-hoc? . #t) ,@alist)))
+
+(define (wrapped-option opt)
+  "Wrap OPT, a SRFI-37 option, such that its processor always adds the
+'ad-hoc?' flag to the resulting alist."
+  (option (option-names opt)
+          (option-required-arg? opt)
+          (option-optional-arg? opt)
+          (compose ensure-ad-hoc (option-processor opt))))
+
+(define %options
+  ;; Specification of the command-line options.
+  (let ((to-remove '("ad-hoc" "inherit" "load" "help" "version")))
+    (append
+        (list (option '(#\h "help") #f #f
+                      (lambda args
+                        (show-help)
+                        (exit 0)))
+              (option '(#\V "version") #f #f
+                      (lambda args
+                        (show-version-and-exit "guix shell")))
+
+              (option '(#\D "development") #f #f
+                      (lambda (opt name arg result)
+                        ;; Temporarily remove the 'ad-hoc?' flag from result.
+                        ;; The next option will put it back thanks to
+                        ;; 'wrapped-option'.
+                        (alist-delete 'ad-hoc? result)))
+
+              ;; For consistency with 'guix package', support '-f' rather than
+              ;; '-l' like 'guix environment' does.
+              (option '(#\f "file") #t #f
+                      (lambda (opt name arg result)
+                        (alist-cons 'load (tag-package-arg result arg)
+                                    result)))
+              (option '(#\q) #f #f
+                      (lambda (opt name arg result)
+                        (alist-cons 'explicit-loading? #t result)))
+              (option '("rebuild-cache") #f #f
+                      (lambda (opt name arg result)
+                        (alist-cons 'rebuild-cache? #t result))))
+        (filter-map (lambda (opt)
+                      (and (not (any (lambda (name)
+                                       (member name to-remove))
+                                     (option-names opt)))
+                           (wrapped-option opt)))
+                    %environment-options))))
+
+(define %default-options
+  `((ad-hoc? . #t)                                ;always true
+    ,@%environment-default-options))
+
+(define (parse-args args)
+  "Parse the list of command line arguments ARGS."
+  (define (handle-argument arg result)
+    (alist-cons 'package (tag-package-arg result arg)
+                (ensure-ad-hoc result)))
+
+  ;; The '--' token is used to separate the command to run from the rest of
+  ;; the operands.
+  (let ((args command (break (cut string=? "--" <>) args)))
+    (let ((opts (parse-command-line args %options (list %default-options)
+                                    #:argument-handler handle-argument)))
+      (options-with-caching
+       (auto-detect-manifest
+        (match command
+          (() opts)
+          (("--") opts)
+          (("--" command ...) (alist-cons 'exec command opts))))))))
+
+(define (find-file-in-parent-directories candidates)
+  "Find one of CANDIDATES in the current directory or one of its ancestors."
+  (define start (getcwd))
+  (define device (stat:dev (stat start)))
+
+  (let loop ((directory start))
+    (let ((stat (stat directory)))
+      (and (= (stat:uid stat) (getuid))
+           (= (stat:dev stat) device)
+           (or (any (lambda (candidate)
+                      (let ((candidate (string-append directory "/" candidate)))
+                        (and (file-exists? candidate) candidate)))
+                    candidates)
+               (and (not (string=? directory "/"))
+                    (loop (dirname directory)))))))) ;lexical ".." resolution
+
+(define (authorized-directory-file)
+  "Return the name of the file listing directories for which 'guix shell' may
+automatically load 'guix.scm' or 'manifest.scm' files."
+  (string-append (config-directory) "/shell-authorized-directories"))
+
+(define (authorized-shell-directory? directory)
+  "Return true if DIRECTORY is among the authorized directories for automatic
+loading.  The list of authorized directories is read from
+'authorized-directory-file'; each line must be either: an absolute file name,
+a hash-prefixed comment, or a blank line."
+  (catch 'system-error
+    (lambda ()
+      (call-with-input-file (authorized-directory-file)
+        (lambda (port)
+          (let loop ()
+            (match (read-line port)
+              ((? eof-object?) #f)
+              ((= string-trim line)
+               (cond ((string-prefix? "#" line)   ;comment
+                      (loop))
+                     ((string-prefix? "/" line)   ;absolute file name
+                      (or (string=? line directory)
+                          (loop)))
+                     ((string-null? (string-trim-right line)) ;blank line
+                      (loop))
+                     (else                        ;bogus line
+                      (let ((loc (location (port-filename port)
+                                           (port-line port)
+                                           (port-column port))))
+                        (warning loc (G_ "ignoring invalid file name: '~a'~%")
+                                 line))))))))))
+    (const #f)))
+
+(define (options-with-caching opts)
+  "If OPTS contains exactly one 'load' or one 'manifest' key, automatically
+add a 'profile' key (when a profile for that file is already in cache) or a
+'gc-root' key (to add the profile to cache)."
+  (define (single-file-for-caching opts)
+    (let loop ((opts opts)
+               (file #f))
+      (match opts
+        (() file)
+        ((('package . _) . _) #f)
+        ((('load . ('package candidate)) . rest)
+         (and (not file) (loop rest candidate)))
+        ((('manifest . candidate) . rest)
+         (and (not file) (loop rest candidate)))
+        ((('expression . _) . _) #f)
+        ((_ . rest) (loop rest file)))))
+
+  ;; Check whether there's a single 'load' or 'manifest' option.  When that is
+  ;; the case, arrange to automatically cache the resulting profile.
+  (match (single-file-for-caching opts)
+    (#f opts)
+    (file
+     (let* ((root (profile-cached-gc-root file))
+            (stat (and root (false-if-exception (lstat root)))))
+       (if (and (not (assoc-ref opts 'rebuild-cache?))
+                stat
+                (<= (stat:mtime ((@ (guile) stat) file))
+                    (stat:mtime stat)))
+           (let ((now (current-time)))
+             ;; Update the atime on ROOT to reflect usage.
+             (utime root
+                    now (stat:mtime stat) 0 (stat:mtimensec stat)
+                    AT_SYMLINK_NOFOLLOW)
+             (alist-cons 'profile root
+                         (remove (match-lambda
+                                   (('load . _) #t)
+                                   (('manifest . _) #t)
+                                   (_ #f))
+                                 opts)))          ;load right away
+           (if (and root (not (assq-ref opts 'gc-root)))
+               (begin
+                 (if stat
+                     (delete-file root)
+                     (mkdir-p (dirname root)))
+                 (alist-cons 'gc-root root opts))
+               opts))))))
+
+(define (auto-detect-manifest opts)
+  "If OPTS do not specify packages or a manifest, load a \"guix.scm\" or
+\"manifest.scm\" file from the current directory or one of its ancestors.
+Return the modified OPTS."
+  (define (options-contain-payload? opts)
+    (match opts
+      (() #f)
+      ((('package . _) . _) #t)
+      ((('load . _) . _) #t)
+      ((('manifest . _) . _) #t)
+      ((('expression . _) . _) #t)
+      ((_ . rest) (options-contain-payload? rest))))
+
+  (define interactive?
+    (not (assoc-ref opts 'exec)))
+
+  (define disallow-implicit-load?
+    (assoc-ref opts 'explicit-loading?))
+
+  (if (or (not interactive?)
+          disallow-implicit-load?
+          (options-contain-payload? opts))
+      opts
+      (match (find-file-in-parent-directories '("manifest.scm" "guix.scm"))
+        (#f
+         (warning (G_ "no packages specified; creating an empty environment~%"))
+         opts)
+        (file
+         (if (authorized-shell-directory? (dirname file))
+             (begin
+               (info (G_ "loading environment from '~a'...~%") file)
+               (match (basename file)
+                 ("guix.scm" (alist-cons 'load `(package ,file) opts))
+                 ("manifest.scm" (alist-cons 'manifest file opts))))
+             (begin
+               (report-error
+                (G_ "not loading '~a' because not authorized to do so~%")
+                file)
+               (display-hint (format #f (G_ "To allow automatic loading of
+@file{~a} when running @command{guix shell}, you must explicitly authorize its
+directory, like so:
+
+@example
+echo ~a >> ~a
+@end example\n")
+                                     file
+                                     (dirname file)
+                                     (authorized-directory-file)))
+               (exit 1)))))))
+
+
+;;;
+;;; Profile cache.
+;;;
+
+(define %profile-cache-directory
+  ;; Directory where profiles created by 'guix shell' alone (without extra
+  ;; options) are cached.
+  (make-parameter (string-append (cache-directory #:ensure? #f)
+                                 "/profiles")))
+
+(define (profile-cache-key file)
+  "Return the cache key for the profile corresponding to FILE, a 'guix.scm' or
+'manifest.scm' file, or #f if we lack channel information."
+  (match (current-channels)
+    (() #f)
+    (((= channel-commit commits) ...)
+     (let ((stat (stat file)))
+       (bytevector->base32-string
+        ;; Since FILE is not canonicalized, only include the device/inode
+        ;; numbers.  XXX: In some rare cases involving Btrfs and NFS, this can
+        ;; be insufficient: <https://lwn.net/Articles/866582/>.
+        (sha256 (string->utf8
+                 (string-append (string-join commits) ":"
+                                (number->string (stat:dev stat)) ":"
+                                (number->string (stat:ino stat))))))))))
+
+(define (profile-cached-gc-root file)
+  "Return the cached GC root for FILE, a 'guix.scm' or 'manifest.scm' file, or
+#f if we lack information to cache it."
+  (match (profile-cache-key file)
+    (#f  #f)
+    (key (string-append (%profile-cache-directory) "/" key))))
+
+
+;;;
+;;; One-time hints.
+;;;
+
+(define (hint-directory)
+  "Return the directory name where previously given hints are recorded."
+  (string-append (cache-directory #:ensure? #f) "/hints"))
+
+(define (hint-file hint)
+  "Return the name of the file that marks HINT as already printed."
+  (string-append (hint-directory) "/" (symbol->string hint)))
+
+(define (record-hint hint)
+  "Mark HINT as already given."
+  (let ((file (hint-file hint)))
+    (mkdir-p (dirname file))
+    (close-fdes (open-fdes file (logior O_CREAT O_WRONLY)))))
+
+(define (hint-given? hint)
+  "Return true if HINT was already given."
+  (file-exists? (hint-file hint)))
+
+
+(define-command (guix-shell . args)
+  (category development)
+  (synopsis "spawn one-off software environments")
+
+  (define (cache-entries directory)
+    (filter-map (match-lambda
+                  ((or "." "..") #f)
+                  (file (string-append directory "/" file)))
+                (or (scandir directory) '())))
+
+  (define* (entry-expiration file)
+    ;; Return the time at which FILE, a cached profile, is considered expired.
+    (match (false-if-exception (lstat file))
+      (#f 0)                       ;FILE may have been deleted in the meantime
+      (st (+ (stat:atime st) (* 60 60 24 7)))))
+
+  (define opts
+    (parse-args args))
+
+  (define interactive?
+    (not (assoc-ref opts 'exec)))
+
+  (if (assoc-ref opts 'check?)
+      (record-hint 'shell-check)
+      (when (and interactive?
+                 (not (hint-given? 'shell-check))
+                 (not (assoc-ref opts 'container?))
+                 (not (assoc-ref opts 'search-paths)))
+        (display-hint (G_ "Consider passing the @option{--check} option once
+to make sure your shell does not clobber environment variables."))) )
+
+  (let ((result (guix-environment* opts)))
+    (maybe-remove-expired-cache-entries (%profile-cache-directory)
+                                        cache-entries
+                                        #:entry-expiration entry-expiration)
+    result))