[bug#50960] [PATCH v2 05/11] DRAFT shell: Honor in ~/.config/guix/shell-authorized-directories.

[Ludovic Courtès]

DRAFT: Squeeze with previous commit, or instead implement "guix shell ."
convention?

* guix/scripts/shell.scm (authorized-directory-file)
(authorized-shell-directory?): New procedure.
(auto-detect-manifest): Use it.
* doc/guix.texi (Invoking guix shell): Document it.
---
 doc/guix.texi          | 14 ++++++++++
 guix/scripts/shell.scm | 60 +++++++++++++++++++++++++++++++++++++++---
 tests/guix-shell.sh    | 16 ++++++++---
 3 files changed, 83 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index b0d745b9e3..b95025a39f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5620,6 +5620,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 39d843bde7..45fd536145 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -18,6 +18,7 @@
 
 (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)
@@ -29,6 +30,8 @@ (define-module (guix scripts shell)
   #: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)
@@ -151,6 +154,39 @@ (define device (stat:dev (stat start)))
                (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.
@@ -179,10 +215,26 @@ (define disallow-implicit-load?
          (warning (G_ "no packages specified; creating an empty 
environment~%"))
          opts)
         (file
-         (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)))))))
+         (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))))))
 
 
 (define-command (guix-shell . args)
diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh
index 0988ca0a75..95725cba2d 100644
--- a/tests/guix-shell.sh
+++ b/tests/guix-shell.sh
@@ -22,19 +22,29 @@
 
 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 'manifest.scm' and 'guix.scm' in non-interactive use.
+# 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)
-- 
2.33.0