shell: By default load the local 'manifest.scm' or 'guix.scm' file.

* 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.
This commit is contained in:
Ludovic Courtès 2021-10-01 17:18:43 +02:00
parent 80edb7df65
commit 746584e0ca
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 176 additions and 7 deletions

View file

@ -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 (@pxref{Invoking guix gc}) may clean up packages that were installed in
the environment and that are no longer used outside of it. the environment and that are no longer used outside of it.
As an added convenience, when running from a directory that contains a
@file{manifest.scm} or a @file{guix.scm} file (in this order), 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} By default, the shell session or command runs in an @emph{augmented}
environment, where the new packages are added to search path environment environment, where the new packages are added to search path environment
variables such as @code{PATH}. You can, instead, choose to create an variables such as @code{PATH}. You can, instead, choose to create an

View file

@ -18,15 +18,20 @@
(define-module (guix scripts shell) (define-module (guix scripts shell)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module ((guix diagnostics) #:select (location))
#:use-module (guix scripts environment) #:use-module (guix scripts environment)
#:autoload (guix scripts build) (show-build-options-help) #:autoload (guix scripts build) (show-build-options-help)
#:autoload (guix transformations) (show-transformation-options-help) #:autoload (guix transformations) (show-transformation-options-help)
#:use-module (guix scripts) #:use-module (guix scripts)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-37) #:use-module (srfi srfi-37)
#:use-module (srfi srfi-71) #:use-module (srfi srfi-71)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:autoload (ice-9 rdelim) (read-line)
#:autoload (guix utils) (config-directory)
#:export (guix-shell)) #:export (guix-shell))
(define (show-help) (define (show-help)
@ -41,6 +46,8 @@ (define (show-help)
(display (G_ " (display (G_ "
-f, --file=FILE create environment for the package that the code within -f, --file=FILE create environment for the package that the code within
FILE evaluates to")) FILE evaluates to"))
(display (G_ "
-q inhibit loading of 'guix.scm' and 'manifest.scm'"))
(show-environment-options-help) (show-environment-options-help)
(newline) (newline)
@ -99,7 +106,10 @@ (define %options
(option '(#\f "file") #t #f (option '(#\f "file") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'load (tag-package-arg result arg) (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) (filter-map (lambda (opt)
(and (not (any (lambda (name) (and (not (any (lambda (name)
(member name to-remove)) (member name to-remove))
@ -122,10 +132,109 @@ (define (handle-argument arg result)
(let ((args command (break (cut string=? "--" <>) args))) (let ((args command (break (cut string=? "--" <>) args)))
(let ((opts (parse-command-line args %options (list %default-options) (let ((opts (parse-command-line args %options (list %default-options)
#:argument-handler handle-argument))) #:argument-handler handle-argument)))
(match command (auto-detect-manifest
(() opts) (match command
(("--") opts) (() opts)
(("--" command ...) (alist-cons 'exec 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 '("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
(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) (define-command (guix-shell . args)

View file

@ -22,15 +22,55 @@
guix shell --version guix shell --version
configdir="t-guix-shell-config-$$"
tmpdir="t-guix-shell-$$" tmpdir="t-guix-shell-$$"
trap 'rm -r "$tmpdir"' EXIT trap 'rm -r "$tmpdir" "$configdir"' EXIT
mkdir "$tmpdir" mkdir "$tmpdir" "$configdir" "$configdir/guix"
XDG_CONFIG_HOME="$(realpath $configdir)"
export XDG_CONFIG_HOME
guix shell --bootstrap --pure guile-bootstrap -- guile --version guix shell --bootstrap --pure guile-bootstrap -- guile --version
# '--ad-hoc' is a thing of the past. # '--ad-hoc' is a thing of the past.
! guix shell --ad-hoc guile-bootstrap ! 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 if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
then then
# Compute the build environment for the initial GNU Make. # Compute the build environment for the initial GNU Make.
@ -51,4 +91,10 @@ then
# 'make-boot0' itself must not be listed. # 'make-boot0' itself must not be listed.
! guix gc --references "$profile" | grep make-boot0 ! 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 fi