environment: Add '--check'.

* guix/scripts/environment.scm (show-environment-options-help)
(%options): Add '--check'.
* guix/scripts/environment.scm (child-shell-environment)
(validate-child-shell-environment): New procedures.
(guix-environment*): Call 'validate-child-shell-environment' when
'check?' key is in OPTS.
* doc/guix.texi (Invoking guix shell): Shorten footnote about Bash
startup files.  Document '--check' and mention startup files.
(Invoking guix environment): Document '--check'.

2 files changed, 189 insertions, 12 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 093e354509..22215214e0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5640,17 +5640,11 @@ environment, where the new packages are added to search path environment
 variables such as @code{PATH}.  You can, instead, choose to create an
 @emph{isolated} environment containing nothing but the packages you
 asked for.  Passing the @option{--pure} option clears environment
-variable definitions found in the parent environment@footnote{Users
-sometimes wrongfully augment environment variables such as @env{PATH} in
-their @file{~/.bashrc} file.  As a consequence, when @command{guix
-environment} launches it, Bash may read @file{~/.bashrc}, thereby
-introducing ``impurities'' in these environment variables.  It is an
-error to define such environment variables in @file{.bashrc}; instead,
-they should be defined in @file{.bash_profile}, which is sourced only by
-log-in shells.  @xref{Bash Startup Files,,, bash, The GNU Bash Reference
-Manual}, for details on Bash start-up files.}; passing
-@option{--container} goes one step further by spawning a @dfn{container}
-isolated from the rest of the system:
+variable definitions found in the parent environment@footnote{Be sure to
+use the @option{--check} option the first time you use @command{guix
+shell} interactively to make sure the shell does not undo the effect of
+@option{--pure}.}; passing @option{--container} goes one step further by
+spawning a @dfn{container} isolated from the rest of the system:
 
 @example
 guix shell --container emacs gcc-toolchain
@@ -5699,6 +5693,24 @@ $ ls "$GUIX_ENVIRONMENT/bin"
 The available options are summarized below.
 
 @table @code
+@item --check
+Set up the environment and check whether the shell would clobber
+environment variables.  It's a good idea to use this option the first
+time you run @command{guix shell} for an interactive session to make
+sure your setup is correct.
+
+For example, if the shell modifies the @env{PATH} environment variable,
+report it since you would get a different environment than what you
+asked for.
+
+Such problems usually indicate that the 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}---the
+former is sourced only by log-in shells.  @xref{Bash Startup Files,,,
+bash, The GNU Bash Reference Manual}, for details on Bash start-up
+files.
+
 @item --development
 @itemx -D
 Cause @command{guix shell} to include in the environment the
@@ -6065,6 +6077,11 @@ guix environment --preserve='^DISPLAY$' --container --network \
 The available options are summarized below.
 
 @table @code
+@item --check
+Set up the environment and check whether the shell would clobber
+environment variables.  @xref{Invoking guix shell, @option{--check}},
+for more info.
+
 @item --root=@var{file}
 @itemx -r @var{file}
 @cindex persistent environment
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 05a43659da..7b97a8e39a 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -41,12 +41,14 @@
   #: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)
+  #:autoload   (guix build syscalls) (set-network-interface-up openpty login-tty)
   #:use-module (gnu system file-systems)
   #: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)
@@ -84,6 +86,8 @@ shell'."
   (display (G_ "
   -p, --profile=PATH     create environment from profile at PATH"))
   (display (G_ "
+      --check            check if the shell clobbers environment variables"))
+  (display (G_ "
       --pure             unset existing environment variables"))
   (display (G_ "
   -E, --preserve=REGEXP  preserve environment variables that match REGEXP"))
@@ -178,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)))
@@ -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
@@ -775,6 +931,10 @@ command-line option processing with 'parse-command-line'."
                   (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?)