[bug#50960] [PATCH v3 04/10] shell: By default load the local 'guix.scm' or 'manifest.scm' file.

["Ludovic Courtès" <ludo@gnu.org>]

* guix/scripts/shell.scm (parse-args): Add call to 'auto-detect-manifest'.
(authorized-directory-file, authorized-shell-directory?)
(find-file-in-parent-directories, auto-detect-manifest): New procedures.
* tests/guix-shell.sh: Add test.
* doc/guix.texi (Invoking guix shell): Document it.
---
 doc/guix.texi          |  14 +++++
 guix/scripts/shell.scm | 119 +++++++++++++++++++++++++++++++++++++++--
 tests/guix-shell.sh    |  50 ++++++++++++++++-
 3 files changed, 176 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 63612728ed..7c8f0c1f9b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5621,6 +5621,20 @@ before @command{guix shell} was invoked.  The next garbage collection
 (@pxref{Invoking guix gc}) may clean up packages that were installed in
 the environment and that are no longer used outside of it.
 
+As an added convenience, when running from a directory that contains a
+@file{guix.scm} or a @file{manifest.scm} file, possibly in a parent
+directory, @command{guix shell} automatically loads the file---provided
+the directory is listed in
+@file{~/.config/guix/shell-authorized-directories}, and only for
+interactive use:
+
+@example
+guix shell
+@end example
+
+This provides an easy way to define, share, and enter development
+environments.
+
 By default, the shell session or command runs in an @emph{augmented}
 environment, where the new packages are added to search path environment
 variables such as @code{PATH}.  You can, instead, choose to create an
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index 190dd8837d..45fd536145 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -18,15 +18,20 @@
 
 (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 utils) (config-directory)
   #:export (guix-shell))
 
 (define (show-help)
@@ -41,6 +46,8 @@ (define (show-help)
   (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'"))
 
   (show-environment-options-help)
   (newline)
@@ -99,7 +106,10 @@ (define %options
               (option '(#\f "file") #t #f
                       (lambda (opt name arg result)
                         (alist-cons 'load (tag-package-arg result arg)
-                                    result))))
+                                    result)))
+              (option '(#\q) #f #f
+                      (lambda (opt name arg result)
+                        (alist-cons 'explicit-loading? #t result))))
         (filter-map (lambda (opt)
                       (and (not (any (lambda (name)
                                        (member name to-remove))
@@ -122,10 +132,109 @@ (define (handle-argument arg result)
   (let ((args command (break (cut string=? "--" <>) args)))
     (let ((opts (parse-command-line args %options (list %default-options)
                                     #:argument-handler handle-argument)))
-      (match command
-        (() opts)
-        (("--") opts)
-        (("--" command ...) (alist-cons 'exec command opts))))))
+      (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 (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 '("guix.scm" "manifest.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
+               (warning (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)))
+               opts))))))
 
 \f
 (define-command (guix-shell . args)
diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh
index f08637f7ff..95725cba2d 100644
--- a/tests/guix-shell.sh
+++ b/tests/guix-shell.sh
@@ -22,15 +22,55 @@
 
 guix shell --version
 
+configdir="t-guix-shell-config-$$"
 tmpdir="t-guix-shell-$$"
-trap 'rm -r "$tmpdir"' EXIT
-mkdir "$tmpdir"
+trap 'rm -r "$tmpdir" "$configdir"' EXIT
+mkdir "$tmpdir" "$configdir" "$configdir/guix"
+
+XDG_CONFIG_HOME="$(realpath $configdir)"
+export XDG_CONFIG_HOME
 
 guix shell --bootstrap --pure guile-bootstrap -- guile --version
 
 # '--ad-hoc' is a thing of the past.
 ! guix shell --ad-hoc guile-bootstrap
 
+# Ignoring unauthorized files.
+cat > "$tmpdir/guix.scm" <<EOF
+This is a broken guix.scm file.
+EOF
+(cd "$tmpdir"; SHELL="$(type -P true)" guix shell --bootstrap)
+
+# Authorize the directory.
+echo "$(realpath "$tmpdir")" > "$configdir/guix/shell-authorized-directories"
+
+# Ignoring 'manifest.scm' and 'guix.scm' in non-interactive use.
+(cd "$tmpdir"; guix shell --bootstrap -- true)
+mv "$tmpdir/guix.scm" "$tmpdir/manifest.scm"
+(cd "$tmpdir"; guix shell --bootstrap -- true)
+rm "$tmpdir/manifest.scm"
+
+# Honoring the local 'manifest.scm' file.
+cat > "$tmpdir/manifest.scm" <<EOF
+(specifications->manifest '("guile-bootstrap"))
+EOF
+cat > "$tmpdir/fake-shell.sh" <<EOF
+#!$SHELL
+# This fake shell allows us to test interactive use.
+exec echo "\$GUIX_ENVIRONMENT"
+EOF
+chmod +x "$tmpdir/fake-shell.sh"
+profile1="$(cd "$tmpdir"; SHELL="$(realpath fake-shell.sh)" guix shell --bootstrap)"
+profile2="$(guix shell --bootstrap guile-bootstrap -- "$SHELL" -c 'echo $GUIX_ENVIRONMENT')"
+test -n "$profile1"
+test "$profile1" = "$profile2"
+rm "$tmpdir/manifest.scm"
+
+# Do not read manifest when passed '-q'.
+echo "Broken manifest." > "$tmpdir/manifest.scm"
+(cd "$tmpdir"; SHELL="$(realpath fake-shell.sh)" guix shell --bootstrap -q)
+rm "$tmpdir/manifest.scm"
+
 if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
 then
     # Compute the build environment for the initial GNU Make.
@@ -51,4 +91,10 @@ then
 
     # 'make-boot0' itself must not be listed.
     ! guix gc --references "$profile" | grep make-boot0
+
+    # Honoring the local 'guix.scm' file.
+    echo '(@ (guix tests) gnu-make-for-tests)' > "$tmpdir/guix.scm"
+    (cd "$tmpdir"; guix shell --bootstrap --search-paths --pure > "b")
+    cmp "$tmpdir/a" "$tmpdir/b"
+    rm "$tmpdir/guix.scm"
 fi
-- 
2.33.0