* [bug#58812] [PATCH 2/5] tests: Add a tests/utils.sh support file.
2022-10-27 3:50 ` [bug#58812] [PATCH 1/5] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
@ 2022-10-27 3:50 ` Maxim Cournoyer
2022-11-09 21:07 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' Ludovic Courtès
2022-10-27 3:50 ` [bug#58812] [PATCH 3/5] install: Validate symlink target in evaluate-populate-directive Maxim Cournoyer
` (2 subsequent siblings)
3 siblings, 1 reply; 60+ messages in thread
From: Maxim Cournoyer @ 2022-10-27 3:50 UTC (permalink / raw)
To: 58812; +Cc: Maxim Cournoyer
The purpose of this file will be to accumulate support shell functions for the
shell-authored tests.
* tests/shell-utils.scm: New file.
* tests/utils.sh: Likewise.
* Makefile.am (EXTRA_DIST): Register them.
---
Makefile.am | 3 +++
tests/shell-utils.scm | 29 +++++++++++++++++++++++++++++
tests/utils.sh | 33 +++++++++++++++++++++++++++++++++
3 files changed, 65 insertions(+)
create mode 100644 tests/shell-utils.scm
create mode 100644 tests/utils.sh
diff --git a/Makefile.am b/Makefile.am
index 6cc7c0c4a0..14cbdcb011 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -16,6 +16,7 @@
# Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
# Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
# Copyright © 2021 Andrew Tropin <andrew@trop.in>
+# Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
#
# This file is part of GNU Guix.
#
@@ -700,7 +701,9 @@ EXTRA_DIST += \
tests/keys/rsa.pub \
tests/keys/signing-key.pub \
tests/keys/signing-key.sec \
+ tests/shell-utils.scm \
tests/test.drv \
+ tests/utils.sh \
$(TESTS)
if !BUILD_DAEMON_OFFLOAD
diff --git a/tests/shell-utils.scm b/tests/shell-utils.scm
new file mode 100644
index 0000000000..3ae9a414cd
--- /dev/null
+++ b/tests/shell-utils.scm
@@ -0,0 +1,29 @@
+;; GNU Guix --- Functional package management for GNU
+;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;
+;; 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/>.
+;;
+;; Commentary:
+;;
+;; This file contains procedures that support the shell functions defined in
+;; tests/utils.sh.
+(use-modules (gnu build linux-container))
+
+(define (container-support?)
+ (unless (and (user-namespace-supported?)
+ (unprivileged-user-namespace-supported?)
+ (setgroups-supported?))
+ (exit 1)))
diff --git a/tests/utils.sh b/tests/utils.sh
new file mode 100644
index 0000000000..ba17f0de15
--- /dev/null
+++ b/tests/utils.sh
@@ -0,0 +1,33 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+#
+# 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/>.
+#
+# Commentary:
+#
+# This file provides utility shell functions that can be used in the shell
+# test scripts. The file is intended to be sourced as a shell library.
+
+BASEDIR=$(dirname "$0")
+
+HAS_CONTAINER_SUPPORT=
+has_container_support() {
+ if [ -z "$HAS_CONTAINER_SUPPORT" ]; then
+ guile -l "$BASEDIR/shell-utils.scm" -c '(container-support?)'
+ HAS_CONTAINER_SUPPORT=$?
+ fi
+ return "$HAS_CONTAINER_SUPPORT"
+}
--
2.37.3
^ permalink raw reply related [flat|nested] 60+ messages in thread* [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell'.
2022-10-27 3:50 ` [bug#58812] [PATCH 2/5] tests: Add a tests/utils.sh support file Maxim Cournoyer
@ 2022-11-09 21:07 ` Ludovic Courtès
2022-11-10 3:38 ` Maxim Cournoyer
2022-11-10 4:23 ` [bug#59164] [PATCH v2 1/4] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
0 siblings, 2 replies; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-09 21:07 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: 58812
Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
> The purpose of this file will be to accumulate support shell functions for the
> shell-authored tests.
>
> * tests/shell-utils.scm: New file.
> * tests/utils.sh: Likewise.
> * Makefile.am (EXTRA_DIST): Register them.
Maybe we can discuss this one separately since it’s no longer strictly
necessary if we move tests to ‘tests/guix-environment-container.sh’?
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread
* [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell'.
2022-11-09 21:07 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' Ludovic Courtès
@ 2022-11-10 3:38 ` Maxim Cournoyer
2022-11-10 4:23 ` [bug#59164] [PATCH v2 1/4] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
1 sibling, 0 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-10 3:38 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 58812
Hi,
Ludovic Courtès <ludo@gnu.org> writes:
> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>
>> The purpose of this file will be to accumulate support shell functions for the
>> shell-authored tests.
>>
>> * tests/shell-utils.scm: New file.
>> * tests/utils.sh: Likewise.
>> * Makefile.am (EXTRA_DIST): Register them.
>
> Maybe we can discuss this one separately since it’s no longer strictly
> necessary if we move tests to ‘tests/guix-environment-container.sh’?
Since it's not immediately necessary, I've dropped the commit for now.
We can resurrect it or something similar if/when the need arises.
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread
* [bug#59164] [PATCH v2 1/4] Makefile.am: Sort EXTRA_DIST entries.
2022-11-09 21:07 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' Ludovic Courtès
2022-11-10 3:38 ` Maxim Cournoyer
@ 2022-11-10 4:23 ` Maxim Cournoyer
2022-11-10 4:23 ` [bug#59161] [PATCH v2 2/4] install: Validate symlink target in evaluate-populate-directive Maxim Cournoyer
` (2 more replies)
1 sibling, 3 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-10 4:23 UTC (permalink / raw)
To: 59164; +Cc: Maxim Cournoyer
* Makefile.am (EXTRA_DIST): Sort.
---
Makefile.am | 52 ++++++++++++++++++++++++++--------------------------
1 file changed, 26 insertions(+), 26 deletions(-)
diff --git a/Makefile.am b/Makefile.am
index 47886721fa..c3af23b68e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -660,49 +660,49 @@ dist_fishcompletion_DATA = etc/completion/fish/guix.fish
nodist_selinux_policy_DATA = etc/guix-daemon.cil
EXTRA_DIST += \
- HACKING \
- ROADMAP \
- TODO \
- CODE-OF-CONDUCT \
.dir-locals.el \
.guix-authorizations \
.guix-channel \
- scripts/guix.in \
- etc/disarchive-manifest.scm \
- etc/guix-install.sh \
- etc/news.scm \
- etc/release-manifest.scm \
- etc/source-manifest.scm \
- etc/system-tests.scm \
- etc/time-travel-manifest.scm \
- etc/historical-authorizations \
+ CODE-OF-CONDUCT \
+ HACKING \
+ ROADMAP \
+ TODO \
+ bootstrap \
build-aux/build-self.scm \
- build-aux/compile-all.scm \
- build-aux/cuirass/hurd-manifest.scm \
- build-aux/check-final-inputs-self-contained.scm \
build-aux/check-channel-news.scm \
+ build-aux/check-final-inputs-self-contained.scm \
+ build-aux/compile-all.scm \
build-aux/compile-as-derivation.scm \
+ build-aux/config.rpath \
build-aux/convert-xref.scm \
+ build-aux/cuirass/hurd-manifest.scm \
build-aux/generate-authors.scm \
build-aux/test-driver.scm \
- build-aux/update-guix-package.scm \
build-aux/update-NEWS.scm \
- tests/test.drv \
+ build-aux/update-guix-package.scm \
+ doc/build.scm \
+ etc/disarchive-manifest.scm \
+ etc/guix-install.sh \
+ etc/historical-authorizations \
+ etc/news.scm \
+ etc/release-manifest.scm \
+ etc/source-manifest.scm \
+ etc/system-tests.scm \
+ etc/time-travel-manifest.scm \
+ scripts/guix.in \
tests/cve-sample.json \
- tests/keys/signing-key.pub \
- tests/keys/signing-key.sec \
tests/keys/civodul.pub \
- tests/keys/rsa.pub \
tests/keys/dsa.pub \
- tests/keys/ed25519.pub \
- tests/keys/ed25519.sec \
tests/keys/ed25519-2.pub \
tests/keys/ed25519-2.sec \
tests/keys/ed25519-3.pub \
tests/keys/ed25519-3.sec \
- build-aux/config.rpath \
- bootstrap \
- doc/build.scm \
+ tests/keys/ed25519.pub \
+ tests/keys/ed25519.sec \
+ tests/keys/rsa.pub \
+ tests/keys/signing-key.pub \
+ tests/keys/signing-key.sec \
+ tests/test.drv \
$(TESTS)
if !BUILD_DAEMON_OFFLOAD
--
2.37.3
^ permalink raw reply related [flat|nested] 60+ messages in thread* [bug#59161] [PATCH v2 2/4] install: Validate symlink target in evaluate-populate-directive.
2022-11-10 4:23 ` [bug#59164] [PATCH v2 1/4] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
@ 2022-11-10 4:23 ` Maxim Cournoyer
2022-11-10 4:23 ` [bug#59162] [PATCH v2 3/4] guix: shell: Add '--symlink' option Maxim Cournoyer
2022-11-10 4:23 ` [bug#59163] [PATCH v2 4/4] shell: Detect --symlink spec problems early Maxim Cournoyer
2 siblings, 0 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-10 4:23 UTC (permalink / raw)
To: 59161; +Cc: Maxim Cournoyer
* gnu/build/install.scm (evaluate-populate-directive): By default, error when
the target of a symlink doesn't exist. Always ensure TARGET ends with "/".
(populate-root-file-system): Call evaluate-populate-directive with
#:error-on-dangling-symlink #t and add comment.
---
gnu/build/install.scm | 60 ++++++++++++++++++++++++++++---------------
1 file changed, 40 insertions(+), 20 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index f5c8407b89..33a9616c0d 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -56,19 +57,24 @@ (define (install-boot-config bootcfg bootcfg-location mount-point)
(define* (evaluate-populate-directive directive target
#:key
(default-gid 0)
- (default-uid 0))
+ (default-uid 0)
+ (error-on-dangling-symlink? #t))
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under
directory TARGET. DEFAULT-UID and DEFAULT-GID are the default UID and GID in
the context of the caller. If the directive matches those defaults then,
-'chown' won't be run."
+'chown' won't be run. When ERROR-ON-DANGLING-SYMLINK? is true, abort with an
+error when a dangling symlink would be created."
+ (define target* (if (string-suffix? "/" target)
+ target
+ (string-append target "/")))
(let loop ((directive directive))
(catch 'system-error
(lambda ()
(match directive
(('directory name)
- (mkdir-p (string-append target name)))
+ (mkdir-p (string-append target* name)))
(('directory name uid gid)
- (let ((dir (string-append target name)))
+ (let ((dir (string-append target* name)))
(mkdir-p dir)
;; If called from a context without "root" permissions, "chown"
;; to root will fail. In that case, do not try to run "chown"
@@ -78,27 +84,38 @@ (define* (evaluate-populate-directive directive target
(chown dir uid gid))))
(('directory name uid gid mode)
(loop `(directory ,name ,uid ,gid))
- (chmod (string-append target name) mode))
+ (chmod (string-append target* name) mode))
(('file name)
- (call-with-output-file (string-append target name)
+ (call-with-output-file (string-append target* name)
(const #t)))
(('file name (? string? content))
- (call-with-output-file (string-append target name)
+ (call-with-output-file (string-append target* name)
(lambda (port)
(display content port))))
((new '-> old)
- (let try ()
- (catch 'system-error
- (lambda ()
- (symlink old (string-append target new)))
- (lambda args
- ;; When doing 'guix system init' on the current '/', some
- ;; symlinks may already exists. Override them.
- (if (= EEXIST (system-error-errno args))
- (begin
- (delete-file (string-append target new))
- (try))
- (apply throw args))))))))
+ (let ((new* (string-append target* new)))
+ (let try ()
+ (catch 'system-error
+ (lambda ()
+ (when error-on-dangling-symlink?
+ ;; When the symbolic link points to a relative path,
+ ;; checking if its target exists must be done relatively
+ ;; to the link location.
+ (unless (if (string-prefix? "/" old)
+ (file-exists? old)
+ (with-directory-excursion (dirname new*)
+ (file-exists? old)))
+ (error (format #f "symlink `~a' points to nonexistent \
+file `~a'" new* old))))
+ (symlink old new*))
+ (lambda args
+ ;; When doing 'guix system init' on the current '/', some
+ ;; symlinks may already exists. Override them.
+ (if (= EEXIST (system-error-errno args))
+ (begin
+ (delete-file new*)
+ (try))
+ (apply throw args)))))))))
(lambda args
;; Usually we can only get here when installing to an existing root,
;; as with 'guix system init foo.scm /'.
@@ -142,7 +159,10 @@ (define* (populate-root-file-system system target
includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM.
EXTRAS is a list of directives appended to the built-in directives to populate
TARGET."
- (for-each (cut evaluate-populate-directive <> target)
+ ;; It's expected that some symbolic link targets do not exist yet, so do not
+ ;; error on dangling links.
+ (for-each (cut evaluate-populate-directive <> target
+ #:error-on-dangling-symlink? #f)
(append (directives (%store-directory)) extras))
;; Add system generation 1.
--
2.37.3
^ permalink raw reply related [flat|nested] 60+ messages in thread* [bug#59162] [PATCH v2 3/4] guix: shell: Add '--symlink' option.
2022-11-10 4:23 ` [bug#59164] [PATCH v2 1/4] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
2022-11-10 4:23 ` [bug#59161] [PATCH v2 2/4] install: Validate symlink target in evaluate-populate-directive Maxim Cournoyer
@ 2022-11-10 4:23 ` Maxim Cournoyer
2022-11-10 4:23 ` [bug#59163] [PATCH v2 4/4] shell: Detect --symlink spec problems early Maxim Cournoyer
2 siblings, 0 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-10 4:23 UTC (permalink / raw)
To: 59162; +Cc: Maxim Cournoyer
* guix/scripts/pack.scm (%options): Extract symlink parsing logic to...
(symlink-spec-option-parser): ... here.
(self-contained-tarball/builder): Extract symlink->directives logic to...
* gnu/build/install.scm (make-symlink->directives): ... here. Add a comment
mentioning why a relative file name is used for the link target.
* guix/scripts/environment.scm (show-environment-options-help): Document new
--symlink option.
(%default-options): Add default value for symlinks.
(%options): Register new symlink option.
(launch-environment/container): Add #:symlinks argument and extend doc.
Create symlinks using evaluate-populate-directive and
make-symlink->directives.
(guix-environment*): Pass symlinks arguments to launch-environment/container.
* doc/guix.texi (Invoking guix shell): Document it.
* tests/guix-shell.sh: Add a --symlink (negative) test.
* tests/guix-environment-container.sh: Add tests.
---
doc/guix.texi | 9 ++++-
gnu/build/install.scm | 18 +++++++++
guix/scripts/environment.scm | 38 ++++++++++++++-----
guix/scripts/pack.scm | 57 ++++++++++++-----------------
tests/guix-environment-container.sh | 12 ++++++
tests/guix-shell.sh | 3 ++
6 files changed, 92 insertions(+), 45 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 3f76184495..94c3f29790 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -49,7 +49,7 @@ Copyright @copyright{} 2017 humanitiesNerd@*
Copyright @copyright{} 2017, 2021 Christine Lemmer-Webber@*
Copyright @copyright{} 2017, 2018, 2019, 2020, 2021, 2022 Marius Bakke@*
Copyright @copyright{} 2017, 2019, 2020, 2022 Hartmut Goebel@*
-Copyright @copyright{} 2017, 2019, 2020, 2021 Maxim Cournoyer@*
+Copyright @copyright{} 2017, 2019, 2020, 2021, 2022 Maxim Cournoyer@*
Copyright @copyright{} 2017–2022 Tobias Geerinckx-Rice@*
Copyright @copyright{} 2017 George Clemmer@*
Copyright @copyright{} 2017 Andy Wingo@*
@@ -6242,6 +6242,12 @@ directory:
guix shell --container --expose=$HOME=/exchange guile -- guile
@end example
+@cindex symbolic links, guix shell
+@item --symlink=@var{spec}
+@itemx -S @var{spec}
+For containers, create the symbolic links specified by @var{spec}, as
+documented in @ref{pack-symlink-option}.
+
@cindex file system hierarchy standard (FHS)
@cindex FHS (file system hierarchy standard)
@item --emulate-fhs
@@ -7034,6 +7040,7 @@ Compress the resulting tarball using @var{tool}---one of @code{gzip},
@code{zstd}, @code{bzip2}, @code{xz}, @code{lzip}, or @code{none} for no
compression.
+@anchor{pack-symlink-option}
@item --symlink=@var{spec}
@itemx -S @var{spec}
Add the symlinks specified by @var{spec} to the pack. This option can
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 33a9616c0d..031a97e91b 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -19,6 +19,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build install)
+ #:use-module ((guix build union) #:select (relative-file-name))
#:use-module (guix build syscalls)
#:use-module (guix build utils)
#:use-module (guix build store-copy)
@@ -26,6 +27,7 @@ (define-module (gnu build install)
#:use-module (ice-9 match)
#:export (install-boot-config
evaluate-populate-directive
+ make-symlink->directives
populate-root-file-system
install-database-and-gc-roots
populate-single-profile-directory
@@ -124,6 +126,22 @@ (define target* (if (string-suffix? "/" target)
directive)
(apply throw args)))))
+(define (make-symlink->directives directory)
+ "Return a procedure that turn symlinks specs into directives that target
+DIRECTORY."
+ (match-lambda
+ ((source '-> target)
+ (let ((target (string-append directory "/" target))
+ (parent (dirname source)))
+ ;; Never add a 'directory' directive for "/" so as to preserve its
+ ;; ownership and avoid adding the same entries multiple times.
+ `(,@(if (string=? parent "/")
+ '()
+ `((directory ,parent)))
+ ;; Note: a relative file name is used for compatibility with
+ ;; relocatable packs.
+ (,source -> ,(relative-file-name parent target)))))))
+
(define (directives store)
"Return a list of directives to populate the root file system that will host
STORE."
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index de9bc8f98d..7174dd72d2 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -33,8 +33,10 @@ (define-module (guix scripts environment)
#:use-module ((guix gexp) #:select (lower-object))
#:use-module (guix scripts)
#:use-module (guix scripts build)
+ #:autoload (guix scripts pack) (symlink-spec-option-parser)
#:use-module (guix transformations)
#:autoload (ice-9 ftw) (scandir)
+ #:use-module (gnu build install)
#:autoload (gnu build linux-container) (call-with-container %namespaces
user-namespace-supported?
unprivileged-user-namespace-supported?
@@ -120,6 +122,9 @@ (define (show-environment-options-help)
--expose=SPEC for containers, expose read-only host file system
according to SPEC"))
(display (G_ "
+ -S, --symlink=SPEC for containers, add symlinks to the profile according
+ to SPEC, e.g. \"/usr/bin/env=bin/env\"."))
+ (display (G_ "
-v, --verbosity=LEVEL use the given verbosity LEVEL"))
(display (G_ "
--bootstrap use bootstrap binaries to build the environment")))
@@ -157,6 +162,7 @@ (define (show-help)
(define %default-options
`((system . ,(%current-system))
(substitutes? . #t)
+ (symlinks . ())
(offload? . #t)
(graft? . #t)
(print-build-trace? . #t)
@@ -256,6 +262,7 @@ (define %options
(alist-cons 'file-system-mapping
(specification->file-system-mapping arg #f)
result)))
+ (option '(#\S "symlink") #t #f symlink-spec-option-parser)
(option '(#\r "root") #t #f
(lambda (opt name arg result)
(alist-cons 'gc-root arg result)))
@@ -672,7 +679,7 @@ (define* (launch-environment/fork command profile manifest
(define* (launch-environment/container #:key command bash user user-mappings
profile manifest link-profile? network?
map-cwd? emulate-fhs? (setup-hook #f)
- (white-list '()))
+ (symlinks '()) (white-list '()))
"Run COMMAND within a container that features the software in PROFILE.
Environment variables are set according to the search paths of MANIFEST. The
global shell is BASH, a file name for a GNU Bash binary in the store. When
@@ -690,6 +697,9 @@ (define* (launch-environment/container #:key command bash user user-mappings
LINK-PROFILE? creates a symbolic link from ~/.guix-profile to the
environment profile.
+SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
+added to the container.
+
Preserve environment variables whose name matches the one of the regexps in
WHILE-LIST."
(define (optional-mapping->fs mapping)
@@ -797,6 +807,10 @@ (define fhs-mappings
(mkdir-p home-dir)
(setenv "HOME" home-dir)
+ ;; Create symlinks.
+ (for-each (cut evaluate-populate-directive <> ".")
+ (append-map (make-symlink->directives profile) symlinks))
+
;; Call an additional setup procedure, if provided.
(when setup-hook
(setup-hook profile))
@@ -970,6 +984,7 @@ (define (guix-environment* opts)
(let* ((pure? (assoc-ref opts 'pure))
(container? (assoc-ref opts 'container?))
(link-prof? (assoc-ref opts 'link-profile?))
+ (symlinks (assoc-ref opts 'symlinks))
(network? (assoc-ref opts 'network?))
(no-cwd? (assoc-ref opts 'no-cwd?))
(emulate-fhs? (assoc-ref opts 'emulate-fhs?))
@@ -1010,15 +1025,17 @@ (define-syntax-rule (with-store/maybe store exp ...)
(when container? (assert-container-features))
- (when (and (not container?) link-prof?)
- (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
- (when (and (not container?) user)
- (leave (G_ "'--user' cannot be used without '--container'~%")))
- (when (and (not container?) no-cwd?)
- (leave (G_ "--no-cwd cannot be used without '--container'~%")))
- (when (and (not container?) emulate-fhs?)
- (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
-
+ (when (not container?)
+ (when link-prof?
+ (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
+ (when user
+ (leave (G_ "'--user' cannot be used without '--container'~%")))
+ (when no-cwd?
+ (leave (G_ "--no-cwd cannot be used without '--container'~%")))
+ (when emulate-fhs?
+ (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
+ (when (pair? symlinks)
+ (leave (G_ "'--symlink' cannot be used without '--container~%'"))))
(with-store/maybe store
(with-status-verbosity (assoc-ref opts 'verbosity)
@@ -1099,6 +1116,7 @@ (define manifest
#:network? network?
#:map-cwd? (not no-cwd?)
#:emulate-fhs? emulate-fhs?
+ #:symlinks symlinks
#:setup-hook
(and emulate-fhs?
setup-fhs))))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 06849e4761..e3bddc4274 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -61,7 +61,9 @@ (define-module (guix scripts pack)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
- #:export (self-contained-tarball
+ #:export (symlink-spec-option-parser
+
+ self-contained-tarball
debian-archive
docker-image
squashfs-image
@@ -160,6 +162,21 @@ (define str (string-join names "-"))
((_) str)
((names ... _) (loop names))))))
+(define (symlink-spec-option-parser opt name arg result)
+ "A SRFI-37 option parser for the --symlink option."
+ ;; Note: Using 'string-split' allows us to handle empty
+ ;; TARGET (as in "/opt/guile=", meaning that /opt/guile is
+ ;; a symlink to the profile) correctly.
+ (match (string-split arg (char-set #\=))
+ ((source target)
+ (let ((symlinks (assoc-ref result 'symlinks)))
+ (alist-cons 'symlinks
+ `((,source -> ,target) ,@symlinks)
+ (alist-delete 'symlinks result eq?))))
+ (x
+ (leave (G_ "~a: invalid symlink specification~%")
+ arg))))
+
\f
;;;
;;; Tarball format.
@@ -204,30 +221,15 @@ (define (import-module? module)
(use-modules (guix build pack)
(guix build store-copy)
(guix build utils)
- ((guix build union) #:select (relative-file-name))
(gnu build install)
(srfi srfi-1)
- (srfi srfi-26)
- (ice-9 match))
+ (srfi srfi-26))
(define %root "root")
- (define symlink->directives
- ;; Return "populate directives" to make the given symlink and its
- ;; parent directories.
- (match-lambda
- ((source '-> target)
- (let ((target (string-append #$profile "/" target))
- (parent (dirname source)))
- ;; Never add a 'directory' directive for "/" so as to
- ;; preserve its ownership when extracting the archive (see
- ;; below), and also because this would lead to adding the
- ;; same entries twice in the tarball.
- `(,@(if (string=? parent "/")
- '()
- `((directory ,parent)))
- (,source
- -> ,(relative-file-name parent target)))))))
+ ;; Return "populate directives" to make the given symlink and its
+ ;; parent directories.
+ (define symlink->directives (make-symlink->directives #$profile))
(define directives
;; Fully-qualified symlinks.
@@ -1208,20 +1210,7 @@ (define %options
(lambda (opt name arg result)
(alist-cons 'compressor (lookup-compressor arg)
result)))
- (option '(#\S "symlink") #t #f
- (lambda (opt name arg result)
- ;; Note: Using 'string-split' allows us to handle empty
- ;; TARGET (as in "/opt/guile=", meaning that /opt/guile is
- ;; a symlink to the profile) correctly.
- (match (string-split arg (char-set #\=))
- ((source target)
- (let ((symlinks (assoc-ref result 'symlinks)))
- (alist-cons 'symlinks
- `((,source -> ,target) ,@symlinks)
- (alist-delete 'symlinks result eq?))))
- (x
- (leave (G_ "~a: invalid symlink specification~%")
- arg)))))
+ (option '(#\S "symlink") #t #f symlink-spec-option-parser)
(option '("save-provenance") #f #f
(lambda (opt name arg result)
(alist-cons 'save-provenance? #t result)))
diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh
index fb2c19b193..b509e52e26 100644
--- a/tests/guix-environment-container.sh
+++ b/tests/guix-environment-container.sh
@@ -241,3 +241,15 @@ guix shell -CF --bootstrap guile-bootstrap glibc \
"glibc-for-fhs")
0
1))'
+
+# '--symlink' works.
+echo "TESTING SYMLINK IN CONTAINER"
+guix shell --bootstrap guile-bootstrap --container \
+ --symlink=/usr/bin/guile=bin/guile -- \
+ /usr/bin/guile --version
+
+# An invalid symlink spec causes the command to fail.
+! guix shell --bootstrap -CS bin/guile=/usr/bin/guile guile-bootstrap -- exit
+
+# A dangling symlink causes the command to fail.
+! guix shell --bootstrap -CS /usr/bin/python=bin/python guile-bootstrap -- exit
diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh
index 9a6b055264..cb2b53466d 100644
--- a/tests/guix-shell.sh
+++ b/tests/guix-shell.sh
@@ -32,6 +32,9 @@ export XDG_CONFIG_HOME
guix shell --bootstrap --pure guile-bootstrap -- guile --version
+# '--symlink' can only be used with --container.
+! guix shell --bootstrap guile-bootstrap -S /dummy=bin/guile
+
# '--ad-hoc' is a thing of the past.
! guix shell --ad-hoc guile-bootstrap
--
2.37.3
^ permalink raw reply related [flat|nested] 60+ messages in thread* [bug#59163] [PATCH v2 4/4] shell: Detect --symlink spec problems early.
2022-11-10 4:23 ` [bug#59164] [PATCH v2 1/4] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
2022-11-10 4:23 ` [bug#59161] [PATCH v2 2/4] install: Validate symlink target in evaluate-populate-directive Maxim Cournoyer
2022-11-10 4:23 ` [bug#59162] [PATCH v2 3/4] guix: shell: Add '--symlink' option Maxim Cournoyer
@ 2022-11-10 4:23 ` Maxim Cournoyer
2 siblings, 0 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-10 4:23 UTC (permalink / raw)
To: 59163; +Cc: Maxim Cournoyer
* guix/scripts/pack.scm (symlink-spec-option-parser): Remove extraneous
char-set. Raise an exception when the target is an absolute file name.
(guix-pack): Move with-error-handler earlier.
* guix/scripts/shell.scm (guix-shell): Likewise.
* guix/scripts/environment.scm (guix-environment): Wrap the whole
guix-environment* call with the with-error-handling handler.
* tests/guix-shell.sh: Add test.
* tests/guix-pack.sh: Adjust symlink spec.
---
guix/scripts/environment.scm | 294 +++++++++++++++++------------------
guix/scripts/pack.scm | 155 ++++++++++--------
guix/scripts/shell.scm | 77 ++++-----
tests/guix-pack.sh | 2 +-
4 files changed, 273 insertions(+), 255 deletions(-)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 7174dd72d2..ce299c4533 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -975,158 +975,158 @@ (define-command (guix-environment . args)
(category development)
(synopsis "spawn one-off software environments (deprecated)")
- (guix-environment* (parse-args args)))
+ (with-error-handling
+ (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* ((pure? (assoc-ref opts 'pure))
- (container? (assoc-ref opts 'container?))
- (link-prof? (assoc-ref opts 'link-profile?))
- (symlinks (assoc-ref opts 'symlinks))
- (network? (assoc-ref opts 'network?))
- (no-cwd? (assoc-ref opts 'no-cwd?))
- (emulate-fhs? (assoc-ref opts 'emulate-fhs?))
- (user (assoc-ref opts 'user))
- (bootstrap? (assoc-ref opts 'bootstrap?))
- (system (assoc-ref opts 'system))
- (profile (assoc-ref opts 'profile))
- (command (or (assoc-ref opts 'exec)
- ;; Spawn a shell if the user didn't specify
- ;; anything in particular.
- (if container?
- ;; The user's shell is likely not available
- ;; within the container.
- '("/bin/sh")
- (list %default-shell))))
- (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 (not container?)
- (when link-prof?
- (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
- (when user
- (leave (G_ "'--user' cannot be used without '--container'~%")))
- (when no-cwd?
- (leave (G_ "--no-cwd cannot be used without '--container'~%")))
- (when emulate-fhs?
- (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
- (when (pair? symlinks)
- (leave (G_ "'--symlink' cannot be used without '--container~%'"))))
-
- (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
- (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
- (if container?
- (warning (G_ "'--check' is unnecessary \
+ (let* ((pure? (assoc-ref opts 'pure))
+ (container? (assoc-ref opts 'container?))
+ (link-prof? (assoc-ref opts 'link-profile?))
+ (symlinks (assoc-ref opts 'symlinks))
+ (network? (assoc-ref opts 'network?))
+ (no-cwd? (assoc-ref opts 'no-cwd?))
+ (emulate-fhs? (assoc-ref opts 'emulate-fhs?))
+ (user (assoc-ref opts 'user))
+ (bootstrap? (assoc-ref opts 'bootstrap?))
+ (system (assoc-ref opts 'system))
+ (profile (assoc-ref opts 'profile))
+ (command (or (assoc-ref opts 'exec)
+ ;; Spawn a shell if the user didn't specify
+ ;; anything in particular.
+ (if container?
+ ;; The user's shell is likely not available
+ ;; within the container.
+ '("/bin/sh")
+ (list %default-shell))))
+ (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 (not container?)
+ (when link-prof?
+ (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
+ (when user
+ (leave (G_ "'--user' cannot be used without '--container'~%")))
+ (when no-cwd?
+ (leave (G_ "--no-cwd cannot be used without '--container'~%")))
+ (when emulate-fhs?
+ (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
+ (when (pair? symlinks)
+ (leave (G_ "'--symlink' cannot be used without '--container~%'"))))
+
+ (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
+ (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
+ (if container?
+ (warning (G_ "'--check' is unnecessary \
when using '--container'; doing nothing~%"))
- (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?)
- #:emulate-fhs? emulate-fhs?
- #:symlinks symlinks
- #:setup-hook
- (and emulate-fhs?
- setup-fhs))))
-
- (else
- (return
- (exit/status
- (launch-environment/fork command profile manifest
- #:white-list white-list
- #:pure? pure?))))))))))))))
+ (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?)
+ #:emulate-fhs? emulate-fhs?
+ #:symlinks symlinks
+ #:setup-hook
+ (and emulate-fhs?
+ setup-fhs))))
+
+ (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)
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index e3bddc4274..a101900736 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -42,6 +42,7 @@ (define-module (guix scripts pack)
#:use-module (guix profiles)
#:use-module (guix describe)
#:use-module (guix derivations)
+ #:use-module (guix diagnostics)
#:use-module (guix search-paths)
#:use-module (guix build-system gnu)
#:use-module (guix scripts build)
@@ -59,6 +60,7 @@ (define-module (guix scripts pack)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:export (symlink-spec-option-parser
@@ -163,12 +165,27 @@ (define str (string-join names "-"))
((names ... _) (loop names))))))
(define (symlink-spec-option-parser opt name arg result)
- "A SRFI-37 option parser for the --symlink option."
+ "A SRFI-37 option parser for the --symlink option. The symlink spec accepts
+the link file name as its left-hand side value and its target as its
+right-hand side value. The target must be a relative link."
;; Note: Using 'string-split' allows us to handle empty
;; TARGET (as in "/opt/guile=", meaning that /opt/guile is
;; a symlink to the profile) correctly.
- (match (string-split arg (char-set #\=))
+ (match (string-split arg #\=)
((source target)
+ (when (string-prefix? "/" target)
+ (raise-exception
+ (make-compound-condition
+ (formatted-message (G_ "symlink target is absolute: '~a'~%") target)
+ (condition
+ (&fix-hint (hint (format #f (G_ "The target of the symlink must be
+relative rather than absolute, as it is relative to the profile created.
+Perhaps the source and target components of the symlink spec were inverted?
+Below is a valid example, where the @file{/usr/bin/env} symbolic link is to
+target the profile's @file{bin/env} file:
+@example
+--symlink=/usr/bin/env=bin/env
+@end example"))))))))
(let ((symlinks (assoc-ref result 'symlinks)))
(alist-cons 'symlinks
`((,source -> ,target) ,@symlinks)
@@ -1310,74 +1327,74 @@ (define-command (guix-pack . args)
(category development)
(synopsis "create application bundles")
- (define opts
- (parse-command-line args %options (list %default-options)))
-
- (define maybe-package-argument
- ;; Given an option pair, return a package, a package/output tuple, or #f.
- (match-lambda
- (('argument . spec)
- (call-with-values
- (lambda ()
- (specification->package+output spec))
- list))
- (('expression . exp)
- (read/eval-package-expression exp))
- (x #f)))
-
- (define (manifest-from-args store opts)
- (let* ((transform (options->transformation opts))
- (packages (map (match-lambda
- (((? package? package) output)
- (list (transform package) output))
- ((? package? package)
- (list (transform package) "out")))
- (reverse
- (filter-map maybe-package-argument opts))))
- (manifests (filter-map (match-lambda
- (('manifest . file) file)
- (_ #f))
- opts)))
- (define with-provenance
- (if (assoc-ref opts 'save-provenance?)
- (lambda (manifest)
- (map-manifest-entries
- (lambda (entry)
- (let ((entry (manifest-entry-with-provenance entry)))
- (unless (assq 'provenance (manifest-entry-properties entry))
- (warning (G_ "could not determine provenance of package ~a~%")
- (manifest-entry-name entry)))
- entry))
- manifest))
- identity))
-
- (with-provenance
- (cond
- ((and (not (null? manifests)) (not (null? packages)))
- (leave (G_ "both a manifest and a package list were given~%")))
- ((not (null? manifests))
- (concatenate-manifests
- (map (lambda (file)
- (let ((user-module (make-user-module
- '((guix profiles) (gnu)))))
- (load* file user-module)))
- manifests)))
- (else
- (packages->manifest packages))))))
-
- (define (process-file-arg opts name)
- ;; Validate that the file exists and return it as a <local-file> object,
- ;; else #f.
- (let ((value (assoc-ref opts name)))
- (match value
- ((and (? string?) (not (? file-exists?)))
- (leave (G_ "file provided with option ~a does not exist: ~a~%")
- (string-append "--" (symbol->string name)) value))
- ((? string?)
- (local-file value))
- (#f #f))))
-
(with-error-handling
+ (define opts
+ (parse-command-line args %options (list %default-options)))
+
+ (define maybe-package-argument
+ ;; Given an option pair, return a package, a package/output tuple, or #f.
+ (match-lambda
+ (('argument . spec)
+ (call-with-values
+ (lambda ()
+ (specification->package+output spec))
+ list))
+ (('expression . exp)
+ (read/eval-package-expression exp))
+ (x #f)))
+
+ (define (manifest-from-args store opts)
+ (let* ((transform (options->transformation opts))
+ (packages (map (match-lambda
+ (((? package? package) output)
+ (list (transform package) output))
+ ((? package? package)
+ (list (transform package) "out")))
+ (reverse
+ (filter-map maybe-package-argument opts))))
+ (manifests (filter-map (match-lambda
+ (('manifest . file) file)
+ (_ #f))
+ opts)))
+ (define with-provenance
+ (if (assoc-ref opts 'save-provenance?)
+ (lambda (manifest)
+ (map-manifest-entries
+ (lambda (entry)
+ (let ((entry (manifest-entry-with-provenance entry)))
+ (unless (assq 'provenance (manifest-entry-properties entry))
+ (warning (G_ "could not determine provenance of package ~a~%")
+ (manifest-entry-name entry)))
+ entry))
+ manifest))
+ identity))
+
+ (with-provenance
+ (cond
+ ((and (not (null? manifests)) (not (null? packages)))
+ (leave (G_ "both a manifest and a package list were given~%")))
+ ((not (null? manifests))
+ (concatenate-manifests
+ (map (lambda (file)
+ (let ((user-module (make-user-module
+ '((guix profiles) (gnu)))))
+ (load* file user-module)))
+ manifests)))
+ (else
+ (packages->manifest packages))))))
+
+ (define (process-file-arg opts name)
+ ;; Validate that the file exists and return it as a <local-file> object,
+ ;; else #f.
+ (let ((value (assoc-ref opts name)))
+ (match value
+ ((and (? string?) (not (? file-exists?)))
+ (leave (G_ "file provided with option ~a does not exist: ~a~%")
+ (string-append "--" (symbol->string name)) value))
+ ((? string?)
+ (local-file value))
+ (#f #f))))
+
(with-store store
(with-status-verbosity (assoc-ref opts 'verbosity)
;; Set the build options before we do anything else.
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index 7a379122ae..2fc1dc942a 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -534,43 +534,44 @@ (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
+ (with-error-handling
+ (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."))) )
- ;; Clean the cache in EXIT-HOOK so that (1) it happens after potential use
- ;; of cached profiles, and (2) cleanup actually happens, even when
- ;; 'guix-environment*' calls 'exit'.
- (add-hook! exit-hook
- (lambda _
- (maybe-remove-expired-cache-entries
- (%profile-cache-directory)
- cache-entries
- #:entry-expiration entry-expiration)))
-
- (if (assoc-ref opts 'export-manifest?)
- (export-manifest opts (current-output-port))
- (guix-environment* opts)))
+ ;; Clean the cache in EXIT-HOOK so that (1) it happens after potential use
+ ;; of cached profiles, and (2) cleanup actually happens, even when
+ ;; 'guix-environment*' calls 'exit'.
+ (add-hook! exit-hook
+ (lambda _
+ (maybe-remove-expired-cache-entries
+ (%profile-cache-directory)
+ cache-entries
+ #:entry-expiration entry-expiration)))
+
+ (if (assoc-ref opts 'export-manifest?)
+ (export-manifest opts (current-output-port))
+ (guix-environment* opts))))
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index f19a0f754e..6fc9e3723b 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -103,7 +103,7 @@ fi
guix pack --dry-run --bootstrap -f docker guile-bootstrap
# Build a Docker image with a symlink.
-guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
+guix pack --dry-run --bootstrap -f docker -S /opt/gnu= guile-bootstrap
# Build a tarball pack of cross-compiled software. Use coreutils because
# guile-bootstrap is not intended to be cross-compiled.
--
2.37.3
^ permalink raw reply related [flat|nested] 60+ messages in thread
* [bug#58812] [PATCH 3/5] install: Validate symlink target in evaluate-populate-directive.
2022-10-27 3:50 ` [bug#58812] [PATCH 1/5] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
2022-10-27 3:50 ` [bug#58812] [PATCH 2/5] tests: Add a tests/utils.sh support file Maxim Cournoyer
@ 2022-10-27 3:50 ` Maxim Cournoyer
2022-11-09 21:06 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' Ludovic Courtès
2022-10-27 3:50 ` [bug#58812] [PATCH 4/5] guix: shell: Add '--symlink' option Maxim Cournoyer
2022-10-27 3:51 ` [bug#58812] [PATCH 5/5] shell: Detect --symlink spec problems early Maxim Cournoyer
3 siblings, 1 reply; 60+ messages in thread
From: Maxim Cournoyer @ 2022-10-27 3:50 UTC (permalink / raw)
To: 58812; +Cc: Maxim Cournoyer
* gnu/build/install.scm (evaluate-populate-directive): By default, error when
the target of a symlink doesn't exist. Always ensure TARGET ends with "/".
(populate-root-file-system): Call evaluate-populate-directive with
#:error-on-dangling-symlink #t and add comment.
---
gnu/build/install.scm | 60 ++++++++++++++++++++++++++++---------------
1 file changed, 40 insertions(+), 20 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index f5c8407b89..15cc29b2c8 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -56,19 +57,24 @@ (define (install-boot-config bootcfg bootcfg-location mount-point)
(define* (evaluate-populate-directive directive target
#:key
(default-gid 0)
- (default-uid 0))
+ (default-uid 0)
+ (error-on-dangling-symlink? #t))
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under
directory TARGET. DEFAULT-UID and DEFAULT-GID are the default UID and GID in
the context of the caller. If the directive matches those defaults then,
-'chown' won't be run."
+'chown' won't be run. When ERROR-ON-DANGLING-SYMLINK? is true, abort with an
+error when a dangling symlink would be created."
+ (define target* (if (string-suffix? "/" target)
+ target
+ (string-append target "/")))
(let loop ((directive directive))
(catch 'system-error
(lambda ()
(match directive
(('directory name)
- (mkdir-p (string-append target name)))
+ (mkdir-p (string-append target* name)))
(('directory name uid gid)
- (let ((dir (string-append target name)))
+ (let ((dir (string-append target* name)))
(mkdir-p dir)
;; If called from a context without "root" permissions, "chown"
;; to root will fail. In that case, do not try to run "chown"
@@ -78,27 +84,38 @@ (define* (evaluate-populate-directive directive target
(chown dir uid gid))))
(('directory name uid gid mode)
(loop `(directory ,name ,uid ,gid))
- (chmod (string-append target name) mode))
+ (chmod (string-append target* name) mode))
(('file name)
- (call-with-output-file (string-append target name)
+ (call-with-output-file (string-append target* name)
(const #t)))
(('file name (? string? content))
- (call-with-output-file (string-append target name)
+ (call-with-output-file (string-append target* name)
(lambda (port)
(display content port))))
((new '-> old)
- (let try ()
- (catch 'system-error
- (lambda ()
- (symlink old (string-append target new)))
- (lambda args
- ;; When doing 'guix system init' on the current '/', some
- ;; symlinks may already exists. Override them.
- (if (= EEXIST (system-error-errno args))
- (begin
- (delete-file (string-append target new))
- (try))
- (apply throw args))))))))
+ (let ((new* (string-append target* new)))
+ (let try ()
+ (catch 'system-error
+ (lambda ()
+ (when error-on-dangling-symlink?
+ ;; When the symbolic link points to a relative path,
+ ;; checking if its target exists must be done relative to
+ ;; the link location.
+ (with-directory-excursion (if (string-prefix? "/" old)
+ (getcwd)
+ (dirname new*)) ;relative
+ (unless (file-exists? old)
+ (error (format #f "symlink `~a' points to nonexistent \
+file `~a'" new* old)))))
+ (symlink old new*))
+ (lambda args
+ ;; When doing 'guix system init' on the current '/', some
+ ;; symlinks may already exists. Override them.
+ (if (= EEXIST (system-error-errno args))
+ (begin
+ (delete-file new*)
+ (try))
+ (apply throw args)))))))))
(lambda args
;; Usually we can only get here when installing to an existing root,
;; as with 'guix system init foo.scm /'.
@@ -142,7 +159,10 @@ (define* (populate-root-file-system system target
includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM.
EXTRAS is a list of directives appended to the built-in directives to populate
TARGET."
- (for-each (cut evaluate-populate-directive <> target)
+ ;; It's expected that some symbolic link targets do not exist yet, so do not
+ ;; error on dangling links.
+ (for-each (cut evaluate-populate-directive <> target
+ #:error-on-dangling-symlink? #f)
(append (directives (%store-directory)) extras))
;; Add system generation 1.
--
2.37.3
^ permalink raw reply related [flat|nested] 60+ messages in thread* [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell'.
2022-10-27 3:50 ` [bug#58812] [PATCH 3/5] install: Validate symlink target in evaluate-populate-directive Maxim Cournoyer
@ 2022-11-09 21:06 ` Ludovic Courtès
2022-11-10 3:37 ` Maxim Cournoyer
0 siblings, 1 reply; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-09 21:06 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: 58812
Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
> * gnu/build/install.scm (evaluate-populate-directive): By default, error when
> the target of a symlink doesn't exist. Always ensure TARGET ends with "/".
> (populate-root-file-system): Call evaluate-populate-directive with
> #:error-on-dangling-symlink #t and add comment.
[...]
> + (define target* (if (string-suffix? "/" target)
> + target
> + (string-append target "/")))
Maybe make it:
(let ((target (if …)))
…)
so there’s only one ‘target’ in scope (and no ‘target*’); otherwise it’s
easy to forget the ‘*’ and refer to wrong one.
> + (let ((new* (string-append target* new)))
Likewise.
> + (when error-on-dangling-symlink?
> + ;; When the symbolic link points to a relative path,
> + ;; checking if its target exists must be done relative to
> + ;; the link location.
> + (with-directory-excursion (if (string-prefix? "/" old)
> + (getcwd)
> + (dirname new*)) ;relative
> + (unless (file-exists? old)
> + (error (format #f "symlink `~a' points to nonexistent \
> +file `~a'" new* old)))))
> + (symlink old new*))
I would avoid the directory excursion when unnecessary:
(unless (if (string-prefix? "/" old)
(file-exists? old)
(with-directory-excursion (dirname new)
(file-exists? old)))
…)
(We could use ‘lstat’ instead of ‘file-exists?’ if we want to allow
symlinks to dangling symlinks…)
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread* [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell'.
2022-11-09 21:06 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' Ludovic Courtès
@ 2022-11-10 3:37 ` Maxim Cournoyer
2022-11-17 17:37 ` [bug#59164] Coding style: similarly-named variables Ludovic Courtès
0 siblings, 1 reply; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-10 3:37 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 58812
Hi again,
Ludovic Courtès <ludo@gnu.org> writes:
> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>
>> * gnu/build/install.scm (evaluate-populate-directive): By default, error when
>> the target of a symlink doesn't exist. Always ensure TARGET ends with "/".
>> (populate-root-file-system): Call evaluate-populate-directive with
>> #:error-on-dangling-symlink #t and add comment.
>
> [...]
>
>> + (define target* (if (string-suffix? "/" target)
>> + target
>> + (string-append target "/")))
>
> Maybe make it:
>
> (let ((target (if …)))
> …)
>
> so there’s only one ‘target’ in scope (and no ‘target*’); otherwise it’s
> easy to forget the ‘*’ and refer to wrong one.
It's a pattern I've used at other places; I find it more hygienic to not
shadow existing variables; it signal to the reader "be careful, this is
not the same as the argument-bound one, though they are closely
related".
>> + (when error-on-dangling-symlink?
>> + ;; When the symbolic link points to a relative path,
>> + ;; checking if its target exists must be done relative to
>> + ;; the link location.
>> + (with-directory-excursion (if (string-prefix? "/" old)
>> + (getcwd)
>> + (dirname new*)) ;relative
>> + (unless (file-exists? old)
>> + (error (format #f "symlink `~a' points to nonexistent \
>> +file `~a'" new* old)))))
>> + (symlink old new*))
>
> I would avoid the directory excursion when unnecessary:
>
> (unless (if (string-prefix? "/" old)
> (file-exists? old)
> (with-directory-excursion (dirname new)
> (file-exists? old)))
> …)
Done:
--8<---------------cut here---------------start------------->8---
modified gnu/build/install.scm
@@ -99,14 +99,14 @@ (define target* (if (string-suffix? "/" target)
(lambda ()
(when error-on-dangling-symlink?
;; When the symbolic link points to a relative path,
- ;; checking if its target exists must be done relative to
- ;; the link location.
- (with-directory-excursion (if (string-prefix? "/" old)
- (getcwd)
- (dirname new*)) ;relative
- (unless (file-exists? old)
- (error (format #f "symlink `~a' points to nonexistent \
-file `~a'" new* old)))))
+ ;; checking if its target exists must be done relatively
+ ;; to the link location.
+ (unless (if (string-prefix? "/" old)
+ (file-exists? old)
+ (with-directory-excursion (dirname new*)
+ (file-exists? old)))
+ (error (format #f "symlink `~a' points to nonexistent \
+file `~a'" new* old))))
(symlink old new*))
--8<---------------cut here---------------end--------------->8---
> (We could use ‘lstat’ instead of ‘file-exists?’ if we want to allow
> symlinks to dangling symlinks…)
It seems better to leave it as-is; the odd use case of symlinking to a
dangling symlink can be accomplished via "#:error-on-dangling-symlink
#f" :-).
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread* [bug#59164] Coding style: similarly-named variables
2022-11-10 3:37 ` Maxim Cournoyer
@ 2022-11-17 17:37 ` Ludovic Courtès
2022-11-17 18:44 ` [bug#58812] " zimoun
2022-11-17 20:34 ` Maxim Cournoyer
0 siblings, 2 replies; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-17 17:37 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: 59164, 58812
Hi,
Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>>
>>> * gnu/build/install.scm (evaluate-populate-directive): By default, error when
>>> the target of a symlink doesn't exist. Always ensure TARGET ends with "/".
>>> (populate-root-file-system): Call evaluate-populate-directive with
>>> #:error-on-dangling-symlink #t and add comment.
>>
>> [...]
>>
>>> + (define target* (if (string-suffix? "/" target)
>>> + target
>>> + (string-append target "/")))
>>
>> Maybe make it:
>>
>> (let ((target (if …)))
>> …)
>>
>> so there’s only one ‘target’ in scope (and no ‘target*’); otherwise it’s
>> easy to forget the ‘*’ and refer to wrong one.
>
> It's a pattern I've used at other places; I find it more hygienic to not
> shadow existing variables; it signal to the reader "be careful, this is
> not the same as the argument-bound one, though they are closely
> related".
I don’t buy it. :-) The reader might be careful yet end up using the
“wrong” variable. As long as the “wrong” variable has no use, I think
it’s best to shadow it so that mistakes cannot happen.
Of course the details vary depending on context, but I think we should
not start introducing this pattern in different places. Perhaps
something to discuss and codify under “Formatting Code”?
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread
* [bug#58812] [bug#59164] Coding style: similarly-named variables
2022-11-17 17:37 ` [bug#59164] Coding style: similarly-named variables Ludovic Courtès
@ 2022-11-17 18:44 ` zimoun
2022-11-18 17:02 ` Maxim Cournoyer
2022-11-17 20:34 ` Maxim Cournoyer
1 sibling, 1 reply; 60+ messages in thread
From: zimoun @ 2022-11-17 18:44 UTC (permalink / raw)
To: Ludovic Courtès, Maxim Cournoyer; +Cc: 59164, 58812
Hi,
On Thu, 17 Nov 2022 at 18:37, Ludovic Courtès <ludo@gnu.org> wrote:
>> It's a pattern I've used at other places; I find it more hygienic to not
>> shadow existing variables; it signal to the reader "be careful, this is
>> not the same as the argument-bound one, though they are closely
>> related".
>
> I don’t buy it. :-) The reader might be careful yet end up using the
> “wrong” variable. As long as the “wrong” variable has no use, I think
> it’s best to shadow it so that mistakes cannot happen.
>
> Of course the details vary depending on context, but I think we should
> not start introducing this pattern in different places. Perhaps
> something to discuss and codify under “Formatting Code”?
I agree with Ludo. For another instance than target*, the previous was,
--8<---------------cut here---------------start------------->8---
((new '-> old)
[...]
- (symlink old (string-append target new)))
[...]
- (delete-file (string-append target new))
--8<---------------cut here---------------end--------------->8---
then replaced by,
--8<---------------cut here---------------start------------->8---
((new '-> old)
[...]
+ (let ((new* (string-append target* new)))
[...]
+ (error (format #f "symlink `~a' points to nonexistent \
+file `~a'" new* old)))))
+ (symlink old new*))
--8<---------------cut here---------------end--------------->8---
Well, it seems a Star War. ;-) As Ludo, I am not convinced that it is
less error-prone, maybe the contrary.
Cheers,
simon
^ permalink raw reply [flat|nested] 60+ messages in thread* [bug#58812] [bug#59164] Coding style: similarly-named variables
2022-11-17 18:44 ` [bug#58812] " zimoun
@ 2022-11-18 17:02 ` Maxim Cournoyer
2022-11-21 15:02 ` zimoun
0 siblings, 1 reply; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-18 17:02 UTC (permalink / raw)
To: zimoun; +Cc: Ludovic Courtès, 59164, 58812
Hi,
zimoun <zimon.toutoune@gmail.com> writes:
> Hi,
>
> On Thu, 17 Nov 2022 at 18:37, Ludovic Courtès <ludo@gnu.org> wrote:
>
>>> It's a pattern I've used at other places; I find it more hygienic to not
>>> shadow existing variables; it signal to the reader "be careful, this is
>>> not the same as the argument-bound one, though they are closely
>>> related".
>>
>> I don’t buy it. :-) The reader might be careful yet end up using the
>> “wrong” variable. As long as the “wrong” variable has no use, I think
>> it’s best to shadow it so that mistakes cannot happen.
>>
>> Of course the details vary depending on context, but I think we should
>> not start introducing this pattern in different places. Perhaps
>> something to discuss and codify under “Formatting Code”?
>
> I agree with Ludo. For another instance than target*, the previous was,
>
> ((new '-> old)
> [...]
> - (symlink old (string-append target new)))
> [...]
> - (delete-file (string-append target new))
>
>
> then replaced by,
>
> ((new '-> old)
> [...]
> + (let ((new* (string-append target* new)))
> [...]
> + (error (format #f "symlink `~a' points to nonexistent \
> +file `~a'" new* old)))))
> + (symlink old new*))
The intent was to keep away from the following imperative style, which
hurts both readability and debuggability in my opinion:
--8<---------------cut here---------------start------------->8---
(let* ((my-target "something")
(my-target (mutate-once my-target))
(my-target (mutate-twice my-target)))
(do-something-with my-target))
--8<---------------cut here---------------end--------------->8---
Perhaps the problem at hand would benefit being broken down in smaller
chunks, to avoid having a page-full of code sharing the same scope.
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread* [bug#58812] [bug#59164] Coding style: similarly-named variables
2022-11-18 17:02 ` Maxim Cournoyer
@ 2022-11-21 15:02 ` zimoun
2022-11-21 15:52 ` [bug#59164] " zimoun
2022-11-21 20:55 ` Maxim Cournoyer
0 siblings, 2 replies; 60+ messages in thread
From: zimoun @ 2022-11-21 15:02 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: Ludovic Courtès, 59164, 58812
Hi Maxim,
On Fri, 18 Nov 2022 at 12:02, Maxim Cournoyer <maxim.cournoyer@gmail.com> wrote:
> The intent was to keep away from the following imperative style, which
> hurts both readability and debuggability in my opinion:
>
> --8<---------------cut here---------------start------------->8---
> (let* ((my-target "something")
> (my-target (mutate-once my-target))
> (my-target (mutate-twice my-target)))
> (do-something-with my-target))
> --8<---------------cut here---------------end--------------->8---
Well, ’mutate-*’ is not really mutating. Maybe I miss something and
from my understanding, this ’let*’reads,
--8<---------------cut here---------------start------------->8---
(let ((my-target "something"))
(let ((my-target (mutate-once my-target)))
(let ((my-target (mutate-twice my-target)))
(do-something-with my-target))))
--8<---------------cut here---------------end--------------->8---
and not,
--8<---------------cut here---------------start------------->8---
(begin
(define my-target "something")
(set! my-target (mutate-once my-target))
(set! my-target (mutate-twice my-target))
(do-something-with my-target))
--8<---------------cut here---------------end--------------->8---
Well, the former is ’lexical-scope’d so the 3 ’my-target’ are not truly
an imperative style, I guess.
Back to the pattern, you are suggesting to write,
--8<---------------cut here---------------start------------->8---
(let* ((my-target "something")
(my-target* (mutate-once my-target))
(my-target** (mutate-twice my-target*)))
(do-something-with my-target**))
--8<---------------cut here---------------end--------------->8---
well, I am not convinced it helps for readibility. And I think, the
pattern is manually doing what ’let*’ is already doing for you.
Cheers,
simon
^ permalink raw reply [flat|nested] 60+ messages in thread* [bug#59164] [bug#58812] [bug#59164] Coding style: similarly-named variables
2022-11-21 15:02 ` zimoun
@ 2022-11-21 15:52 ` zimoun
2022-11-21 20:55 ` Maxim Cournoyer
1 sibling, 0 replies; 60+ messages in thread
From: zimoun @ 2022-11-21 15:52 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: Ludovic Courtès, 59164, 58812
On Mon, 21 Nov 2022 at 16:02, zimoun <zimon.toutoune@gmail.com> wrote:
> Well, ’mutate-*’ is not really mutating. Maybe I miss something and
> from my understanding, this ’let*’reads,
>
> --8<---------------cut here---------------start------------->8---
> (let ((my-target "something"))
> (let ((my-target (mutate-once my-target)))
> (let ((my-target (mutate-twice my-target)))
> (do-something-with my-target))))
> --8<---------------cut here---------------end--------------->8---
Well, it compiles to something similar…
> And I think, the
> pattern is manually doing what ’let*’ is already doing for you.
…for instance, it reads,
--8<---------------cut here---------------start------------->8---
scheme@(guix-user)> (macroexpand
'(let* ((my-target "something")
(my-target (mutate-once my-target))
(my-target (mutate-twice my-target)))
(do-something-with my-target)))
$1= #<tree-il
(let (my-target) (my-target-11e760207b4c89cb-114)
((const "something"))
(let (my-target) (my-target-11e760207b4c89cb-116)
((call (toplevel mutate-once) (lexical my-target my-target-11e760207b4c89cb-114)))
(let (my-target) (my-target-11e760207b4c89cb-118)
((call (toplevel mutate-twice) (lexical my-target my-target-11e760207b4c89cb-116)))
(call (toplevel do-something-with) (lexical my-target my-target-11e760207b4c89cb-118)))))>
--8<---------------cut here---------------end--------------->8---
Cheers,
simon
^ permalink raw reply [flat|nested] 60+ messages in thread* [bug#58812] [bug#59164] Coding style: similarly-named variables
2022-11-21 15:02 ` zimoun
2022-11-21 15:52 ` [bug#59164] " zimoun
@ 2022-11-21 20:55 ` Maxim Cournoyer
2022-11-22 14:35 ` [bug#59164] " zimoun
1 sibling, 1 reply; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-21 20:55 UTC (permalink / raw)
To: zimoun; +Cc: Ludovic Courtès, 59164, 58812
Hi Simon,
zimoun <zimon.toutoune@gmail.com> writes:
> Hi Maxim,
>
> On Fri, 18 Nov 2022 at 12:02, Maxim Cournoyer <maxim.cournoyer@gmail.com> wrote:
>
>> The intent was to keep away from the following imperative style, which
>> hurts both readability and debuggability in my opinion:
>>
>> --8<---------------cut here---------------start------------->8---
>> (let* ((my-target "something")
>> (my-target (mutate-once my-target))
>> (my-target (mutate-twice my-target)))
>> (do-something-with my-target))
>> --8<---------------cut here---------------end--------------->8---
>
> Well, ’mutate-*’ is not really mutating. Maybe I miss something and
> from my understanding, this ’let*’reads,
>
> (let ((my-target "something"))
> (let ((my-target (mutate-once my-target)))
> (let ((my-target (mutate-twice my-target)))
> (do-something-with my-target))))
>
>
> and not,
>
> (begin
> (define my-target "something")
> (set! my-target (mutate-once my-target))
> (set! my-target (mutate-twice my-target))
> (do-something-with my-target))
Right. I used "mutated" where I should have used "shadowed by lexical
scoping". The outcome for me is the same; the original value of an
argument (target) in the code gets shadowed, thus is theory it becomes
more difficult to inspect its original value, should we have a debugger
that is able to stop at the place to inspect to print ',locals'.
In practice since using breakpoints/a debugger to debug Guile code
rarely works as intended (in my experience hacking on Guix!), we
typically sprinkle the source with 'pk', and that point becomes moot.
> Well, the former is ’lexical-scope’d so the 3 ’my-target’ are not truly
> an imperative style, I guess.
>
> Back to the pattern, you are suggesting to write,
>
> (let* ((my-target "something")
> (my-target* (mutate-once my-target))
> (my-target** (mutate-twice my-target*)))
> (do-something-with my-target**))
> well, I am not convinced it helps for readibility. And I think, the
> pattern is manually doing what ’let*’ is already doing for you.
The value it provides is that it becomes easy to inspect each
intermediary result in a debugger.
I think we're done expressing the arguments to have on both sides, which
aren't too strong either ways :-). I'm happy to restrain myself using
such a pattern and keep moving forward.
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread
* [bug#59164] [bug#58812] [bug#59164] Coding style: similarly-named variables
2022-11-21 20:55 ` Maxim Cournoyer
@ 2022-11-22 14:35 ` zimoun
2022-11-25 15:23 ` Guile debugger workgroup? (was: Coding style: similarly-named variables) Maxim Cournoyer
2022-11-26 14:47 ` [bug#58812] [bug#59164] Coding style: similarly-named variables Ludovic Courtès
0 siblings, 2 replies; 60+ messages in thread
From: zimoun @ 2022-11-22 14:35 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: Ludovic Courtès, 59164, 58812
Hi Maxim,
On Mon, 21 Nov 2022 at 15:55, Maxim Cournoyer <maxim.cournoyer@gmail.com> wrote:
> In practice since using breakpoints/a debugger to debug Guile code
> rarely works as intended (in my experience hacking on Guix!), we
> typically sprinkle the source with 'pk', and that point becomes moot.
I totally agree! Preparing some materials for introducing Guile to
GuixHPC folk, I am trying to collect some tips and, if I am honest, the
debugging experience with Guile is really poor; compared to others (as
Python). For example, DrRacket provides an easy and nice user
experience [1] – where it is easy to compare each intermediary result in
the debugger. For what it is worth, I have not been able to have some
similar inspections as in [1]. Maybe, I am missing something…
Well, IMHO, we are somehow suffering from some Guile limitations and
improvements in this area are an hard task.
Cheers,
simon
Short video demoing (link will be dead after 2022-12-07)
1: https://filesender.renater.fr/?s=download&token=92d4312a-91b4-402e-898a-40ce01a5c3ed
^ permalink raw reply [flat|nested] 60+ messages in thread
* Guile debugger workgroup? (was: Coding style: similarly-named variables)
2022-11-22 14:35 ` [bug#59164] " zimoun
@ 2022-11-25 15:23 ` Maxim Cournoyer
2022-11-26 11:22 ` Guile debugger workgroup? Ludovic Courtès
` (2 more replies)
2022-11-26 14:47 ` [bug#58812] [bug#59164] Coding style: similarly-named variables Ludovic Courtès
1 sibling, 3 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-25 15:23 UTC (permalink / raw)
To: zimoun; +Cc: Ludovic Courtès, guix-devel
Hi Simon,
zimoun <zimon.toutoune@gmail.com> writes:
> Hi Maxim,
>
> On Mon, 21 Nov 2022 at 15:55, Maxim Cournoyer <maxim.cournoyer@gmail.com> wrote:
>
>> In practice since using breakpoints/a debugger to debug Guile code
>> rarely works as intended (in my experience hacking on Guix!), we
>> typically sprinkle the source with 'pk', and that point becomes moot.
>
> I totally agree! Preparing some materials for introducing Guile to
> GuixHPC folk, I am trying to collect some tips and, if I am honest, the
> debugging experience with Guile is really poor; compared to others (as
> Python). For example, DrRacket provides an easy and nice user
> experience [1] – where it is easy to compare each intermediary result in
> the debugger. For what it is worth, I have not been able to have some
> similar inspections as in [1]. Maybe, I am missing something…
>
> Well, IMHO, we are somehow suffering from some Guile limitations and
> improvements in this area are an hard task.
I also agree! It's hard to convince people to pick Guile for their
project when there is:
1. Lack of a debugger that can break and step anywhere in your source
code
2. Lack of debugger integration to an IDE (it's not even integrated into
Emacs)
Perhaps we should assemble a Guile debugger workgroup that'd review
what's broken, what's missing, what can be borrowed from other Scheme or
languages for inspiration, and hopefully improve the Guile debugging
experience? :-)
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread* Re: Guile debugger workgroup?
2022-11-25 15:23 ` Guile debugger workgroup? (was: Coding style: similarly-named variables) Maxim Cournoyer
@ 2022-11-26 11:22 ` Ludovic Courtès
2022-11-27 3:16 ` Maxim Cournoyer
` (2 more replies)
2022-11-28 12:24 ` Guile debugger workgroup? (was: Coding style: similarly-named variables) Csepp
2022-11-30 7:09 ` Guile debugger workgroup? Jannneke Nieuwenhuizen
2 siblings, 3 replies; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-26 11:22 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: zimoun, guix-devel
Hi,
Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
> I also agree! It's hard to convince people to pick Guile for their
> project when there is:
>
> 1. Lack of a debugger that can break and step anywhere in your source
> code
> 2. Lack of debugger integration to an IDE (it's not even integrated into
> Emacs)
Well, Guile has a debugger that lets you do that (modulo inlining etc.,
as with any other compiler), and Geiser is not Visual Studio™ but it
does a good job.
Also, I think I mentioned before that I almost never use breakpoints on
Guile code—not because of some deficiency of the debugger, not (just)
because I’m silly or inexperienced, but because it’s rarely the right
tool for the job.
I believe this is largely due to (1) writing functional code, and (2)
doing live programming at the REPL. Why would you use breakpoints when
you can just call the relevant procedures on some input to see how they
behave?
So I think you won’t convince people to pick Guile for their project by
selling it as a C/C++/Python drop-in replacement. Guile is about
functional programming and live coding so the set of tools differs.
> Perhaps we should assemble a Guile debugger workgroup that'd review
> what's broken, what's missing, what can be borrowed from other Scheme or
> languages for inspiration, and hopefully improve the Guile debugging
> experience? :-)
Despite what I wrote, I think it’s a good idea. I suppose inspiration
would come from other Schemes, in particular Racket, and perhaps from
other live-coding systems (Common Lisp, Smalltalk, etc.), rather than
from Python or C.
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread* Re: Guile debugger workgroup?
2022-11-26 11:22 ` Guile debugger workgroup? Ludovic Courtès
@ 2022-11-27 3:16 ` Maxim Cournoyer
2022-11-28 10:53 ` Ludovic Courtès
2022-11-27 12:04 ` zimoun
2022-11-27 20:46 ` Attila Lendvai
2 siblings, 1 reply; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-27 3:16 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: zimoun, guix-devel
Hi Ludovic,
Ludovic Courtès <ludo@gnu.org> writes:
> Hi,
>
> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>
>> I also agree! It's hard to convince people to pick Guile for their
>> project when there is:
>>
>> 1. Lack of a debugger that can break and step anywhere in your source
>> code
>> 2. Lack of debugger integration to an IDE (it's not even integrated into
>> Emacs)
>
> Well, Guile has a debugger that lets you do that (modulo inlining etc.,
> as with any other compiler), and Geiser is not Visual Studio™ but it
> does a good job.
I'll try to get more concrete with actual scenarios, but for now it's
just a feeling that "it rarely works", e.g. break points don't stop or
the code stepped is hardly recognizable. Perhaps Guile aggressively
inline things or macros add to the confusion, but that shouldn't be a
price the user has to pay for. One of Guile's strong points is supposed
to be that it's geared for interactive programming, and I'd categorize
stepping code being related to the programming experience being
"interactive".
> Also, I think I mentioned before that I almost never use breakpoints on
> Guile code—not because of some deficiency of the debugger, not (just)
> because I’m silly or inexperienced, but because it’s rarely the right
> tool for the job.
>
> I believe this is largely due to (1) writing functional code, and (2)
> doing live programming at the REPL. Why would you use breakpoints when
> you can just call the relevant procedures on some input to see how they
> behave?
And I've probably countered that before by saying that while it's true
that functional programming helps, there are still times where the
inputs or the lexical environment I need to understand are complex
enough that reproducing them at the global level (REPL) is a pain. Just
breaking at the right place and typing ,locals would be a much more
efficient way to proceed to see what the environment in scope looks
like.
> So I think you won’t convince people to pick Guile for their project by
> selling it as a C/C++/Python drop-in replacement. Guile is about
> functional programming and live coding so the set of tools differs.
Debugging/live coding abilities do not have to be mutually exclusive.
Python excels at both, in my experience.
>> Perhaps we should assemble a Guile debugger workgroup that'd review
>> what's broken, what's missing, what can be borrowed from other Scheme or
>> languages for inspiration, and hopefully improve the Guile debugging
>> experience? :-)
>
> Despite what I wrote, I think it’s a good idea. I suppose inspiration
> would come from other Schemes, in particular Racket, and perhaps from
> other live-coding systems (Common Lisp, Smalltalk, etc.), rather than
> from Python or C.
Great!
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread
* Re: Guile debugger workgroup?
2022-11-27 3:16 ` Maxim Cournoyer
@ 2022-11-28 10:53 ` Ludovic Courtès
2022-11-28 13:41 ` Attila Lendvai
0 siblings, 1 reply; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-28 10:53 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: zimoun, guix-devel
Hi,
Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
> Ludovic Courtès <ludo@gnu.org> writes:
[...]
>> Also, I think I mentioned before that I almost never use breakpoints on
>> Guile code—not because of some deficiency of the debugger, not (just)
>> because I’m silly or inexperienced, but because it’s rarely the right
>> tool for the job.
>>
>> I believe this is largely due to (1) writing functional code, and (2)
>> doing live programming at the REPL. Why would you use breakpoints when
>> you can just call the relevant procedures on some input to see how they
>> behave?
>
> And I've probably countered that before by saying that while it's true
> that functional programming helps, there are still times where the
> inputs or the lexical environment I need to understand are complex
> enough that reproducing them at the global level (REPL) is a pain. Just
> breaking at the right place and typing ,locals would be a much more
> efficient way to proceed to see what the environment in scope looks
> like.
Agreed, I didn’t mean to suggest that breakpoints are never useful.
The scenario you describe above should be possible above (there *is* a
debugger that supports breakpoints and single stepping). Now, it may
be, as you wrote, that inlining can lead breakpoints to never be hit, or
that there are bugs in this area. These things should be fixed, I agree.
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread
* Re: Guile debugger workgroup?
2022-11-28 10:53 ` Ludovic Courtès
@ 2022-11-28 13:41 ` Attila Lendvai
2022-11-28 14:50 ` Maxim Cournoyer
2022-11-29 8:46 ` Ludovic Courtès
0 siblings, 2 replies; 60+ messages in thread
From: Attila Lendvai @ 2022-11-28 13:41 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Maxim Cournoyer, zimoun, guix-devel
> The scenario you describe above should be possible above (there is a
> debugger that supports breakpoints and single stepping). Now, it may
> be, as you wrote, that inlining can lead breakpoints to never be hit, or
> that there are bugs in this area. These things should be fixed, I agree.
i'm sure there's a way to globally override the debug/optimization/inlining level in guile to make sure the code compiles in a way that no breakpoints are missed (and/or backtraces remain more intact, etc).
this should also be added to the documentation, especially in the guix context, where it's very much not as trivial as to change a command line argument to e.g. start the guix daemon, or shepherd, in a configuration that makes things more debuggable.
--
• attila lendvai
• PGP: 963F 5D5F 45C7 DFCD 0A39
--
“Knowledge makes a man unfit to be a slave.”
— Frederick Douglass (1818–1895), a former slave.
^ permalink raw reply [flat|nested] 60+ messages in thread
* Re: Guile debugger workgroup?
2022-11-28 13:41 ` Attila Lendvai
@ 2022-11-28 14:50 ` Maxim Cournoyer
2022-11-29 8:46 ` Ludovic Courtès
1 sibling, 0 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-28 14:50 UTC (permalink / raw)
To: Attila Lendvai; +Cc: Ludovic Courtès, zimoun, guix-devel
Hi,
Attila Lendvai <attila@lendvai.name> writes:
>> The scenario you describe above should be possible above (there is a
>> debugger that supports breakpoints and single stepping). Now, it may
>> be, as you wrote, that inlining can lead breakpoints to never be hit, or
>> that there are bugs in this area. These things should be fixed, I agree.
>
>
> i'm sure there's a way to globally override the
> debug/optimization/inlining level in guile to make sure the code
> compiles in a way that no breakpoints are missed (and/or backtraces
> remain more intact, etc).
The Guile documentation itself doesn't seem to be covered for that.
It'd be a good place to start in my opinion.
> this should also be added to the documentation, especially in the guix
> context, where it's very much not as trivial as to change a command
> line argument to e.g. start the guix daemon, or shepherd, in a
> configuration that makes things more debuggable.
That'd be nice yes. I think we should add the nice ideas/things noted
here in a "Improve debbuging experience" section of the
maintenance/doc/ROADMAP.org TODO.
I'll get to it if no-one beats me to it.
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread
* Re: Guile debugger workgroup?
2022-11-28 13:41 ` Attila Lendvai
2022-11-28 14:50 ` Maxim Cournoyer
@ 2022-11-29 8:46 ` Ludovic Courtès
2022-11-30 3:44 ` Attila Lendvai
1 sibling, 1 reply; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-29 8:46 UTC (permalink / raw)
To: Attila Lendvai; +Cc: Maxim Cournoyer, zimoun, guix-devel
Attila Lendvai <attila@lendvai.name> skribis:
>> The scenario you describe above should be possible above (there is a
>> debugger that supports breakpoints and single stepping). Now, it may
>> be, as you wrote, that inlining can lead breakpoints to never be hit, or
>> that there are bugs in this area. These things should be fixed, I agree.
>
>
> i'm sure there's a way to globally override the debug/optimization/inlining level in guile to make sure the code compiles in a way that no breakpoints are missed (and/or backtraces remain more intact, etc).
Note that I’m not even sure this bug exists (hence “may” :-)) but if it
does, you’re right, it’s probably a matter of compiling with -O1.
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread
* Re: Guile debugger workgroup?
2022-11-29 8:46 ` Ludovic Courtès
@ 2022-11-30 3:44 ` Attila Lendvai
0 siblings, 0 replies; 60+ messages in thread
From: Attila Lendvai @ 2022-11-30 3:44 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Maxim Cournoyer, zimoun, guix-devel
> > > The scenario you describe above should be possible above (there is a
> > > debugger that supports breakpoints and single stepping). Now, it may
> > > be, as you wrote, that inlining can lead breakpoints to never be hit, or
> > > that there are bugs in this area. These things should be fixed, I agree.
> >
> > i'm sure there's a way to globally override the debug/optimization/inlining level in guile to make sure the code compiles in a way that no breakpoints are missed (and/or backtraces remain more intact, etc).
>
>
> Note that I’m not even sure this bug exists (hence “may” :-)) but if it
> does, you’re right, it’s probably a matter of compiling with -O1.
i would be quite surprised if brakepoints in Guile worked on inlined function invocations... but hey! i like positive surprises! :)
but in general, optimized code is usually less debuggable due to the tradeoffs taken. having a means to force parts of the codebase to run in unoptimized form is usually very helpful when debugging.
and sometimes it makes sense to straight out force parts of the code to always be unoptimized, or run in the interpreter, if it's not in a hotspot of the codebase, and it's expected to be involved often in situations where errors are raised.
--
• attila lendvai
• PGP: 963F 5D5F 45C7 DFCD 0A39
--
“Liberty means responsibility. That is why most men dread it.”
— George Bernard Shaw (1856–1950), 'Man and Superman'
^ permalink raw reply [flat|nested] 60+ messages in thread
* Re: Guile debugger workgroup?
2022-11-26 11:22 ` Guile debugger workgroup? Ludovic Courtès
2022-11-27 3:16 ` Maxim Cournoyer
@ 2022-11-27 12:04 ` zimoun
2022-11-28 0:27 ` Maxim Cournoyer
2022-11-28 11:06 ` Ludovic Courtès
2022-11-27 20:46 ` Attila Lendvai
2 siblings, 2 replies; 60+ messages in thread
From: zimoun @ 2022-11-27 12:04 UTC (permalink / raw)
To: Ludovic Courtès, Maxim Cournoyer; +Cc: guix-devel
Hi Ludo,
On Sat, 26 Nov 2022 at 12:22, Ludovic Courtès <ludo@gnu.org> wrote:
> Well, Guile has a debugger that lets you do that (modulo inlining etc.,
> as with any other compiler), and Geiser is not Visual Studio™ but it
> does a good job.
And you wrote elsewhere in the thread:
It may be more of a limitation of Geiser than of Guile. I find
it more useful in “typical” imperative ELisp code than in
functional Scheme code, but it’d be nice to have either way!
<https://yhetil.org/guix/87pmd993i4.fsf@gnu.org>
Maybe I am wrong or miss some Guile features. From my experience, the
issue is not the way that the information is presented or how we
interact with it (Geiser or else) but, instead, the issue is the
availability of such information. And that is one limitation of Guile,
IMHO.
> Also, I think I mentioned before that I almost never use breakpoints on
> Guile code—not because of some deficiency of the debugger, not (just)
> because I’m silly or inexperienced, but because it’s rarely the right
> tool for the job.
That’s interesting. :-) Well, so you are using the good ol’ way putting
’pk’ here or there, right? One thing when debugging is to inspect the
current state of the program; what are the values of this or that, then
after running this other, etc. And, ’pk’ is the poor man
breakpoint. :-)
> I believe this is largely due to (1) writing functional code, and (2)
> doing live programming at the REPL. Why would you use breakpoints when
> you can just call the relevant procedures on some input to see how they
> behave?
Well, I do not think you are not using breakpoint with Guile because the
code is functional style. My guess is more that you have built your way
around the limitations of the Guile debugger.
For what this example is worth, I know people with 30+ years of
experience programming highly optimized C code and they never used GDB
or Valgrind or strace or else for debugging. Doing all debugging with
plain ’printf’. Well, because when they started, GDB and friends were
less efficient, other folk around were not used to these tools, etc.
And so they took habits without.
> So I think you won’t convince people to pick Guile for their project by
> selling it as a C/C++/Python drop-in replacement. Guile is about
> functional programming and live coding so the set of tools differs.
Racket is an example of functional programming and live coding. Haskell
is another; it is functional programming and if I might, I would
recommend to give a look at the interactive GHCi debugger [1].
Back to the initial example [2]. Racket is able to set breakpoints at
various places, as shown in the short demo [3]. Well, I am not able to
do that with Guile.
--8<---------------cut here---------------start------------->8---
$ cat -n my-target.scm
1 ;#lang racket
2
3 (define (mutate-once x)
4 (let ((once "once")
5 (dash "-"))
6 (string-append x dash once)))
7
8 (define (mutate-twice x)
9 (let* ((dash "-")
10 (twice "twice")
11 (stuff (string-append twice dash)))
12 (string-append "twice-" x)))
13
14 (define (do-something-with x)
15 (string-length x))
16
17 (define (example x)
18 (let* ((my-target "something")
19 (my-target (mutate-once my-target))
20 (my-target (mutate-twice my-target)))
21 (do-something-with my-target)))
--8<---------------cut here---------------end--------------->8---
then,
--8<---------------cut here---------------start------------->8---
$ guix repl
GNU Guile 3.0.8
Copyright (C) 1995-2021 Free Software Foundation, Inc.
Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.
Enter `,help' for help.
scheme@(guix-user)> (load "my-target.scm")
scheme@(guix-user)> ,break-at-source "my-target.scm" 17
While executing meta-command:
No procedures found at ~a:~a. "my-target.scm" 17
scheme@(guix-user)> ,break-at-source "/home/simon/tmp/my-target.scm" 17
While executing meta-command:
No procedures found at ~a:~a. "/home/simon/tmp/my-target.scm" 17
scheme@(guix-user)> (example #t)
$1 = 20
scheme@(guix-user)> ,break example
Trap 2: Breakpoint at #<procedure example (a)>.
scheme@(guix-user)> (example #t)
$2 = 20
scheme@(guix-user)>
--8<---------------cut here---------------end--------------->8---
How can I enter in the debugger? Do I only enter on error? Well, I end
to put ’pk’ here and there to inspect the code. Poor experience. :-)
Just to compare with Haskell (functional style, where it is hard nor
impossible to put equivalent of ’pk’ here or there :-)) – the code is
the equivalent as above.
--8<---------------cut here---------------start------------->8---
1 mutate_once x = x ++ dash ++ once
2 where
3 once = "once"
4 dash = "-"
5
6 mutate_twice x = stuff ++ x
7 where
8 dash = "-"
9 twice = "once"
10 stuff = twice ++ dash
11
12 do_something_with x = length x
13
14 example x = do_something_with my_target
15 where
16 my_target = mutate_twice my_target
17 where
18 my_target = mutate_once my_target
19 where
20 my_target = "something"
--8<---------------cut here---------------end--------------->8---
then,
--8<---------------cut here---------------start------------->8---
$ guix shell ghc gcc-toolchain -- ghci
GHCi, version 8.10.7: https://www.haskell.org/ghc/ :? for help
Prelude> :load my-target.hs
[1 of 1] Compiling Main ( my-target.hs, interpreted )
Ok, one module loaded.
*Main> :break 14
Breakpoint 0 activated at my-target.hs:14:13-39
*Main> example True
Stopped in Main.example, my-target.hs:14:13-39
_result :: Int = _
my_target :: [Char] = _
[my-target.hs:14:13-39] *Main> :list
13
14 example x = do_something_with my_target
^^^^^^^^^^^^^^^^^^^^^^^^^^^
15 where
[my-target.hs:14:13-39] *Main> :break 18
Breakpoint 1 activated at my-target.hs:18:21-41
[my-target.hs:14:13-39] *Main> :continue
Stopped in Main.example.my_target.my_target, my-target.hs:18:21-41
_result :: [Char] = _
my_target :: [Char] = _
[my-target.hs:18:21-41] *Main> :list
17 where
18 my_target = mutate_once my_target
^^^^^^^^^^^^^^^^^^^^^
19 where
[my-target.hs:18:21-41] *Main> my_target
"something"
[my-target.hs:18:21-41] *Main>
--8<---------------cut here---------------end--------------->8---
Well, again maybe I miss how to use the Guile debugger. From my small
experience, I have hard time to debug and inspect Guile code.
1: <https://downloads.haskell.org/~ghc/9.4.3/docs/users_guide/ghci.html#the-ghci-debugger>
2: <https://yhetil.org/guix/87y1s82o23.fsf@gmail.com>
3: Short video demoing (link will be dead after 2022-12-07)
https://filesender.renater.fr/?s=download&token=92d4312a-91b4-402e-898a-40ce01a5c3ed
Cheers,
simon
^ permalink raw reply [flat|nested] 60+ messages in thread* Re: Guile debugger workgroup?
2022-11-27 12:04 ` zimoun
@ 2022-11-28 0:27 ` Maxim Cournoyer
2022-11-28 11:06 ` Ludovic Courtès
1 sibling, 0 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-28 0:27 UTC (permalink / raw)
To: zimoun; +Cc: Ludovic Courtès, guix-devel
Hi Simon,
zimoun <zimon.toutoune@gmail.com> writes:
[...]
> Racket is an example of functional programming and live coding. Haskell
> is another; it is functional programming and if I might, I would
> recommend to give a look at the interactive GHCi debugger [1].
>
> Back to the initial example [2]. Racket is able to set breakpoints at
> various places, as shown in the short demo [3]. Well, I am not able to
> do that with Guile.
>
> $ cat -n my-target.scm
> 1 ;#lang racket
> 2
> 3 (define (mutate-once x)
> 4 (let ((once "once")
> 5 (dash "-"))
> 6 (string-append x dash once)))
> 7
> 8 (define (mutate-twice x)
> 9 (let* ((dash "-")
> 10 (twice "twice")
> 11 (stuff (string-append twice dash)))
> 12 (string-append "twice-" x)))
> 13
> 14 (define (do-something-with x)
> 15 (string-length x))
> 16
> 17 (define (example x)
> 18 (let* ((my-target "something")
> 19 (my-target (mutate-once my-target))
> 20 (my-target (mutate-twice my-target)))
> 21 (do-something-with my-target)))
>
>
> then,
>
> $ guix repl
> GNU Guile 3.0.8
> Copyright (C) 1995-2021 Free Software Foundation, Inc.
>
> Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
> This program is free software, and you are welcome to redistribute it
> under certain conditions; type `,show c' for details.
>
> Enter `,help' for help.
> scheme@(guix-user)> (load "my-target.scm")
> scheme@(guix-user)> ,break-at-source "my-target.scm" 17
> While executing meta-command:
> No procedures found at ~a:~a. "my-target.scm" 17
> scheme@(guix-user)> ,break-at-source "/home/simon/tmp/my-target.scm" 17
> While executing meta-command:
> No procedures found at ~a:~a. "/home/simon/tmp/my-target.scm" 17
> scheme@(guix-user)> (example #t)
> $1 = 20
> scheme@(guix-user)> ,break example
> Trap 2: Breakpoint at #<procedure example (a)>.
> scheme@(guix-user)> (example #t)
> $2 = 20
> scheme@(guix-user)>
>
>
> How can I enter in the debugger? Do I only enter on error? Well, I end
> to put ’pk’ here and there to inspect the code. Poor experience. :-)
>
> Just to compare with Haskell (functional style, where it is hard nor
> impossible to put equivalent of ’pk’ here or there :-)) – the code is
> the equivalent as above.
>
> 1 mutate_once x = x ++ dash ++ once
> 2 where
> 3 once = "once"
> 4 dash = "-"
> 5
> 6 mutate_twice x = stuff ++ x
> 7 where
> 8 dash = "-"
> 9 twice = "once"
> 10 stuff = twice ++ dash
> 11
> 12 do_something_with x = length x
> 13
> 14 example x = do_something_with my_target
> 15 where
> 16 my_target = mutate_twice my_target
> 17 where
> 18 my_target = mutate_once my_target
> 19 where
> 20 my_target = "something"
>
>
> then,
>
> $ guix shell ghc gcc-toolchain -- ghci
> GHCi, version 8.10.7: https://www.haskell.org/ghc/ :? for help
> Prelude> :load my-target.hs
> [1 of 1] Compiling Main ( my-target.hs, interpreted )
> Ok, one module loaded.
> *Main> :break 14
> Breakpoint 0 activated at my-target.hs:14:13-39
> *Main> example True
> Stopped in Main.example, my-target.hs:14:13-39
> _result :: Int = _
> my_target :: [Char] = _
> [my-target.hs:14:13-39] *Main> :list
> 13
> 14 example x = do_something_with my_target
> ^^^^^^^^^^^^^^^^^^^^^^^^^^^
> 15 where
> [my-target.hs:14:13-39] *Main> :break 18
> Breakpoint 1 activated at my-target.hs:18:21-41
> [my-target.hs:14:13-39] *Main> :continue
> Stopped in Main.example.my_target.my_target, my-target.hs:18:21-41
> _result :: [Char] = _
> my_target :: [Char] = _
> [my-target.hs:18:21-41] *Main> :list
> 17 where
> 18 my_target = mutate_once my_target
> ^^^^^^^^^^^^^^^^^^^^^
> 19 where
> [my-target.hs:18:21-41] *Main> my_target
> "something"
> [my-target.hs:18:21-41] *Main>
>
>
> Well, again maybe I miss how to use the Guile debugger. From my small
> experience, I have hard time to debug and inspect Guile code.
I think your above example summarizes well what appears to be wrong with
the Guile debugging experience; at least I personally strongly relate.
We should turn this kind of scenario into unit tests for Guile; the
output of the workgroup could then be to make these pass! There are
also paper cuts such as the malformed error message "No procedures found
at ~a:~a. "my-target.scm" 17".
When searching for how the debugger work in the Guile Reference info
manual, I also don't find anything useful: only the gut of the debugging
API of the Guile VM appears to be documented ("Debugging
Infrastructure"), so documentation is another place that could be
improved, with some examples and pro tips for real life, practical
debugging with Guile.
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread* Re: Guile debugger workgroup?
2022-11-27 12:04 ` zimoun
2022-11-28 0:27 ` Maxim Cournoyer
@ 2022-11-28 11:06 ` Ludovic Courtès
2022-11-28 12:31 ` zimoun
1 sibling, 1 reply; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-28 11:06 UTC (permalink / raw)
To: zimoun; +Cc: Maxim Cournoyer, guix-devel
Hi,
zimoun <zimon.toutoune@gmail.com> skribis:
> scheme@(guix-user)> ,break example
> Trap 2: Breakpoint at #<procedure example (a)>.
> scheme@(guix-user)> (example #t)
> $2 = 20
I get this:
--8<---------------cut here---------------start------------->8---
$ guile
GNU Guile 3.0.8
Copyright (C) 1995-2021 Free Software Foundation, Inc.
Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.
Enter `,help' for help.
scheme@(guile-user)> (load "/tmp/example.scm")
;;; note: source file /tmp/example.scm
;;; newer than compiled /home/ludo/.cache/guile/ccache/3.0-LE-8-4.6/tmp/example.scm.go
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;; or pass the --no-auto-compile argument to disable.
;;; compiling /tmp/example.scm
;;; <unknown-location>: warning: possibly unused local top-level variable `mutate-once'
;;; <unknown-location>: warning: possibly unused local top-level variable `mutate-twice'
;;; <unknown-location>: warning: possibly unused local top-level variable `do-something-with'
;;; <unknown-location>: warning: possibly unused local top-level variable `example'
;;; compiled /home/ludo/.cache/guile/ccache/3.0-LE-8-4.6/tmp/example.scm.go
scheme@(guile-user)> ,break example
Trap 0: Breakpoint at #<procedure example (x)>.
scheme@(guile-user)> (example #t)
Trap 0: Breakpoint at #<procedure example (x)>
Entering a new prompt. Type `,bt' for a backtrace or `,q' to continue.
scheme@(guile-user) [1]> ,bt
In /tmp/example.scm:
17:0 0 (example #t)
scheme@(guile-user) [1]> ,locals
No local variables.
--8<---------------cut here---------------end--------------->8---
and then:
--8<---------------cut here---------------start------------->8---
scheme@(guile-user) [1]> ,q
$1 = 20
scheme@(guile-user)> ,break /tmp/example.scm 17
While executing meta-command:
Wrong number of arguments to #<procedure 7f53bf0d0288 at system/repl/command.scm:671:0 (repl form)>
scheme@(guile-user)> ,break-at /tmp/example.scm 17
Trap 1: Breakpoint at /tmp/example.scm:17.
scheme@(guile-user)> (example #t)
Trap 1: Breakpoint at /tmp/example.scm:17
Entering a new prompt. Type `,bt' for a backtrace or `,q' to continue.
scheme@(guile-user) [1]> ,q
Trap 0: Breakpoint at #<procedure example (x)>
Entering a new prompt. Type `,bt' for a backtrace or `,q' to continue.
--8<---------------cut here---------------end--------------->8---
Why doesn’t it work in ‘guix repl’? Because auto-compilation is
disabled:
--8<---------------cut here---------------start------------->8---
$ head -1 $(type -P guix)
#!/gnu/store/805g934pgy3955g87ld6qixny6biwmj3-guile-wrapper/bin/guile --no-auto-compile
--8<---------------cut here---------------end--------------->8---
… which in turn causes ‘load’ to evaluate code.
I think we should identify scenarios where things don’t work as
expected, and then turn them into bug reports, documentation issues, or
any other concrete action we should take.
And I guess that brings us back to Maxim’s suggestion of starting a
debugger workgroup. :-)
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread* Re: Guile debugger workgroup?
2022-11-28 11:06 ` Ludovic Courtès
@ 2022-11-28 12:31 ` zimoun
0 siblings, 0 replies; 60+ messages in thread
From: zimoun @ 2022-11-28 12:31 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Maxim Cournoyer, guix-devel
Hi,
On Mon, 28 Nov 2022 at 12:06, Ludovic Courtès <ludo@gnu.org> wrote:
> Why doesn’t it work in ‘guix repl’? Because auto-compilation is
> disabled:
Ah, thanks. Well, maybe we could have an option to start “guix repl”
with debug mode available… even if it is really slow.
> I think we should identify scenarios where things don’t work as
> expected, and then turn them into bug reports, documentation issues, or
> any other concrete action we should take.
The example I provided is, IMHO, a good scenario for starting. :-) For
instance, ,step by ,step works,
--8<---------------cut here---------------start------------->8---
$ guix shell guile -- guile -q
GNU Guile 3.0.8
Copyright (C) 1995-2021 Free Software Foundation, Inc.
Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.
Enter `,help' for help.
scheme@(guile-user)> (load "/tmp/my-target.scm")
scheme@(guile-user)> ,break example
Trap 0: Breakpoint at #<procedure example (x)>.
scheme@(guile-user)> (example #t)
Trap 0: Breakpoint at #<procedure example (x)>
Entering a new prompt. Type `,bt' for a backtrace or `,q' to continue.
scheme@(guile-user) [1]> ,bt
In /tmp/my-target.scm:
17:0 0 (example #t)
scheme@(guile-user) [1]> ,s
Step into #<frame 7ff70be4ace0 example>
scheme@(guile-user) [1]> ,bt
In /tmp/my-target.scm:
19:21 0 (example _)
scheme@(guile-user) [1]> ,s
Step into #<frame 7ff70be73360 example>
scheme@(guile-user) [1]> ,s
Step into #<frame 7ff70beef870 example>
scheme@(guile-user) [1]> ,s
Step into #<frame 7ff70bf15f20 example>
scheme@(guile-user) [1]> ,bt
In /tmp/my-target.scm:
19:20 1 (example _)
3:0 0 (mutate-once "something")
scheme@(guile-user) [1]>
--8<---------------cut here---------------end--------------->8---
but then I do not know how many steps are required to reach the other
’mutate-twice’.
--8<---------------cut here---------------start------------->8---
Step into #<frame 7ff70bf15350 mutate-once>
Step into #<frame 7ff70dab0480 mutate-once>
4x Step into #<frame 7ff70cc70760 b>
5x Step into #<frame 7ff70cc198e0 catch>
4x Step into #<frame 7ff70cc70170 catch>
Step into #<frame 7ff70c378bf0 procedure?>
10x Step into #<frame 7ff70c3784b0 catch>
4x Step into #<frame 7ff70bb33af0 with-exception-handler>
Step into #<frame 7ff70ba1adf0 procedure?>
6x Step into #<frame 7ff70ba1a6b0 with-exception-handler>
3x Step into #<frame 7ff70c32d060 make-prompt-tag>
5x Step into #<frame 7ff70da0e910 with-exception-handler>
Step into #<frame 7ff70b9921d0>
…
--8<---------------cut here---------------end--------------->8---
And I do not know if ,break-at-source works correctly.
--8<---------------cut here---------------start------------->8---
$ cat -n /tmp/my-target.scm | grep 20
20 (my-target (mutate-twice my-target)))
$ guix shell guile -- guile -q
GNU Guile 3.0.8
Copyright (C) 1995-2021 Free Software Foundation, Inc.
Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.
Enter `,help' for help.
scheme@(guile-user)> (load "/tmp/my-target.scm")
scheme@(guile-user)> ,break example
Trap 0: Breakpoint at #<procedure example (x)>.
scheme@(guile-user)> (example #t)
Trap 0: Breakpoint at #<procedure example (x)>
Entering a new prompt. Type `,bt' for a backtrace or `,q' to continue.
scheme@(guile-user) [1]> ,bt
In /tmp/my-target.scm:
17:0 0 (example #t)
scheme@(guile-user) [1]> ,break-at-source "/tmp/my-target.scm" 20
Trap 1: Breakpoint at /tmp/my-target.scm:20.
scheme@(guile-user) [1]> ,bt
In /tmp/my-target.scm:
17:0 0 (example #t)
scheme@(guile-user) [1]> ,next
Step into #<frame 7f8c260a9b00 example>
scheme@(guile-user) [1]> ,bt
In /tmp/my-target.scm:
19:21 0 (example _)
scheme@(guile-user) [1]> ,locals
No local variables.
scheme@(guile-user) [1]>
--8<---------------cut here---------------end--------------->8---
Cheers,
simon
^ permalink raw reply [flat|nested] 60+ messages in thread
* Re: Guile debugger workgroup?
2022-11-26 11:22 ` Guile debugger workgroup? Ludovic Courtès
2022-11-27 3:16 ` Maxim Cournoyer
2022-11-27 12:04 ` zimoun
@ 2022-11-27 20:46 ` Attila Lendvai
2022-11-28 0:41 ` David Pirotte
` (2 more replies)
2 siblings, 3 replies; 60+ messages in thread
From: Attila Lendvai @ 2022-11-27 20:46 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Maxim Cournoyer, zimoun, guix-devel
coming from common lisp (and SBCL in particular), i think the lowest hanging fruit in the guile debugging experience is making sure that backtraces are not cut short when printed.
i tried multiple ways to configure the printer to acquire more info, but it didn't react to anything i tried:
(setenv "COLUMNS" "300")
(debug-set! width 160)
(debug-set! depth 1000)
this is regularly causing me frustration when all i need to make progress is in the cut off part of the backtrace, and the code in question is in a part of the codebase that i can't easily change to add some good old printf's.
which reminds me that a project-wide logging infrastructure would also greatly elevate the guix debugging experience.
--
• attila lendvai
• PGP: 963F 5D5F 45C7 DFCD 0A39
--
If you never heal from what hurt you, you'll bleed on people who didn't cut you.
^ permalink raw reply [flat|nested] 60+ messages in thread* Re: Guile debugger workgroup?
2022-11-27 20:46 ` Attila Lendvai
@ 2022-11-28 0:41 ` David Pirotte
2022-11-28 0:45 ` David Pirotte
2022-11-28 2:06 ` Maxim Cournoyer
2022-11-28 11:09 ` Ludovic Courtès
2 siblings, 1 reply; 60+ messages in thread
From: David Pirotte @ 2022-11-28 0:41 UTC (permalink / raw)
To: Attila Lendvai; +Cc: Ludovic Courtès, Maxim Cournoyer, zimoun, guix-devel
[-- Attachment #1: Type: text/plain, Size: 1773 bytes --]
Hello Attila,
> coming from common lisp (and SBCL in particular), i think the lowest
> hanging fruit in the guile debugging experience is making sure that
> backtraces are not cut short when printed.
Not 'by default' though, I would personally vote against such a change
[1].
Did you try, after the exception is raised:
,bt #:full? #t :#width 1000 (or higher if needed)
That always worked for me.
David
[1]
Fwiw, I am actually trying to get our maintainers to accept to set the
very same 'truncate' defaults for both repl printiers [2] and raised
exception printers [3].
[2]
repl printers can be easily configured by users though, even for none
experimented users, so ok but I would still prefer the default to
truncate the output. Here is how though, for those interested
https://www.gnu.org/software/guile-cv/manual/html_node/Configuring-Guile_0027s-repl_002dprint-procedure.html
[3]
raised exception printer are next to impossible to configure for none
experimented users, and even 'advanced' or 'very advanced' guilers
do not know how to do this, and when advised with the proper solution,
there are just 'scared' to implement it (which I understand, as the
solution requires to patch (ice-9 boot-9).
This is explained here, again, fwiw:
https://www.gnu.org/software/guile-cv/manual/html_node/Configuring-Guile_0027s-raised-exception-system.html
But there is a patch, if you prefer
https://git.savannah.gnu.org/cgit/guile.git?h=wip-exception-truncate
https://git.savannah.gnu.org/cgit/guile.git/commit/?h=wip-exception-truncate&id=1a919d98514f1184b91085a19b55a4c719300149
[ for guile-3.0 ofc, and you'd need to install from the source
[ in the first place, then cherry pick the patch ...
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]
^ permalink raw reply [flat|nested] 60+ messages in thread
* Re: Guile debugger workgroup?
2022-11-27 20:46 ` Attila Lendvai
2022-11-28 0:41 ` David Pirotte
@ 2022-11-28 2:06 ` Maxim Cournoyer
2022-11-28 7:22 ` Joshua Branson
2022-11-28 11:09 ` Ludovic Courtès
2 siblings, 1 reply; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-28 2:06 UTC (permalink / raw)
To: Attila Lendvai; +Cc: Ludovic Courtès, zimoun, guix-devel
Hi Attila,
Attila Lendvai <attila@lendvai.name> writes:
> coming from common lisp (and SBCL in particular), i think the lowest
> hanging fruit in the guile debugging experience is making sure that
> backtraces are not cut short when printed.
>
> i tried multiple ways to configure the printer to acquire more info,
> but it didn't react to anything i tried:
>
> (setenv "COLUMNS" "300")
> (debug-set! width 160)
> (debug-set! depth 1000)
>
> this is regularly causing me frustration when all i need to make
> progress is in the cut off part of the backtrace, and the code in
> question is in a part of the codebase that i can't easily change to
> add some good old printf's.
Thanks for reminding me of this problem. I thought the following might
do it:
--8<---------------cut here---------------start------------->8---
modified doc/guix.texi
@@ -18263,6 +18263,10 @@ This data type represents the configuration of the Guix build daemon.
@item @code{guix} (default: @var{guix})
The Guix package to use.
+@item @code{backtrace-width} (default: @var{400})
+The character width at which backtraces of Guile processes launched by
+the Guix daemon should be truncated.
+
@item @code{build-group} (default: @code{"guixbuild"})
Name of the group for build user accounts.
modified gnu/services/base.scm
@@ -187,6 +187,7 @@ (define-module (gnu services base)
guix-configuration?
guix-configuration-guix
+ guix-configuration-backtrace-width
guix-configuration-build-group
guix-configuration-build-accounts
guix-configuration-authorize-key?
@@ -1634,6 +1635,8 @@ (define-record-type* <guix-configuration>
(default 0))
(timeout guix-configuration-timeout ;integer
(default 0))
+ (backtrace-width guix-configuration-backtrace-width ;integer
+ (default 400))
(log-compression guix-configuration-log-compression
(default 'gzip))
(discover? guix-configuration-discover?
@@ -1701,7 +1704,7 @@ (define (guix-shepherd-service config)
(guix build-group build-accounts authorize-key? authorized-keys
use-substitutes? substitute-urls max-silent-time timeout
log-compression discover? extra-options log-file
- http-proxy tmpdir chroot-directories)
+ http-proxy tmpdir chroot-directories backtrace-width)
(list (shepherd-service
(documentation "Run the Guix daemon.")
(provision '(guix-daemon))
@@ -1771,6 +1774,9 @@ (define discover?
(list (string-append "TMPDIR=" tmpdir))
'())
+ #$(string-append "COLUMNS=" (number->string
+ backtrace-width))
+
;; Make sure we run in a UTF-8 locale so that
;; 'guix offload' correctly restores nars
;; that contain UTF-8 file names such as
--8<---------------cut here---------------end--------------->8---
But it doesn't seem to work :-(.
> which reminds me that a project-wide logging infrastructure would also
> greatly elevate the guix debugging experience.
I wouldn't be against having a logging system in Guix; there's a readily
available logging library part of guile-lib; see info '(guile-library)
loggig logger')
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread* Re: Guile debugger workgroup?
2022-11-27 20:46 ` Attila Lendvai
2022-11-28 0:41 ` David Pirotte
2022-11-28 2:06 ` Maxim Cournoyer
@ 2022-11-28 11:09 ` Ludovic Courtès
2022-11-28 14:12 ` Attila Lendvai
2 siblings, 1 reply; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-28 11:09 UTC (permalink / raw)
To: Attila Lendvai; +Cc: Maxim Cournoyer, zimoun, guix-devel
Hi,
Attila Lendvai <attila@lendvai.name> skribis:
> which reminds me that a project-wide logging infrastructure would also greatly elevate the guix debugging experience.
Do you have examples in mind of things you’d like to log and that would
have helped you on a debugging journey?
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread
* Re: Guile debugger workgroup?
2022-11-28 11:09 ` Ludovic Courtès
@ 2022-11-28 14:12 ` Attila Lendvai
2022-11-29 8:54 ` Ludovic Courtès
0 siblings, 1 reply; 60+ messages in thread
From: Attila Lendvai @ 2022-11-28 14:12 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Maxim Cournoyer, zimoun, guix-devel
> Do you have examples in mind of things you’d like to log and that would
> have helped you on a debugging journey?
the first thing that pops to my mind is the service start gexp's in shepherd: they felt impossible to debug. i often was pretty much resorting to staring at the code, and then trying ad-hoc changes (with a minute+ long edit-compile-test cycle).
there are multiple issues here. the first one is that there's no proper error handling in shepherd. but if there was at least a semi-global error handler, that logged a full backtrace into a log file, then it would have been immensely helpful.
for inspiration, this is what we developed in common lisp:
https://hub.darcs.net/hu.dwim/hu.dwim.util/browse/source/error-handling.lisp#10
WITH-LAYERED-ERROR-HANDLERS is a macro for which you can provide a "level 1" error handler hook that does whatever it wants. if any errors happen within this hook, then a level2 error handler kicks in, turns off several things (e.g. custom PRINT-OBJECT methods), and tries to log a backtrace in a defensive way (e.g. there are error handlers installed while printing each backtrace level).
if even level2 errors out, then a super conservative level3 error handler logs this fact, so that there's *some* sign of an error.
note that the logging library must also be smart about how it deals with errors.
the default level1 handler has fancy features like "backtrace decorators", which is a registry of dinamically bound thunks that are called when a backtrace is printed. they can decorate the end of the backtrace with dynamic information from the context that is not captured by the backtrace (e.g. the web session, the user logged in, etc).
this error handler mechanism is installed at strategic points, like the handling of a http request, or a great candidate would be when calling the user code in the start gexp of a shpeherd service.
let me know if anything like this is available in scheme.
i know about these in guix and guile:
/guix/ui.scm: (define (call-with-error-handling
/module/system/repl/error-handling.scm: (define* (call-with-error-handling
the longer i work on/in guix, the higher the chance that i'll port parts of our CL debugging stuff to scheme. i think i was just procractinating it until i develop a deep enough understanding of scheme to do it properly.
HTH,
--
• attila lendvai
• PGP: 963F 5D5F 45C7 DFCD 0A39
--
“We are caged by our cultural programming. Culture is a mass hallucination, and when you step outside the mass hallucination you see it for what it's worth.”
— Terence McKenna (1946–2000), from the lecture 'Eros and the Eschaton' (1994)
^ permalink raw reply [flat|nested] 60+ messages in thread
* Re: Guile debugger workgroup?
2022-11-28 14:12 ` Attila Lendvai
@ 2022-11-29 8:54 ` Ludovic Courtès
0 siblings, 0 replies; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-29 8:54 UTC (permalink / raw)
To: Attila Lendvai; +Cc: Maxim Cournoyer, zimoun, guix-devel
Hi,
Attila Lendvai <attila@lendvai.name> skribis:
> the first thing that pops to my mind is the service start gexp's in shepherd: they felt impossible to debug. i often was pretty much resorting to staring at the code, and then trying ad-hoc changes (with a minute+ long edit-compile-test cycle).
Ah yes. That’s a problem that has to do with staging, which makes
things more difficult.
The one multi-stage language I know of that did it well, but in a
totally different context, is Hop <https://hop.inria.fr>.
<https://hal.inria.fr/hal-01580582/document> briefly discusses
cross-stage debugging.
> there are multiple issues here. the first one is that there's no proper error handling in shepherd. but if there was at least a semi-global error handler, that logged a full backtrace into a log file, then it would have been immensely helpful.
OK. I guess there are cases where you do get logging with Shepherd 0.9,
and other cases less so (e.g., if the ‘start’ method refers to an
unbound variable). We should look at typical examples to get a better
understanding of what’s missing.
> for inspiration, this is what we developed in common lisp:
>
> https://hub.darcs.net/hu.dwim/hu.dwim.util/browse/source/error-handling.lisp#10
>
> WITH-LAYERED-ERROR-HANDLERS is a macro for which you can provide a "level 1" error handler hook that does whatever it wants. if any errors happen within this hook, then a level2 error handler kicks in, turns off several things (e.g. custom PRINT-OBJECT methods), and tries to log a backtrace in a defensive way (e.g. there are error handlers installed while printing each backtrace level).
>
> if even level2 errors out, then a super conservative level3 error handler logs this fact, so that there's *some* sign of an error.
Looks like a good source of inspiration!
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread
* Re: Guile debugger workgroup? (was: Coding style: similarly-named variables)
2022-11-25 15:23 ` Guile debugger workgroup? (was: Coding style: similarly-named variables) Maxim Cournoyer
2022-11-26 11:22 ` Guile debugger workgroup? Ludovic Courtès
@ 2022-11-28 12:24 ` Csepp
2022-11-30 7:09 ` Guile debugger workgroup? Jannneke Nieuwenhuizen
2 siblings, 0 replies; 60+ messages in thread
From: Csepp @ 2022-11-28 12:24 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: zimoun, Ludovic Courtès, guix-devel
Maxim Cournoyer <maxim.cournoyer@gmail.com> writes:
> Hi Simon,
>
> zimoun <zimon.toutoune@gmail.com> writes:
>
>> Hi Maxim,
>>
>> On Mon, 21 Nov 2022 at 15:55, Maxim Cournoyer <maxim.cournoyer@gmail.com> wrote:
>>
>>> In practice since using breakpoints/a debugger to debug Guile code
>>> rarely works as intended (in my experience hacking on Guix!), we
>>> typically sprinkle the source with 'pk', and that point becomes moot.
>>
>> I totally agree! Preparing some materials for introducing Guile to
>> GuixHPC folk, I am trying to collect some tips and, if I am honest, the
>> debugging experience with Guile is really poor; compared to others (as
>> Python). For example, DrRacket provides an easy and nice user
>> experience [1] – where it is easy to compare each intermediary result in
>> the debugger. For what it is worth, I have not been able to have some
>> similar inspections as in [1]. Maybe, I am missing something…
>>
>> Well, IMHO, we are somehow suffering from some Guile limitations and
>> improvements in this area are an hard task.
>
> I also agree! It's hard to convince people to pick Guile for their
> project when there is:
>
> 1. Lack of a debugger that can break and step anywhere in your source
> code
> 2. Lack of debugger integration to an IDE (it's not even integrated into
> Emacs)
>
> Perhaps we should assemble a Guile debugger workgroup that'd review
> what's broken, what's missing, what can be borrowed from other Scheme or
> languages for inspiration, and hopefully improve the Guile debugging
> experience? :-)
Can we also get a profiler like Python's Scalene?
I'm pretty sure there are some performance bottlenecks it could help
identify, both in Guix and in Guile itself.
^ permalink raw reply [flat|nested] 60+ messages in thread
* Re: Guile debugger workgroup?
2022-11-25 15:23 ` Guile debugger workgroup? (was: Coding style: similarly-named variables) Maxim Cournoyer
2022-11-26 11:22 ` Guile debugger workgroup? Ludovic Courtès
2022-11-28 12:24 ` Guile debugger workgroup? (was: Coding style: similarly-named variables) Csepp
@ 2022-11-30 7:09 ` Jannneke Nieuwenhuizen
2 siblings, 0 replies; 60+ messages in thread
From: Jannneke Nieuwenhuizen @ 2022-11-30 7:09 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: zimoun, Ludovic Courtès, guix-devel
Maxim Cournoyer writes:
> Hi Simon,
>
> zimoun <zimon.toutoune@gmail.com> writes:
>
>> Hi Maxim,
>>
>> On Mon, 21 Nov 2022 at 15:55, Maxim Cournoyer <maxim.cournoyer@gmail.com> wrote:
>> Well, IMHO, we are somehow suffering from some Guile limitations and
>> improvements in this area are an hard task.
> I also agree! It's hard to convince people to pick Guile for their
> project when there is:
Yes, I thought so too. I made an attempt to do these thingssome time
ago, but did not fully see it through.
> 1. Lack of a debugger that can break and step anywhere in your source
> code
I didn't get thse patches to work
https://lists.gnu.org/archive/html/guile-devel/2014-08/msg00004.html
> 2. Lack of debugger integration to an IDE (it's not even integrated into
> Emacs)
This made it into Emacs, though
https://lists.gnu.org/archive/html/guile-devel/2014-08/msg00006.html
Greetinsgs,
Janneke
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply [flat|nested] 60+ messages in thread
* [bug#58812] [bug#59164] Coding style: similarly-named variables
2022-11-22 14:35 ` [bug#59164] " zimoun
2022-11-25 15:23 ` Guile debugger workgroup? (was: Coding style: similarly-named variables) Maxim Cournoyer
@ 2022-11-26 14:47 ` Ludovic Courtès
1 sibling, 0 replies; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-26 14:47 UTC (permalink / raw)
To: zimoun; +Cc: 59164, Maxim Cournoyer, 58812
Hi,
zimoun <zimon.toutoune@gmail.com> skribis:
> I totally agree! Preparing some materials for introducing Guile to
> GuixHPC folk, I am trying to collect some tips and, if I am honest, the
> debugging experience with Guile is really poor; compared to others (as
> Python). For example, DrRacket provides an easy and nice user
> experience [1] – where it is easy to compare each intermediary result in
> the debugger. For what it is worth, I have not been able to have some
> similar inspections as in [1]. Maybe, I am missing something…
Looking at the video you posted, I better understand what debugging
features we’re talking about. DrRacket is the gold standard; here it
does something similar to what we have with in Elisp with EDebug, which
is certainly useful.
It may be more of a limitation of Geiser than of Guile. I find it more
useful in “typical” imperative ELisp code than in functional Scheme
code, but it’d be nice to have either way!
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread
* [bug#59164] Coding style: similarly-named variables
2022-11-17 17:37 ` [bug#59164] Coding style: similarly-named variables Ludovic Courtès
2022-11-17 18:44 ` [bug#58812] " zimoun
@ 2022-11-17 20:34 ` Maxim Cournoyer
2022-11-20 10:46 ` [bug#58812] " Ludovic Courtès
1 sibling, 1 reply; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-17 20:34 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 59164, 58812
Hi,
Ludovic Courtès <ludo@gnu.org> writes:
> Hi,
>
> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>
>> Ludovic Courtès <ludo@gnu.org> writes:
>>
>>> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>>>
>>>> * gnu/build/install.scm (evaluate-populate-directive): By default, error when
>>>> the target of a symlink doesn't exist. Always ensure TARGET ends with "/".
>>>> (populate-root-file-system): Call evaluate-populate-directive with
>>>> #:error-on-dangling-symlink #t and add comment.
>>>
>>> [...]
>>>
>>>> + (define target* (if (string-suffix? "/" target)
>>>> + target
>>>> + (string-append target "/")))
>>>
>>> Maybe make it:
>>>
>>> (let ((target (if …)))
>>> …)
>>>
>>> so there’s only one ‘target’ in scope (and no ‘target*’); otherwise it’s
>>> easy to forget the ‘*’ and refer to wrong one.
>>
>> It's a pattern I've used at other places; I find it more hygienic to not
>> shadow existing variables; it signal to the reader "be careful, this is
>> not the same as the argument-bound one, though they are closely
>> related".
>
> I don’t buy it. :-) The reader might be careful yet end up using the
> “wrong” variable. As long as the “wrong” variable has no use, I think
> it’s best to shadow it so that mistakes cannot happen.
I'm surprised you're not buying it, given we're writing Scheme in a more
functional style, and mutating same-named variables clearly goes against
that style :-).
> Of course the details vary depending on context, but I think we should
> not start introducing this pattern in different places. Perhaps
> something to discuss and codify under “Formatting Code”?
That's more of a coding style guidelines than "formatting" code (when I
read "formatting", I think of a mechanical process like 'guix style' or
'rust-fmt' can do), but yes, that could be nice to have. Better yet,
something basic to share across the whole Guile/Scheme community and
include in the Guile user manual, like Python has PEP 8 they can refer
to, to save every Guile/Scheme project from having to reinvent the
wheel.
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread
* [bug#58812] Coding style: similarly-named variables
2022-11-17 20:34 ` Maxim Cournoyer
@ 2022-11-20 10:46 ` Ludovic Courtès
0 siblings, 0 replies; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-20 10:46 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: 59164, 58812
Hi,
Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
[...]
>>> It's a pattern I've used at other places; I find it more hygienic to not
>>> shadow existing variables; it signal to the reader "be careful, this is
>>> not the same as the argument-bound one, though they are closely
>>> related".
>>
>> I don’t buy it. :-) The reader might be careful yet end up using the
>> “wrong” variable. As long as the “wrong” variable has no use, I think
>> it’s best to shadow it so that mistakes cannot happen.
>
> I'm surprised you're not buying it, given we're writing Scheme in a more
> functional style, and mutating same-named variables clearly goes against
> that style :-).
There’s no mutation here, only lexical scoping. Anyway, I find it clear
that the risk of typing ‘x’ instead of ‘x*’, especially in relatively
long functions, justifies shadowing in situations like this one. WDYT?
>> Of course the details vary depending on context, but I think we should
>> not start introducing this pattern in different places. Perhaps
>> something to discuss and codify under “Formatting Code”?
>
> That's more of a coding style guidelines than "formatting" code
Sorry I meant “Coding Style”, which is the section that documents the
project’s conventions.
> (when I read "formatting", I think of a mechanical process like 'guix
> style' or 'rust-fmt' can do), but yes, that could be nice to have.
> Better yet, something basic to share across the whole Guile/Scheme
> community and include in the Guile user manual, like Python has PEP 8
> they can refer to, to save every Guile/Scheme project from having to
> reinvent the wheel.
I won’t do it, but sure, why not! My immediate concern is to make sure
we have a shared understanding, within Guix, of some of the conventions
we follow. It’s a minor issue, but minor issues are what our day-to-day
work is made of. :-)
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread
* [bug#58812] [PATCH 4/5] guix: shell: Add '--symlink' option.
2022-10-27 3:50 ` [bug#58812] [PATCH 1/5] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
2022-10-27 3:50 ` [bug#58812] [PATCH 2/5] tests: Add a tests/utils.sh support file Maxim Cournoyer
2022-10-27 3:50 ` [bug#58812] [PATCH 3/5] install: Validate symlink target in evaluate-populate-directive Maxim Cournoyer
@ 2022-10-27 3:50 ` Maxim Cournoyer
2022-11-09 20:58 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' Ludovic Courtès
2022-10-27 3:51 ` [bug#58812] [PATCH 5/5] shell: Detect --symlink spec problems early Maxim Cournoyer
3 siblings, 1 reply; 60+ messages in thread
From: Maxim Cournoyer @ 2022-10-27 3:50 UTC (permalink / raw)
To: 58812; +Cc: Maxim Cournoyer
* guix/scripts/pack.scm (%options): Extract symlink parsing logic to...
(symlink-spec-option-parser): ... here.
(self-contained-tarball/builder): Extract symlink->directives logic to...
* gnu/build/install.scm (make-symlink->directives): ... here. Add a comment
mentioning why a relative file name is used for the link target.
* guix/scripts/environment.scm (show-environment-options-help): Document new
--symlink option.
(%default-options): Add default value for symlinks.
(%options): Register new symlink option.
(launch-environment/container): Add #:symlinks argument and extend doc.
Create symlinks using evaluate-populate-directive and
make-symlink->directives.
(guix-environment*): Pass symlinks arguments to launch-environment/container.
* doc/guix.texi (Invoking guix shell): Document it.
* tests/guix-shell.sh: Test it.
---
doc/guix.texi | 9 +++++-
gnu/build/install.scm | 18 ++++++++++++
guix/scripts/environment.scm | 38 +++++++++++++++++-------
guix/scripts/pack.scm | 57 +++++++++++++++---------------------
tests/guix-shell.sh | 17 +++++++++++
5 files changed, 94 insertions(+), 45 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 2f7ab61aec..4bd3c18223 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -49,7 +49,7 @@ Copyright @copyright{} 2017 humanitiesNerd@*
Copyright @copyright{} 2017, 2021 Christine Lemmer-Webber@*
Copyright @copyright{} 2017, 2018, 2019, 2020, 2021, 2022 Marius Bakke@*
Copyright @copyright{} 2017, 2019, 2020, 2022 Hartmut Goebel@*
-Copyright @copyright{} 2017, 2019, 2020, 2021 Maxim Cournoyer@*
+Copyright @copyright{} 2017, 2019, 2020, 2021, 2022 Maxim Cournoyer@*
Copyright @copyright{} 2017–2022 Tobias Geerinckx-Rice@*
Copyright @copyright{} 2017 George Clemmer@*
Copyright @copyright{} 2017 Andy Wingo@*
@@ -6230,6 +6230,12 @@ directory:
guix shell --container --expose=$HOME=/exchange guile -- guile
@end example
+@cindex symbolic links, guix shell
+@item --symlink=@var{spec}
+@itemx -S @var{spec}
+For containers, create the symbolic links specified by @var{spec}, as
+documented in @ref{pack-symlink-option}.
+
@cindex file system hierarchy standard (FHS)
@cindex FHS (file system hierarchy standard)
@item --emulate-fhs
@@ -7022,6 +7028,7 @@ Compress the resulting tarball using @var{tool}---one of @code{gzip},
@code{zstd}, @code{bzip2}, @code{xz}, @code{lzip}, or @code{none} for no
compression.
+@anchor{pack-symlink-option}
@item --symlink=@var{spec}
@itemx -S @var{spec}
Add the symlinks specified by @var{spec} to the pack. This option can
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 15cc29b2c8..8cf772f3ea 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -19,6 +19,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build install)
+ #:use-module ((guix build union) #:select (relative-file-name))
#:use-module (guix build syscalls)
#:use-module (guix build utils)
#:use-module (guix build store-copy)
@@ -26,6 +27,7 @@ (define-module (gnu build install)
#:use-module (ice-9 match)
#:export (install-boot-config
evaluate-populate-directive
+ make-symlink->directives
populate-root-file-system
install-database-and-gc-roots
populate-single-profile-directory
@@ -124,6 +126,22 @@ (define target* (if (string-suffix? "/" target)
directive)
(apply throw args)))))
+(define (make-symlink->directives directory)
+ "Return a procedure that turn symlinks specs into directives that target
+DIRECTORY."
+ (match-lambda
+ ((source '-> target)
+ (let ((target (string-append directory "/" target))
+ (parent (dirname source)))
+ ;; Never add a 'directory' directive for "/" so as to preserve its
+ ;; ownership and avoid adding the same entries multiple times.
+ `(,@(if (string=? parent "/")
+ '()
+ `((directory ,parent)))
+ ;; Note: a relative file name is used for compatibility with
+ ;; relocatable packs.
+ (,source -> ,(relative-file-name parent target)))))))
+
(define (directives store)
"Return a list of directives to populate the root file system that will host
STORE."
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index de9bc8f98d..bd95329c5c 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -33,8 +33,10 @@ (define-module (guix scripts environment)
#:use-module ((guix gexp) #:select (lower-object))
#:use-module (guix scripts)
#:use-module (guix scripts build)
+ #:use-module ((guix scripts pack) #:select (symlink-spec-option-parser))
#:use-module (guix transformations)
#:autoload (ice-9 ftw) (scandir)
+ #:use-module (gnu build install)
#:autoload (gnu build linux-container) (call-with-container %namespaces
user-namespace-supported?
unprivileged-user-namespace-supported?
@@ -120,6 +122,9 @@ (define (show-environment-options-help)
--expose=SPEC for containers, expose read-only host file system
according to SPEC"))
(display (G_ "
+ -S, --symlink=SPEC for containers, add symlinks to the profile according
+ to SPEC, e.g. \"/usr/bin/env=bin/env\"."))
+ (display (G_ "
-v, --verbosity=LEVEL use the given verbosity LEVEL"))
(display (G_ "
--bootstrap use bootstrap binaries to build the environment")))
@@ -157,6 +162,7 @@ (define (show-help)
(define %default-options
`((system . ,(%current-system))
(substitutes? . #t)
+ (symlinks . ())
(offload? . #t)
(graft? . #t)
(print-build-trace? . #t)
@@ -256,6 +262,7 @@ (define %options
(alist-cons 'file-system-mapping
(specification->file-system-mapping arg #f)
result)))
+ (option '(#\S "symlink") #t #f symlink-spec-option-parser)
(option '(#\r "root") #t #f
(lambda (opt name arg result)
(alist-cons 'gc-root arg result)))
@@ -672,7 +679,7 @@ (define* (launch-environment/fork command profile manifest
(define* (launch-environment/container #:key command bash user user-mappings
profile manifest link-profile? network?
map-cwd? emulate-fhs? (setup-hook #f)
- (white-list '()))
+ (symlinks '()) (white-list '()))
"Run COMMAND within a container that features the software in PROFILE.
Environment variables are set according to the search paths of MANIFEST. The
global shell is BASH, a file name for a GNU Bash binary in the store. When
@@ -690,6 +697,9 @@ (define* (launch-environment/container #:key command bash user user-mappings
LINK-PROFILE? creates a symbolic link from ~/.guix-profile to the
environment profile.
+SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
+added to the container.
+
Preserve environment variables whose name matches the one of the regexps in
WHILE-LIST."
(define (optional-mapping->fs mapping)
@@ -797,6 +807,10 @@ (define fhs-mappings
(mkdir-p home-dir)
(setenv "HOME" home-dir)
+ ;; Create symlinks.
+ (for-each (cut evaluate-populate-directive <> ".")
+ (append-map (make-symlink->directives profile) symlinks))
+
;; Call an additional setup procedure, if provided.
(when setup-hook
(setup-hook profile))
@@ -970,6 +984,7 @@ (define (guix-environment* opts)
(let* ((pure? (assoc-ref opts 'pure))
(container? (assoc-ref opts 'container?))
(link-prof? (assoc-ref opts 'link-profile?))
+ (symlinks (assoc-ref opts 'symlinks))
(network? (assoc-ref opts 'network?))
(no-cwd? (assoc-ref opts 'no-cwd?))
(emulate-fhs? (assoc-ref opts 'emulate-fhs?))
@@ -1010,15 +1025,17 @@ (define-syntax-rule (with-store/maybe store exp ...)
(when container? (assert-container-features))
- (when (and (not container?) link-prof?)
- (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
- (when (and (not container?) user)
- (leave (G_ "'--user' cannot be used without '--container'~%")))
- (when (and (not container?) no-cwd?)
- (leave (G_ "--no-cwd cannot be used without '--container'~%")))
- (when (and (not container?) emulate-fhs?)
- (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
-
+ (when (not container?)
+ (when link-prof?
+ (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
+ (when user
+ (leave (G_ "'--user' cannot be used without '--container'~%")))
+ (when no-cwd?
+ (leave (G_ "--no-cwd cannot be used without '--container'~%")))
+ (when emulate-fhs?
+ (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
+ (when (pair? symlinks)
+ (leave (G_ "'--symlink' cannot be used without '--container~%'"))))
(with-store/maybe store
(with-status-verbosity (assoc-ref opts 'verbosity)
@@ -1099,6 +1116,7 @@ (define manifest
#:network? network?
#:map-cwd? (not no-cwd?)
#:emulate-fhs? emulate-fhs?
+ #:symlinks symlinks
#:setup-hook
(and emulate-fhs?
setup-fhs))))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 06849e4761..e3bddc4274 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -61,7 +61,9 @@ (define-module (guix scripts pack)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
- #:export (self-contained-tarball
+ #:export (symlink-spec-option-parser
+
+ self-contained-tarball
debian-archive
docker-image
squashfs-image
@@ -160,6 +162,21 @@ (define str (string-join names "-"))
((_) str)
((names ... _) (loop names))))))
+(define (symlink-spec-option-parser opt name arg result)
+ "A SRFI-37 option parser for the --symlink option."
+ ;; Note: Using 'string-split' allows us to handle empty
+ ;; TARGET (as in "/opt/guile=", meaning that /opt/guile is
+ ;; a symlink to the profile) correctly.
+ (match (string-split arg (char-set #\=))
+ ((source target)
+ (let ((symlinks (assoc-ref result 'symlinks)))
+ (alist-cons 'symlinks
+ `((,source -> ,target) ,@symlinks)
+ (alist-delete 'symlinks result eq?))))
+ (x
+ (leave (G_ "~a: invalid symlink specification~%")
+ arg))))
+
\f
;;;
;;; Tarball format.
@@ -204,30 +221,15 @@ (define (import-module? module)
(use-modules (guix build pack)
(guix build store-copy)
(guix build utils)
- ((guix build union) #:select (relative-file-name))
(gnu build install)
(srfi srfi-1)
- (srfi srfi-26)
- (ice-9 match))
+ (srfi srfi-26))
(define %root "root")
- (define symlink->directives
- ;; Return "populate directives" to make the given symlink and its
- ;; parent directories.
- (match-lambda
- ((source '-> target)
- (let ((target (string-append #$profile "/" target))
- (parent (dirname source)))
- ;; Never add a 'directory' directive for "/" so as to
- ;; preserve its ownership when extracting the archive (see
- ;; below), and also because this would lead to adding the
- ;; same entries twice in the tarball.
- `(,@(if (string=? parent "/")
- '()
- `((directory ,parent)))
- (,source
- -> ,(relative-file-name parent target)))))))
+ ;; Return "populate directives" to make the given symlink and its
+ ;; parent directories.
+ (define symlink->directives (make-symlink->directives #$profile))
(define directives
;; Fully-qualified symlinks.
@@ -1208,20 +1210,7 @@ (define %options
(lambda (opt name arg result)
(alist-cons 'compressor (lookup-compressor arg)
result)))
- (option '(#\S "symlink") #t #f
- (lambda (opt name arg result)
- ;; Note: Using 'string-split' allows us to handle empty
- ;; TARGET (as in "/opt/guile=", meaning that /opt/guile is
- ;; a symlink to the profile) correctly.
- (match (string-split arg (char-set #\=))
- ((source target)
- (let ((symlinks (assoc-ref result 'symlinks)))
- (alist-cons 'symlinks
- `((,source -> ,target) ,@symlinks)
- (alist-delete 'symlinks result eq?))))
- (x
- (leave (G_ "~a: invalid symlink specification~%")
- arg)))))
+ (option '(#\S "symlink") #t #f symlink-spec-option-parser)
(option '("save-provenance") #f #f
(lambda (opt name arg result)
(alist-cons 'save-provenance? #t result)))
diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh
index 9a6b055264..32dd997fe7 100644
--- a/tests/guix-shell.sh
+++ b/tests/guix-shell.sh
@@ -20,6 +20,8 @@
# Test the 'guix shell' alias.
#
+. tests/utils.sh
+
guix shell --version
configdir="t-guix-shell-config-$$"
@@ -32,6 +34,21 @@ export XDG_CONFIG_HOME
guix shell --bootstrap --pure guile-bootstrap -- guile --version
+# '--symlink' can only be used with --container.
+! guix shell --bootstrap guile-bootstrap -S /dummy=bin/guile
+
+if has_container_support; then
+ # '--symlink' works.
+ echo "TESTING SYMLINK IN CONTAINER"
+ guix shell --bootstrap guile-bootstrap --container \
+ --symlink=/usr/bin/guile=bin/guile -- \
+ /usr/bin/guile --version
+
+ # A bad symlink spec causes the command to fail.
+ ! guix shell --bootstrap -CS bin/guile=/usr/bin/guile guile-bootstrap \
+ -- exit
+fi
+
# '--ad-hoc' is a thing of the past.
! guix shell --ad-hoc guile-bootstrap
--
2.37.3
^ permalink raw reply related [flat|nested] 60+ messages in thread* [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell'.
2022-10-27 3:50 ` [bug#58812] [PATCH 4/5] guix: shell: Add '--symlink' option Maxim Cournoyer
@ 2022-11-09 20:58 ` Ludovic Courtès
2022-11-10 3:10 ` Maxim Cournoyer
2022-11-16 19:03 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' zimoun
0 siblings, 2 replies; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-09 20:58 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: 58812
Hi,
That looks like a useful improvement! Some comments below.
Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
> +@item --symlink=@var{spec}
> +@itemx -S @var{spec}
> +For containers, create the symbolic links specified by @var{spec}, as
> +documented in @ref{pack-symlink-option}.
We should refrain from using @ref in sentences (info "(texinfo) @ref").
Instead, I’d write:
documented for @command{guix pack} (@pxref{pack-symlink-option}).
> (define-module (gnu build install)
> + #:use-module ((guix build union) #:select (relative-file-name))
> #:use-module (guix build syscalls)
> #:use-module (guix build utils)
> #:use-module (guix build store-copy)
> @@ -26,6 +27,7 @@ (define-module (gnu build install)
> #:use-module (ice-9 match)
> #:export (install-boot-config
> evaluate-populate-directive
> + make-symlink->directives
> populate-root-file-system
> install-database-and-gc-roots
> populate-single-profile-directory
> @@ -124,6 +126,22 @@ (define target* (if (string-suffix? "/" target)
> directive)
> (apply throw args)))))
>
> +(define (make-symlink->directives directory)
> + "Return a procedure that turn symlinks specs into directives that target
> +DIRECTORY."
> + (match-lambda
> + ((source '-> target)
> + (let ((target (string-append directory "/" target))
> + (parent (dirname source)))
> + ;; Never add a 'directory' directive for "/" so as to preserve its
> + ;; ownership and avoid adding the same entries multiple times.
> + `(,@(if (string=? parent "/")
> + '()
> + `((directory ,parent)))
> + ;; Note: a relative file name is used for compatibility with
> + ;; relocatable packs.
> + (,source -> ,(relative-file-name parent target)))))))
I think it’s a case where I would refrain from factorizing because this
procedure, as shown by the comments and the use of ‘relative-file-name’,
is specifically tailored for the needs to ‘guix pack -f tarball’.
I’d prefer to have a similar but independently maintained variant of
this procedure in (guix scripts environment) to avoid difficulties down
the road.
> +++ b/guix/scripts/environment.scm
> @@ -33,8 +33,10 @@ (define-module (guix scripts environment)
> #:use-module ((guix gexp) #:select (lower-object))
> #:use-module (guix scripts)
> #:use-module (guix scripts build)
> + #:use-module ((guix scripts pack) #:select (symlink-spec-option-parser))
You can turn this into #:autoload so we don’t pay the price when not
using ‘--symlink’.
> +++ b/tests/guix-shell.sh
> @@ -20,6 +20,8 @@
> # Test the 'guix shell' alias.
> #
>
> +. tests/utils.sh
> +
> guix shell --version
>
> configdir="t-guix-shell-config-$$"
> @@ -32,6 +34,21 @@ export XDG_CONFIG_HOME
>
> guix shell --bootstrap --pure guile-bootstrap -- guile --version
>
> +# '--symlink' can only be used with --container.
> +! guix shell --bootstrap guile-bootstrap -S /dummy=bin/guile
> +
> +if has_container_support; then
> + # '--symlink' works.
> + echo "TESTING SYMLINK IN CONTAINER"
> + guix shell --bootstrap guile-bootstrap --container \
> + --symlink=/usr/bin/guile=bin/guile -- \
> + /usr/bin/guile --version
This should go to ‘tests/guix-environment-container.sh’, which has all
the container-related tests.
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread* [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell'.
2022-11-09 20:58 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' Ludovic Courtès
@ 2022-11-10 3:10 ` Maxim Cournoyer
2022-11-10 14:17 ` Ludovic Courtès
2022-11-16 19:03 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' zimoun
1 sibling, 1 reply; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-10 3:10 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 58812
Hi Ludo!
Ludovic Courtès <ludo@gnu.org> writes:
> Hi,
>
> That looks like a useful improvement! Some comments below.
Thanks!
> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>
>> +@item --symlink=@var{spec}
>> +@itemx -S @var{spec}
>> +For containers, create the symbolic links specified by @var{spec}, as
>> +documented in @ref{pack-symlink-option}.
>
> We should refrain from using @ref in sentences (info "(texinfo) @ref").
> Instead, I’d write:
>
> documented for @command{guix pack} (@pxref{pack-symlink-option}).
I've heard that from you before, but is there a reason against? I like
to know the rationale for doing things a certain way, lest I forget :-).
From info '(texinfo) @ref':
--8<---------------cut here---------------start------------->8---
6.6 '@ref'
==========
'@ref' is nearly the same as '@xref' except that it does not generate a
'See' in the printed output, just the reference itself. This makes it
useful as the last part of a sentence.
For example,
For more information, @pxref{This}, and @ref{That}.
produces in Info:
For more information, *note This::, and *note That::.
--8<---------------cut here---------------end--------------->8---
>> (define-module (gnu build install)
>> + #:use-module ((guix build union) #:select (relative-file-name))
>> #:use-module (guix build syscalls)
>> #:use-module (guix build utils)
>> #:use-module (guix build store-copy)
>> @@ -26,6 +27,7 @@ (define-module (gnu build install)
>> #:use-module (ice-9 match)
>> #:export (install-boot-config
>> evaluate-populate-directive
>> + make-symlink->directives
>> populate-root-file-system
>> install-database-and-gc-roots
>> populate-single-profile-directory
>> @@ -124,6 +126,22 @@ (define target* (if (string-suffix? "/" target)
>> directive)
>> (apply throw args)))))
>>
>> +(define (make-symlink->directives directory)
>> + "Return a procedure that turn symlinks specs into directives that target
>> +DIRECTORY."
>> + (match-lambda
>> + ((source '-> target)
>> + (let ((target (string-append directory "/" target))
>> + (parent (dirname source)))
>> + ;; Never add a 'directory' directive for "/" so as to preserve its
>> + ;; ownership and avoid adding the same entries multiple times.
>> + `(,@(if (string=? parent "/")
>> + '()
>> + `((directory ,parent)))
>> + ;; Note: a relative file name is used for compatibility with
>> + ;; relocatable packs.
>> + (,source -> ,(relative-file-name parent target)))))))
>
> I think it’s a case where I would refrain from factorizing because this
> procedure, as shown by the comments and the use of ‘relative-file-name’,
> is specifically tailored for the needs to ‘guix pack -f tarball’.
>
> I’d prefer to have a similar but independently maintained variant of
> this procedure in (guix scripts environment) to avoid difficulties down
> the road.
I considered to duplicate it, but I opted to reuse it in the end because
I care that the behavior is exactly the same between the two actions
(guix shell --symlink vs guix pack --symlink). If the way we handle
this is to be changed in the future, I'd want both to be changed at
once, so they remain consistent. Does this make sense?
>> +++ b/guix/scripts/environment.scm
>> @@ -33,8 +33,10 @@ (define-module (guix scripts environment)
>> #:use-module ((guix gexp) #:select (lower-object))
>> #:use-module (guix scripts)
>> #:use-module (guix scripts build)
>> + #:use-module ((guix scripts pack) #:select (symlink-spec-option-parser))
>
> You can turn this into #:autoload so we don’t pay the price when not
> using ‘--symlink’.
Done! Could Guile simply always use lazy loading (autoload by default)?
Otherwise, when is it OK to use autoload and when is it not?
>> +++ b/tests/guix-shell.sh
>> @@ -20,6 +20,8 @@
>> # Test the 'guix shell' alias.
>> #
>>
>> +. tests/utils.sh
>> +
>> guix shell --version
>>
>> configdir="t-guix-shell-config-$$"
>> @@ -32,6 +34,21 @@ export XDG_CONFIG_HOME
>>
>> guix shell --bootstrap --pure guile-bootstrap -- guile --version
>>
>> +# '--symlink' can only be used with --container.
>> +! guix shell --bootstrap guile-bootstrap -S /dummy=bin/guile
>> +
>> +if has_container_support; then
>> + # '--symlink' works.
>> + echo "TESTING SYMLINK IN CONTAINER"
>> + guix shell --bootstrap guile-bootstrap --container \
>> + --symlink=/usr/bin/guile=bin/guile -- \
>> + /usr/bin/guile --version
>
> This should go to ‘tests/guix-environment-container.sh’, which has all
> the container-related tests.
Done, for the "has_container_support" conditional tests.
Thanks for taking a peek!
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread* [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell'.
2022-11-10 3:10 ` Maxim Cournoyer
@ 2022-11-10 14:17 ` Ludovic Courtès
2022-11-10 14:49 ` Maxim Cournoyer
2022-11-10 16:05 ` [bug#58812] [PATCH v3 1/4] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
0 siblings, 2 replies; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-10 14:17 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: 58812
Hi Maxim!
Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>> We should refrain from using @ref in sentences (info "(texinfo) @ref").
>> Instead, I’d write:
>>
>> documented for @command{guix pack} (@pxref{pack-symlink-option}).
>
> I've heard that from you before, but is there a reason against? I like
> to know the rationale for doing things a certain way, lest I forget :-).
> From info '(texinfo) @ref':
It’s right below the bit you quoted:
The '@ref' command can tempt writers to express themselves in a
manner that is suitable for a printed manual but looks awkward in the
Info format. Bear in mind that your audience could be using both the
printed and the Info format. For example: […]
>>> +(define (make-symlink->directives directory)
>>> + "Return a procedure that turn symlinks specs into directives that target
>>> +DIRECTORY."
>>> + (match-lambda
>>> + ((source '-> target)
>>> + (let ((target (string-append directory "/" target))
>>> + (parent (dirname source)))
>>> + ;; Never add a 'directory' directive for "/" so as to preserve its
>>> + ;; ownership and avoid adding the same entries multiple times.
>>> + `(,@(if (string=? parent "/")
>>> + '()
>>> + `((directory ,parent)))
>>> + ;; Note: a relative file name is used for compatibility with
>>> + ;; relocatable packs.
>>> + (,source -> ,(relative-file-name parent target)))))))
>>
>> I think it’s a case where I would refrain from factorizing because this
>> procedure, as shown by the comments and the use of ‘relative-file-name’,
>> is specifically tailored for the needs to ‘guix pack -f tarball’.
>>
>> I’d prefer to have a similar but independently maintained variant of
>> this procedure in (guix scripts environment) to avoid difficulties down
>> the road.
>
> I considered to duplicate it, but I opted to reuse it in the end because
> I care that the behavior is exactly the same between the two actions
> (guix shell --symlink vs guix pack --symlink). If the way we handle
> this is to be changed in the future, I'd want both to be changed at
> once, so they remain consistent. Does this make sense?
They don’t have to be consistent. Use of ‘relative-file-name’ here for
example is dictated by the needs of relocatable packs. It doesn’t have
to be this way here.
I think it’s best to keep separate copies here (they likely won’t be
exactly the same).
>>> +++ b/guix/scripts/environment.scm
>>> @@ -33,8 +33,10 @@ (define-module (guix scripts environment)
>>> #:use-module ((guix gexp) #:select (lower-object))
>>> #:use-module (guix scripts)
>>> #:use-module (guix scripts build)
>>> + #:use-module ((guix scripts pack) #:select (symlink-spec-option-parser))
>>
>> You can turn this into #:autoload so we don’t pay the price when not
>> using ‘--symlink’.
>
> Done! Could Guile simply always use lazy loading (autoload by default)?
#:select could be synonymous with #:autoload, if that’s what you mean,
but in general Guile cannot know whether autoloading is semantically
equivalent to eagerly loading: there might be side-effects happening
when the top-level of the module runs.
> Otherwise, when is it OK to use autoload and when is it not?
#:autoload exists as a way to amortize initialization costs and make
sure only necessary functionality gets loaded, thereby reducing CPU and
memory usage.
Only the module user can tell whether #:autoload is appropriate. In
general you’d use it for optional functionality that has a
non-negligible memory footprint or that would noticeably degrade startup
time.
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread* [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell'.
2022-11-10 14:17 ` Ludovic Courtès
@ 2022-11-10 14:49 ` Maxim Cournoyer
2022-11-10 15:16 ` Maxim Cournoyer
2022-11-10 16:05 ` [bug#58812] [PATCH v3 1/4] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
1 sibling, 1 reply; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-10 14:49 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 58812
Hi Ludo!
Ludovic Courtès <ludo@gnu.org> writes:
> Hi Maxim!
>
> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>
>>> We should refrain from using @ref in sentences (info "(texinfo) @ref").
>>> Instead, I’d write:
>>>
>>> documented for @command{guix pack} (@pxref{pack-symlink-option}).
>>
>> I've heard that from you before, but is there a reason against? I like
>> to know the rationale for doing things a certain way, lest I forget :-).
>> From info '(texinfo) @ref':
>
> It’s right below the bit you quoted:
>
> The '@ref' command can tempt writers to express themselves in a
> manner that is suitable for a printed manual but looks awkward in the
> Info format. Bear in mind that your audience could be using both the
> printed and the Info format. For example: […]
Yes, and I don't get it :-)
--8<---------------cut here---------------start------------->8---
The '@ref' command can tempt writers to express themselves in a
manner that is suitable for a printed manual but looks awkward in the
Info format. Bear in mind that your audience could be using both the
printed and the Info format. For example:
Sea surges are described in @ref{Hurricanes}.
looks ok in the printed output:
Sea surges are described in Section 6.7 [Hurricanes], page 72.
but is awkward to read in Info, "note" being a verb:
Sea surges are described in *note Hurricanes::.
--8<---------------cut here---------------end--------------->8---
I don't see a "note" in the final sentence that should make it awkward?
It's lacking a "see " prefix though, which could help to make things a
bit clearer, I guess.
It looks the same in info as in the pxref example given above:
--8<---------------cut here---------------start------------->8---
For example,
For more information, @pxref{This}, and @ref{That}.
produces in Info:
For more information, *note This::, and *note That::.
--8<---------------cut here---------------end--------------->8---
I'm also unsure where the "see" comes before That:: above. Is it a
mistake in the manual?
>>>> +(define (make-symlink->directives directory)
>>>> + "Return a procedure that turn symlinks specs into directives that target
>>>> +DIRECTORY."
>>>> + (match-lambda
>>>> + ((source '-> target)
>>>> + (let ((target (string-append directory "/" target))
>>>> + (parent (dirname source)))
>>>> + ;; Never add a 'directory' directive for "/" so as to preserve its
>>>> + ;; ownership and avoid adding the same entries multiple times.
>>>> + `(,@(if (string=? parent "/")
>>>> + '()
>>>> + `((directory ,parent)))
>>>> + ;; Note: a relative file name is used for compatibility with
>>>> + ;; relocatable packs.
>>>> + (,source -> ,(relative-file-name parent target)))))))
>>>
>>> I think it’s a case where I would refrain from factorizing because this
>>> procedure, as shown by the comments and the use of ‘relative-file-name’,
>>> is specifically tailored for the needs to ‘guix pack -f tarball’.
>>>
>>> I’d prefer to have a similar but independently maintained variant of
>>> this procedure in (guix scripts environment) to avoid difficulties down
>>> the road.
>>
>> I considered to duplicate it, but I opted to reuse it in the end because
>> I care that the behavior is exactly the same between the two actions
>> (guix shell --symlink vs guix pack --symlink). If the way we handle
>> this is to be changed in the future, I'd want both to be changed at
>> once, so they remain consistent. Does this make sense?
>
> They don’t have to be consistent. Use of ‘relative-file-name’ here for
> example is dictated by the needs of relocatable packs. It doesn’t have
> to be this way here.
>
> I think it’s best to keep separate copies here (they likely won’t be
> exactly the same).
OK, I see you point about relative-file-name not being needed. I'll make
the change.
>>>> +++ b/guix/scripts/environment.scm
>>>> @@ -33,8 +33,10 @@ (define-module (guix scripts environment)
>>>> #:use-module ((guix gexp) #:select (lower-object))
>>>> #:use-module (guix scripts)
>>>> #:use-module (guix scripts build)
>>>> + #:use-module ((guix scripts pack) #:select (symlink-spec-option-parser))
>>>
>>> You can turn this into #:autoload so we don’t pay the price when not
>>> using ‘--symlink’.
>>
>> Done! Could Guile simply always use lazy loading (autoload by default)?
>
> #:select could be synonymous with #:autoload, if that’s what you mean,
> but in general Guile cannot know whether autoloading is semantically
> equivalent to eagerly loading: there might be side-effects happening
> when the top-level of the module runs.
Perhaps there could be a strict execution mode where it is assumed that
side effects are not used when modules run? That seems a seldom used
feature anyway, and could enable making lazy loading of modules the
default.
>> Otherwise, when is it OK to use autoload and when is it not?
>
> #:autoload exists as a way to amortize initialization costs and make
> sure only necessary functionality gets loaded, thereby reducing CPU and
> memory usage.
>
> Only the module user can tell whether #:autoload is appropriate. In
> general you’d use it for optional functionality that has a
> non-negligible memory footprint or that would noticeably degrade startup
> time.
>
> Ludo’.
Thank you for the explanations and review! I'll send a v3 shortly.
--
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread* [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell'.
2022-11-10 14:49 ` Maxim Cournoyer
@ 2022-11-10 15:16 ` Maxim Cournoyer
2022-11-14 9:18 ` Ludovic Courtès
0 siblings, 1 reply; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-10 15:16 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 58812
Hello,
Maxim Cournoyer <maxim.cournoyer@gmail.com> writes:
> Hi Ludo!
>
> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Hi Maxim!
>>
>> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>>
>>>> We should refrain from using @ref in sentences (info "(texinfo) @ref").
>>>> Instead, I’d write:
>>>>
>>>> documented for @command{guix pack} (@pxref{pack-symlink-option}).
>>>
>>> I've heard that from you before, but is there a reason against? I like
>>> to know the rationale for doing things a certain way, lest I forget :-).
>>> From info '(texinfo) @ref':
>>
>> It’s right below the bit you quoted:
>>
>> The '@ref' command can tempt writers to express themselves in a
>> manner that is suitable for a printed manual but looks awkward in the
>> Info format. Bear in mind that your audience could be using both the
>> printed and the Info format. For example: […]
>
> Yes, and I don't get it :-)
To be more concrete, this is what it looks currently:
--8<---------------cut here---------------start------------->8---
‘--symlink=SPEC’
‘-S SPEC’
For containers, create the symbolic links specified by SPEC, as
documented in *note pack-symlink-option::.
--8<---------------cut here---------------end--------------->8---
This is what it'd look if I use (see: @pxref ...) instead:
--8<---------------cut here---------------start------------->8---
‘--symlink=SPEC’
‘-S SPEC’
For containers, create the symbolic links specified by SPEC (see:
*note pack-symlink-option::).
--8<---------------cut here---------------end--------------->8---
Contrary to what the Texinfo manual says, pxref seems to be the one
introducing the awkward "*note" verb in the resulting info.
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread* [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell'.
2022-11-10 15:16 ` Maxim Cournoyer
@ 2022-11-14 9:18 ` Ludovic Courtès
0 siblings, 0 replies; 60+ messages in thread
From: Ludovic Courtès @ 2022-11-14 9:18 UTC (permalink / raw)
To: Maxim Cournoyer; +Cc: 58812
Hi,
Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
> Contrary to what the Texinfo manual says, pxref seems to be the one
> introducing the awkward "*note" verb in the resulting info.
If you read it in Emacs, it looks a bit different; I think info.el adds
removes “note” and adds “see” in some cases (e.g., see
‘Info-hide-note-references’).
Ludo’.
^ permalink raw reply [flat|nested] 60+ messages in thread
* [bug#58812] [PATCH v3 1/4] Makefile.am: Sort EXTRA_DIST entries.
2022-11-10 14:17 ` Ludovic Courtès
2022-11-10 14:49 ` Maxim Cournoyer
@ 2022-11-10 16:05 ` Maxim Cournoyer
2022-11-10 16:05 ` [bug#58812] [PATCH v3 2/4] install: Validate symlink target in evaluate-populate-directive Maxim Cournoyer
` (2 more replies)
1 sibling, 3 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-10 16:05 UTC (permalink / raw)
To: 58812; +Cc: Maxim Cournoyer
* Makefile.am (EXTRA_DIST): Sort.
---
Makefile.am | 52 ++++++++++++++++++++++++++--------------------------
1 file changed, 26 insertions(+), 26 deletions(-)
diff --git a/Makefile.am b/Makefile.am
index 47886721fa..c3af23b68e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -660,49 +660,49 @@ dist_fishcompletion_DATA = etc/completion/fish/guix.fish
nodist_selinux_policy_DATA = etc/guix-daemon.cil
EXTRA_DIST += \
- HACKING \
- ROADMAP \
- TODO \
- CODE-OF-CONDUCT \
.dir-locals.el \
.guix-authorizations \
.guix-channel \
- scripts/guix.in \
- etc/disarchive-manifest.scm \
- etc/guix-install.sh \
- etc/news.scm \
- etc/release-manifest.scm \
- etc/source-manifest.scm \
- etc/system-tests.scm \
- etc/time-travel-manifest.scm \
- etc/historical-authorizations \
+ CODE-OF-CONDUCT \
+ HACKING \
+ ROADMAP \
+ TODO \
+ bootstrap \
build-aux/build-self.scm \
- build-aux/compile-all.scm \
- build-aux/cuirass/hurd-manifest.scm \
- build-aux/check-final-inputs-self-contained.scm \
build-aux/check-channel-news.scm \
+ build-aux/check-final-inputs-self-contained.scm \
+ build-aux/compile-all.scm \
build-aux/compile-as-derivation.scm \
+ build-aux/config.rpath \
build-aux/convert-xref.scm \
+ build-aux/cuirass/hurd-manifest.scm \
build-aux/generate-authors.scm \
build-aux/test-driver.scm \
- build-aux/update-guix-package.scm \
build-aux/update-NEWS.scm \
- tests/test.drv \
+ build-aux/update-guix-package.scm \
+ doc/build.scm \
+ etc/disarchive-manifest.scm \
+ etc/guix-install.sh \
+ etc/historical-authorizations \
+ etc/news.scm \
+ etc/release-manifest.scm \
+ etc/source-manifest.scm \
+ etc/system-tests.scm \
+ etc/time-travel-manifest.scm \
+ scripts/guix.in \
tests/cve-sample.json \
- tests/keys/signing-key.pub \
- tests/keys/signing-key.sec \
tests/keys/civodul.pub \
- tests/keys/rsa.pub \
tests/keys/dsa.pub \
- tests/keys/ed25519.pub \
- tests/keys/ed25519.sec \
tests/keys/ed25519-2.pub \
tests/keys/ed25519-2.sec \
tests/keys/ed25519-3.pub \
tests/keys/ed25519-3.sec \
- build-aux/config.rpath \
- bootstrap \
- doc/build.scm \
+ tests/keys/ed25519.pub \
+ tests/keys/ed25519.sec \
+ tests/keys/rsa.pub \
+ tests/keys/signing-key.pub \
+ tests/keys/signing-key.sec \
+ tests/test.drv \
$(TESTS)
if !BUILD_DAEMON_OFFLOAD
--
2.37.3
^ permalink raw reply related [flat|nested] 60+ messages in thread* [bug#58812] [PATCH v3 2/4] install: Validate symlink target in evaluate-populate-directive.
2022-11-10 16:05 ` [bug#58812] [PATCH v3 1/4] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
@ 2022-11-10 16:05 ` Maxim Cournoyer
2022-11-10 16:05 ` [bug#58812] [PATCH v3 3/4] guix: shell: Add '--symlink' option Maxim Cournoyer
2022-11-10 16:05 ` [bug#58812] [PATCH v3 4/4] shell: Detect --symlink spec problems early Maxim Cournoyer
2 siblings, 0 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-10 16:05 UTC (permalink / raw)
To: 58812; +Cc: Maxim Cournoyer
* gnu/build/install.scm (evaluate-populate-directive): By default, error when
the target of a symlink doesn't exist. Always ensure TARGET ends with "/".
(populate-root-file-system): Call evaluate-populate-directive with
#:error-on-dangling-symlink #t and add comment.
---
gnu/build/install.scm | 60 ++++++++++++++++++++++++++++---------------
1 file changed, 40 insertions(+), 20 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index f5c8407b89..33a9616c0d 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -56,19 +57,24 @@ (define (install-boot-config bootcfg bootcfg-location mount-point)
(define* (evaluate-populate-directive directive target
#:key
(default-gid 0)
- (default-uid 0))
+ (default-uid 0)
+ (error-on-dangling-symlink? #t))
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under
directory TARGET. DEFAULT-UID and DEFAULT-GID are the default UID and GID in
the context of the caller. If the directive matches those defaults then,
-'chown' won't be run."
+'chown' won't be run. When ERROR-ON-DANGLING-SYMLINK? is true, abort with an
+error when a dangling symlink would be created."
+ (define target* (if (string-suffix? "/" target)
+ target
+ (string-append target "/")))
(let loop ((directive directive))
(catch 'system-error
(lambda ()
(match directive
(('directory name)
- (mkdir-p (string-append target name)))
+ (mkdir-p (string-append target* name)))
(('directory name uid gid)
- (let ((dir (string-append target name)))
+ (let ((dir (string-append target* name)))
(mkdir-p dir)
;; If called from a context without "root" permissions, "chown"
;; to root will fail. In that case, do not try to run "chown"
@@ -78,27 +84,38 @@ (define* (evaluate-populate-directive directive target
(chown dir uid gid))))
(('directory name uid gid mode)
(loop `(directory ,name ,uid ,gid))
- (chmod (string-append target name) mode))
+ (chmod (string-append target* name) mode))
(('file name)
- (call-with-output-file (string-append target name)
+ (call-with-output-file (string-append target* name)
(const #t)))
(('file name (? string? content))
- (call-with-output-file (string-append target name)
+ (call-with-output-file (string-append target* name)
(lambda (port)
(display content port))))
((new '-> old)
- (let try ()
- (catch 'system-error
- (lambda ()
- (symlink old (string-append target new)))
- (lambda args
- ;; When doing 'guix system init' on the current '/', some
- ;; symlinks may already exists. Override them.
- (if (= EEXIST (system-error-errno args))
- (begin
- (delete-file (string-append target new))
- (try))
- (apply throw args))))))))
+ (let ((new* (string-append target* new)))
+ (let try ()
+ (catch 'system-error
+ (lambda ()
+ (when error-on-dangling-symlink?
+ ;; When the symbolic link points to a relative path,
+ ;; checking if its target exists must be done relatively
+ ;; to the link location.
+ (unless (if (string-prefix? "/" old)
+ (file-exists? old)
+ (with-directory-excursion (dirname new*)
+ (file-exists? old)))
+ (error (format #f "symlink `~a' points to nonexistent \
+file `~a'" new* old))))
+ (symlink old new*))
+ (lambda args
+ ;; When doing 'guix system init' on the current '/', some
+ ;; symlinks may already exists. Override them.
+ (if (= EEXIST (system-error-errno args))
+ (begin
+ (delete-file new*)
+ (try))
+ (apply throw args)))))))))
(lambda args
;; Usually we can only get here when installing to an existing root,
;; as with 'guix system init foo.scm /'.
@@ -142,7 +159,10 @@ (define* (populate-root-file-system system target
includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM.
EXTRAS is a list of directives appended to the built-in directives to populate
TARGET."
- (for-each (cut evaluate-populate-directive <> target)
+ ;; It's expected that some symbolic link targets do not exist yet, so do not
+ ;; error on dangling links.
+ (for-each (cut evaluate-populate-directive <> target
+ #:error-on-dangling-symlink? #f)
(append (directives (%store-directory)) extras))
;; Add system generation 1.
--
2.37.3
^ permalink raw reply related [flat|nested] 60+ messages in thread* [bug#58812] [PATCH v3 3/4] guix: shell: Add '--symlink' option.
2022-11-10 16:05 ` [bug#58812] [PATCH v3 1/4] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
2022-11-10 16:05 ` [bug#58812] [PATCH v3 2/4] install: Validate symlink target in evaluate-populate-directive Maxim Cournoyer
@ 2022-11-10 16:05 ` Maxim Cournoyer
2022-11-10 16:05 ` [bug#58812] [PATCH v3 4/4] shell: Detect --symlink spec problems early Maxim Cournoyer
2 siblings, 0 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-10 16:05 UTC (permalink / raw)
To: 58812; +Cc: Maxim Cournoyer
* guix/scripts/pack.scm (%options): Extract symlink parsing logic to...
(symlink-spec-option-parser): ... here.
(self-contained-tarball/builder): Add a comment mentioning why a relative file
name is used for the link target.
* guix/scripts/environment.scm (show-environment-options-help): Document new
--symlink option.
(%default-options): Add default value for symlinks.
(%options): Register new symlink option.
(launch-environment/container): Add #:symlinks argument and extend doc, and
create symlinks using evaluate-populate-directive.
(guix-environment*): Pass symlinks arguments to launch-environment/container.
* doc/guix.texi (Invoking guix shell): Document it.
* tests/guix-shell.sh: Add a --symlink (negative) test.
* tests/guix-environment-container.sh: Add tests.
---
doc/guix.texi | 9 +++++-
guix/scripts/environment.scm | 43 ++++++++++++++++++++++-------
guix/scripts/pack.scm | 39 ++++++++++++++------------
tests/guix-environment-container.sh | 9 ++++++
tests/guix-shell.sh | 3 ++
5 files changed, 75 insertions(+), 28 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 3f76184495..94c3f29790 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -49,7 +49,7 @@ Copyright @copyright{} 2017 humanitiesNerd@*
Copyright @copyright{} 2017, 2021 Christine Lemmer-Webber@*
Copyright @copyright{} 2017, 2018, 2019, 2020, 2021, 2022 Marius Bakke@*
Copyright @copyright{} 2017, 2019, 2020, 2022 Hartmut Goebel@*
-Copyright @copyright{} 2017, 2019, 2020, 2021 Maxim Cournoyer@*
+Copyright @copyright{} 2017, 2019, 2020, 2021, 2022 Maxim Cournoyer@*
Copyright @copyright{} 2017–2022 Tobias Geerinckx-Rice@*
Copyright @copyright{} 2017 George Clemmer@*
Copyright @copyright{} 2017 Andy Wingo@*
@@ -6242,6 +6242,12 @@ directory:
guix shell --container --expose=$HOME=/exchange guile -- guile
@end example
+@cindex symbolic links, guix shell
+@item --symlink=@var{spec}
+@itemx -S @var{spec}
+For containers, create the symbolic links specified by @var{spec}, as
+documented in @ref{pack-symlink-option}.
+
@cindex file system hierarchy standard (FHS)
@cindex FHS (file system hierarchy standard)
@item --emulate-fhs
@@ -7034,6 +7040,7 @@ Compress the resulting tarball using @var{tool}---one of @code{gzip},
@code{zstd}, @code{bzip2}, @code{xz}, @code{lzip}, or @code{none} for no
compression.
+@anchor{pack-symlink-option}
@item --symlink=@var{spec}
@itemx -S @var{spec}
Add the symlinks specified by @var{spec} to the pack. This option can
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index de9bc8f98d..13c6f6cb5c 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -33,8 +33,10 @@ (define-module (guix scripts environment)
#:use-module ((guix gexp) #:select (lower-object))
#:use-module (guix scripts)
#:use-module (guix scripts build)
+ #:autoload (guix scripts pack) (symlink-spec-option-parser)
#:use-module (guix transformations)
#:autoload (ice-9 ftw) (scandir)
+ #:use-module (gnu build install)
#:autoload (gnu build linux-container) (call-with-container %namespaces
user-namespace-supported?
unprivileged-user-namespace-supported?
@@ -120,6 +122,9 @@ (define (show-environment-options-help)
--expose=SPEC for containers, expose read-only host file system
according to SPEC"))
(display (G_ "
+ -S, --symlink=SPEC for containers, add symlinks to the profile according
+ to SPEC, e.g. \"/usr/bin/env=bin/env\"."))
+ (display (G_ "
-v, --verbosity=LEVEL use the given verbosity LEVEL"))
(display (G_ "
--bootstrap use bootstrap binaries to build the environment")))
@@ -157,6 +162,7 @@ (define (show-help)
(define %default-options
`((system . ,(%current-system))
(substitutes? . #t)
+ (symlinks . ())
(offload? . #t)
(graft? . #t)
(print-build-trace? . #t)
@@ -256,6 +262,7 @@ (define %options
(alist-cons 'file-system-mapping
(specification->file-system-mapping arg #f)
result)))
+ (option '(#\S "symlink") #t #f symlink-spec-option-parser)
(option '(#\r "root") #t #f
(lambda (opt name arg result)
(alist-cons 'gc-root arg result)))
@@ -672,7 +679,7 @@ (define* (launch-environment/fork command profile manifest
(define* (launch-environment/container #:key command bash user user-mappings
profile manifest link-profile? network?
map-cwd? emulate-fhs? (setup-hook #f)
- (white-list '()))
+ (symlinks '()) (white-list '()))
"Run COMMAND within a container that features the software in PROFILE.
Environment variables are set according to the search paths of MANIFEST. The
global shell is BASH, a file name for a GNU Bash binary in the store. When
@@ -690,6 +697,9 @@ (define* (launch-environment/container #:key command bash user user-mappings
LINK-PROFILE? creates a symbolic link from ~/.guix-profile to the
environment profile.
+SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
+added to the container.
+
Preserve environment variables whose name matches the one of the regexps in
WHILE-LIST."
(define (optional-mapping->fs mapping)
@@ -797,6 +807,15 @@ (define fhs-mappings
(mkdir-p home-dir)
(setenv "HOME" home-dir)
+ ;; Create symlinks.
+ (let ((symlink->directives
+ (match-lambda
+ ((source '-> target)
+ `((directory ,(dirname source))
+ (,source -> ,(string-append profile "/" target)))))))
+ (for-each (cut evaluate-populate-directive <> ".")
+ (append-map symlink->directives symlinks)))
+
;; Call an additional setup procedure, if provided.
(when setup-hook
(setup-hook profile))
@@ -970,6 +989,7 @@ (define (guix-environment* opts)
(let* ((pure? (assoc-ref opts 'pure))
(container? (assoc-ref opts 'container?))
(link-prof? (assoc-ref opts 'link-profile?))
+ (symlinks (assoc-ref opts 'symlinks))
(network? (assoc-ref opts 'network?))
(no-cwd? (assoc-ref opts 'no-cwd?))
(emulate-fhs? (assoc-ref opts 'emulate-fhs?))
@@ -1010,15 +1030,17 @@ (define-syntax-rule (with-store/maybe store exp ...)
(when container? (assert-container-features))
- (when (and (not container?) link-prof?)
- (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
- (when (and (not container?) user)
- (leave (G_ "'--user' cannot be used without '--container'~%")))
- (when (and (not container?) no-cwd?)
- (leave (G_ "--no-cwd cannot be used without '--container'~%")))
- (when (and (not container?) emulate-fhs?)
- (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
-
+ (when (not container?)
+ (when link-prof?
+ (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
+ (when user
+ (leave (G_ "'--user' cannot be used without '--container'~%")))
+ (when no-cwd?
+ (leave (G_ "--no-cwd cannot be used without '--container'~%")))
+ (when emulate-fhs?
+ (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
+ (when (pair? symlinks)
+ (leave (G_ "'--symlink' cannot be used without '--container~%'"))))
(with-store/maybe store
(with-status-verbosity (assoc-ref opts 'verbosity)
@@ -1099,6 +1121,7 @@ (define manifest
#:network? network?
#:map-cwd? (not no-cwd?)
#:emulate-fhs? emulate-fhs?
+ #:symlinks symlinks
#:setup-hook
(and emulate-fhs?
setup-fhs))))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 06849e4761..a611922db3 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -61,7 +61,9 @@ (define-module (guix scripts pack)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
- #:export (self-contained-tarball
+ #:export (symlink-spec-option-parser
+
+ self-contained-tarball
debian-archive
docker-image
squashfs-image
@@ -160,6 +162,21 @@ (define str (string-join names "-"))
((_) str)
((names ... _) (loop names))))))
+(define (symlink-spec-option-parser opt name arg result)
+ "A SRFI-37 option parser for the --symlink option."
+ ;; Note: Using 'string-split' allows us to handle empty
+ ;; TARGET (as in "/opt/guile=", meaning that /opt/guile is
+ ;; a symlink to the profile) correctly.
+ (match (string-split arg (char-set #\=))
+ ((source target)
+ (let ((symlinks (assoc-ref result 'symlinks)))
+ (alist-cons 'symlinks
+ `((,source -> ,target) ,@symlinks)
+ (alist-delete 'symlinks result eq?))))
+ (x
+ (leave (G_ "~a: invalid symlink specification~%")
+ arg))))
+
\f
;;;
;;; Tarball format.
@@ -226,8 +243,9 @@ (define symlink->directives
`(,@(if (string=? parent "/")
'()
`((directory ,parent)))
- (,source
- -> ,(relative-file-name parent target)))))))
+ ;; Use a relative file name for compatibility with
+ ;; relocatable packs.
+ (,source -> ,(relative-file-name parent target)))))))
(define directives
;; Fully-qualified symlinks.
@@ -1208,20 +1226,7 @@ (define %options
(lambda (opt name arg result)
(alist-cons 'compressor (lookup-compressor arg)
result)))
- (option '(#\S "symlink") #t #f
- (lambda (opt name arg result)
- ;; Note: Using 'string-split' allows us to handle empty
- ;; TARGET (as in "/opt/guile=", meaning that /opt/guile is
- ;; a symlink to the profile) correctly.
- (match (string-split arg (char-set #\=))
- ((source target)
- (let ((symlinks (assoc-ref result 'symlinks)))
- (alist-cons 'symlinks
- `((,source -> ,target) ,@symlinks)
- (alist-delete 'symlinks result eq?))))
- (x
- (leave (G_ "~a: invalid symlink specification~%")
- arg)))))
+ (option '(#\S "symlink") #t #f symlink-spec-option-parser)
(option '("save-provenance") #f #f
(lambda (opt name arg result)
(alist-cons 'save-provenance? #t result)))
diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh
index fb2c19b193..82192375c7 100644
--- a/tests/guix-environment-container.sh
+++ b/tests/guix-environment-container.sh
@@ -241,3 +241,12 @@ guix shell -CF --bootstrap guile-bootstrap glibc \
"glibc-for-fhs")
0
1))'
+
+# '--symlink' works.
+echo "TESTING SYMLINK IN CONTAINER"
+guix shell --bootstrap guile-bootstrap --container \
+ --symlink=/usr/bin/guile=bin/guile -- \
+ /usr/bin/guile --version
+
+# A dangling symlink causes the command to fail.
+! guix shell --bootstrap -CS /usr/bin/python=bin/python guile-bootstrap -- exit
diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh
index 9a6b055264..cb2b53466d 100644
--- a/tests/guix-shell.sh
+++ b/tests/guix-shell.sh
@@ -32,6 +32,9 @@ export XDG_CONFIG_HOME
guix shell --bootstrap --pure guile-bootstrap -- guile --version
+# '--symlink' can only be used with --container.
+! guix shell --bootstrap guile-bootstrap -S /dummy=bin/guile
+
# '--ad-hoc' is a thing of the past.
! guix shell --ad-hoc guile-bootstrap
--
2.37.3
^ permalink raw reply related [flat|nested] 60+ messages in thread* [bug#58812] [PATCH v3 4/4] shell: Detect --symlink spec problems early.
2022-11-10 16:05 ` [bug#58812] [PATCH v3 1/4] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
2022-11-10 16:05 ` [bug#58812] [PATCH v3 2/4] install: Validate symlink target in evaluate-populate-directive Maxim Cournoyer
2022-11-10 16:05 ` [bug#58812] [PATCH v3 3/4] guix: shell: Add '--symlink' option Maxim Cournoyer
@ 2022-11-10 16:05 ` Maxim Cournoyer
2 siblings, 0 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-10 16:05 UTC (permalink / raw)
To: 58812; +Cc: Maxim Cournoyer
* guix/scripts/pack.scm (symlink-spec-option-parser): Remove extraneous
char-set. Raise an exception when the target is an absolute file name.
(guix-pack): Move with-error-handler earlier.
* guix/scripts/shell.scm (guix-shell): Likewise.
* guix/scripts/environment.scm (guix-environment): Wrap the whole
guix-environment* call with the with-error-handling handler.
* tests/guix-environment-container.sh: Add tests.
* tests/guix-pack.sh: Adjust symlink spec.
---
guix/scripts/environment.scm | 294 ++++++++++++++--------------
guix/scripts/pack.scm | 155 ++++++++-------
guix/scripts/shell.scm | 77 ++++----
tests/guix-environment-container.sh | 3 +
tests/guix-pack.sh | 2 +-
5 files changed, 276 insertions(+), 255 deletions(-)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 13c6f6cb5c..64597f6e9f 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -980,158 +980,158 @@ (define-command (guix-environment . args)
(category development)
(synopsis "spawn one-off software environments (deprecated)")
- (guix-environment* (parse-args args)))
+ (with-error-handling
+ (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* ((pure? (assoc-ref opts 'pure))
- (container? (assoc-ref opts 'container?))
- (link-prof? (assoc-ref opts 'link-profile?))
- (symlinks (assoc-ref opts 'symlinks))
- (network? (assoc-ref opts 'network?))
- (no-cwd? (assoc-ref opts 'no-cwd?))
- (emulate-fhs? (assoc-ref opts 'emulate-fhs?))
- (user (assoc-ref opts 'user))
- (bootstrap? (assoc-ref opts 'bootstrap?))
- (system (assoc-ref opts 'system))
- (profile (assoc-ref opts 'profile))
- (command (or (assoc-ref opts 'exec)
- ;; Spawn a shell if the user didn't specify
- ;; anything in particular.
- (if container?
- ;; The user's shell is likely not available
- ;; within the container.
- '("/bin/sh")
- (list %default-shell))))
- (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 (not container?)
- (when link-prof?
- (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
- (when user
- (leave (G_ "'--user' cannot be used without '--container'~%")))
- (when no-cwd?
- (leave (G_ "--no-cwd cannot be used without '--container'~%")))
- (when emulate-fhs?
- (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
- (when (pair? symlinks)
- (leave (G_ "'--symlink' cannot be used without '--container~%'"))))
-
- (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
- (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
- (if container?
- (warning (G_ "'--check' is unnecessary \
+ (let* ((pure? (assoc-ref opts 'pure))
+ (container? (assoc-ref opts 'container?))
+ (link-prof? (assoc-ref opts 'link-profile?))
+ (symlinks (assoc-ref opts 'symlinks))
+ (network? (assoc-ref opts 'network?))
+ (no-cwd? (assoc-ref opts 'no-cwd?))
+ (emulate-fhs? (assoc-ref opts 'emulate-fhs?))
+ (user (assoc-ref opts 'user))
+ (bootstrap? (assoc-ref opts 'bootstrap?))
+ (system (assoc-ref opts 'system))
+ (profile (assoc-ref opts 'profile))
+ (command (or (assoc-ref opts 'exec)
+ ;; Spawn a shell if the user didn't specify
+ ;; anything in particular.
+ (if container?
+ ;; The user's shell is likely not available
+ ;; within the container.
+ '("/bin/sh")
+ (list %default-shell))))
+ (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 (not container?)
+ (when link-prof?
+ (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
+ (when user
+ (leave (G_ "'--user' cannot be used without '--container'~%")))
+ (when no-cwd?
+ (leave (G_ "--no-cwd cannot be used without '--container'~%")))
+ (when emulate-fhs?
+ (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
+ (when (pair? symlinks)
+ (leave (G_ "'--symlink' cannot be used without '--container~%'"))))
+
+ (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
+ (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
+ (if container?
+ (warning (G_ "'--check' is unnecessary \
when using '--container'; doing nothing~%"))
- (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?)
- #:emulate-fhs? emulate-fhs?
- #:symlinks symlinks
- #:setup-hook
- (and emulate-fhs?
- setup-fhs))))
-
- (else
- (return
- (exit/status
- (launch-environment/fork command profile manifest
- #:white-list white-list
- #:pure? pure?))))))))))))))
+ (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?)
+ #:emulate-fhs? emulate-fhs?
+ #:symlinks symlinks
+ #:setup-hook
+ (and emulate-fhs?
+ setup-fhs))))
+
+ (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)
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index a611922db3..f81b3e6501 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -42,6 +42,7 @@ (define-module (guix scripts pack)
#:use-module (guix profiles)
#:use-module (guix describe)
#:use-module (guix derivations)
+ #:use-module (guix diagnostics)
#:use-module (guix search-paths)
#:use-module (guix build-system gnu)
#:use-module (guix scripts build)
@@ -59,6 +60,7 @@ (define-module (guix scripts pack)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:export (symlink-spec-option-parser
@@ -163,12 +165,27 @@ (define str (string-join names "-"))
((names ... _) (loop names))))))
(define (symlink-spec-option-parser opt name arg result)
- "A SRFI-37 option parser for the --symlink option."
+ "A SRFI-37 option parser for the --symlink option. The symlink spec accepts
+the link file name as its left-hand side value and its target as its
+right-hand side value. The target must be a relative link."
;; Note: Using 'string-split' allows us to handle empty
;; TARGET (as in "/opt/guile=", meaning that /opt/guile is
;; a symlink to the profile) correctly.
- (match (string-split arg (char-set #\=))
+ (match (string-split arg #\=)
((source target)
+ (when (string-prefix? "/" target)
+ (raise-exception
+ (make-compound-condition
+ (formatted-message (G_ "symlink target is absolute: '~a'~%") target)
+ (condition
+ (&fix-hint (hint (format #f (G_ "The target of the symlink must be
+relative rather than absolute, as it is relative to the profile created.
+Perhaps the source and target components of the symlink spec were inverted?
+Below is a valid example, where the @file{/usr/bin/env} symbolic link is to
+target the profile's @file{bin/env} file:
+@example
+--symlink=/usr/bin/env=bin/env
+@end example"))))))))
(let ((symlinks (assoc-ref result 'symlinks)))
(alist-cons 'symlinks
`((,source -> ,target) ,@symlinks)
@@ -1326,74 +1343,74 @@ (define-command (guix-pack . args)
(category development)
(synopsis "create application bundles")
- (define opts
- (parse-command-line args %options (list %default-options)))
-
- (define maybe-package-argument
- ;; Given an option pair, return a package, a package/output tuple, or #f.
- (match-lambda
- (('argument . spec)
- (call-with-values
- (lambda ()
- (specification->package+output spec))
- list))
- (('expression . exp)
- (read/eval-package-expression exp))
- (x #f)))
-
- (define (manifest-from-args store opts)
- (let* ((transform (options->transformation opts))
- (packages (map (match-lambda
- (((? package? package) output)
- (list (transform package) output))
- ((? package? package)
- (list (transform package) "out")))
- (reverse
- (filter-map maybe-package-argument opts))))
- (manifests (filter-map (match-lambda
- (('manifest . file) file)
- (_ #f))
- opts)))
- (define with-provenance
- (if (assoc-ref opts 'save-provenance?)
- (lambda (manifest)
- (map-manifest-entries
- (lambda (entry)
- (let ((entry (manifest-entry-with-provenance entry)))
- (unless (assq 'provenance (manifest-entry-properties entry))
- (warning (G_ "could not determine provenance of package ~a~%")
- (manifest-entry-name entry)))
- entry))
- manifest))
- identity))
-
- (with-provenance
- (cond
- ((and (not (null? manifests)) (not (null? packages)))
- (leave (G_ "both a manifest and a package list were given~%")))
- ((not (null? manifests))
- (concatenate-manifests
- (map (lambda (file)
- (let ((user-module (make-user-module
- '((guix profiles) (gnu)))))
- (load* file user-module)))
- manifests)))
- (else
- (packages->manifest packages))))))
-
- (define (process-file-arg opts name)
- ;; Validate that the file exists and return it as a <local-file> object,
- ;; else #f.
- (let ((value (assoc-ref opts name)))
- (match value
- ((and (? string?) (not (? file-exists?)))
- (leave (G_ "file provided with option ~a does not exist: ~a~%")
- (string-append "--" (symbol->string name)) value))
- ((? string?)
- (local-file value))
- (#f #f))))
-
(with-error-handling
+ (define opts
+ (parse-command-line args %options (list %default-options)))
+
+ (define maybe-package-argument
+ ;; Given an option pair, return a package, a package/output tuple, or #f.
+ (match-lambda
+ (('argument . spec)
+ (call-with-values
+ (lambda ()
+ (specification->package+output spec))
+ list))
+ (('expression . exp)
+ (read/eval-package-expression exp))
+ (x #f)))
+
+ (define (manifest-from-args store opts)
+ (let* ((transform (options->transformation opts))
+ (packages (map (match-lambda
+ (((? package? package) output)
+ (list (transform package) output))
+ ((? package? package)
+ (list (transform package) "out")))
+ (reverse
+ (filter-map maybe-package-argument opts))))
+ (manifests (filter-map (match-lambda
+ (('manifest . file) file)
+ (_ #f))
+ opts)))
+ (define with-provenance
+ (if (assoc-ref opts 'save-provenance?)
+ (lambda (manifest)
+ (map-manifest-entries
+ (lambda (entry)
+ (let ((entry (manifest-entry-with-provenance entry)))
+ (unless (assq 'provenance (manifest-entry-properties entry))
+ (warning (G_ "could not determine provenance of package ~a~%")
+ (manifest-entry-name entry)))
+ entry))
+ manifest))
+ identity))
+
+ (with-provenance
+ (cond
+ ((and (not (null? manifests)) (not (null? packages)))
+ (leave (G_ "both a manifest and a package list were given~%")))
+ ((not (null? manifests))
+ (concatenate-manifests
+ (map (lambda (file)
+ (let ((user-module (make-user-module
+ '((guix profiles) (gnu)))))
+ (load* file user-module)))
+ manifests)))
+ (else
+ (packages->manifest packages))))))
+
+ (define (process-file-arg opts name)
+ ;; Validate that the file exists and return it as a <local-file> object,
+ ;; else #f.
+ (let ((value (assoc-ref opts name)))
+ (match value
+ ((and (? string?) (not (? file-exists?)))
+ (leave (G_ "file provided with option ~a does not exist: ~a~%")
+ (string-append "--" (symbol->string name)) value))
+ ((? string?)
+ (local-file value))
+ (#f #f))))
+
(with-store store
(with-status-verbosity (assoc-ref opts 'verbosity)
;; Set the build options before we do anything else.
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index 7a379122ae..2fc1dc942a 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -534,43 +534,44 @@ (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
+ (with-error-handling
+ (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."))) )
- ;; Clean the cache in EXIT-HOOK so that (1) it happens after potential use
- ;; of cached profiles, and (2) cleanup actually happens, even when
- ;; 'guix-environment*' calls 'exit'.
- (add-hook! exit-hook
- (lambda _
- (maybe-remove-expired-cache-entries
- (%profile-cache-directory)
- cache-entries
- #:entry-expiration entry-expiration)))
-
- (if (assoc-ref opts 'export-manifest?)
- (export-manifest opts (current-output-port))
- (guix-environment* opts)))
+ ;; Clean the cache in EXIT-HOOK so that (1) it happens after potential use
+ ;; of cached profiles, and (2) cleanup actually happens, even when
+ ;; 'guix-environment*' calls 'exit'.
+ (add-hook! exit-hook
+ (lambda _
+ (maybe-remove-expired-cache-entries
+ (%profile-cache-directory)
+ cache-entries
+ #:entry-expiration entry-expiration)))
+
+ (if (assoc-ref opts 'export-manifest?)
+ (export-manifest opts (current-output-port))
+ (guix-environment* opts))))
diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh
index 82192375c7..0306fc1744 100644
--- a/tests/guix-environment-container.sh
+++ b/tests/guix-environment-container.sh
@@ -250,3 +250,6 @@ guix shell --bootstrap guile-bootstrap --container \
# A dangling symlink causes the command to fail.
! guix shell --bootstrap -CS /usr/bin/python=bin/python guile-bootstrap -- exit
+
+# An invalid symlink spec causes the command to fail.
+! guix shell --bootstrap -CS bin/guile=/usr/bin/guile guile-bootstrap -- exit
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index f19a0f754e..6fc9e3723b 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -103,7 +103,7 @@ fi
guix pack --dry-run --bootstrap -f docker guile-bootstrap
# Build a Docker image with a symlink.
-guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
+guix pack --dry-run --bootstrap -f docker -S /opt/gnu= guile-bootstrap
# Build a tarball pack of cross-compiled software. Use coreutils because
# guile-bootstrap is not intended to be cross-compiled.
--
2.37.3
^ permalink raw reply related [flat|nested] 60+ messages in thread
* [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell'.
2022-11-09 20:58 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' Ludovic Courtès
2022-11-10 3:10 ` Maxim Cournoyer
@ 2022-11-16 19:03 ` zimoun
2022-11-16 19:34 ` Maxim Cournoyer
1 sibling, 1 reply; 60+ messages in thread
From: zimoun @ 2022-11-16 19:03 UTC (permalink / raw)
To: Ludovic Courtès, Maxim Cournoyer; +Cc: 58812
Hi Maxim,
On Wed, 09 Nov 2022 at 21:58, Ludovic Courtès <ludo@gnu.org> wrote:
>> +@item --symlink=@var{spec}
>> +@itemx -S @var{spec}
>> +For containers, create the symbolic links specified by @var{spec}, as
>> +documented in @ref{pack-symlink-option}.
>
> We should refrain from using @ref in sentences (info "(texinfo) @ref").
> Instead, I’d write:
>
> documented for @command{guix pack} (@pxref{pack-symlink-option}).
Well, for what it is worth, I have marked this email [1] by Eli
Zaretskii from Emacs. Somehow, the message provides some rules of thumb
to write Texinfo. :-) Quoting about cross-reference:
5. Cross-references:
As a separate sentence: @xref{Node name}, for the details.
In the middle of a sentence ... see @ref{Node name}, for more.
In parentheses: Some text (@pxref{Some node}) more text.
1: https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00525.html
Cheers,
simon
^ permalink raw reply [flat|nested] 60+ messages in thread* [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell'.
2022-11-16 19:03 ` [bug#58812] [PATCH 0/5] Add --symlink option to 'guix shell' zimoun
@ 2022-11-16 19:34 ` Maxim Cournoyer
0 siblings, 0 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-11-16 19:34 UTC (permalink / raw)
To: zimoun; +Cc: Ludovic Courtès, 58812
Hi Simon,
zimoun <zimon.toutoune@gmail.com> writes:
> Hi Maxim,
>
> On Wed, 09 Nov 2022 at 21:58, Ludovic Courtès <ludo@gnu.org> wrote:
>
>>> +@item --symlink=@var{spec}
>>> +@itemx -S @var{spec}
>>> +For containers, create the symbolic links specified by @var{spec}, as
>>> +documented in @ref{pack-symlink-option}.
>>
>> We should refrain from using @ref in sentences (info "(texinfo) @ref").
>> Instead, I’d write:
>>
>> documented for @command{guix pack} (@pxref{pack-symlink-option}).
>
> Well, for what it is worth, I have marked this email [1] by Eli
> Zaretskii from Emacs. Somehow, the message provides some rules of thumb
> to write Texinfo. :-) Quoting about cross-reference:
>
> 5. Cross-references:
>
> As a separate sentence: @xref{Node name}, for the details.
> In the middle of a sentence ... see @ref{Node name}, for more.
> In parentheses: Some text (@pxref{Some node}) more text.
>
> 1: https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00525.html
I like it, it takes the occult out of the equation :-).
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 60+ messages in thread
* [bug#58812] [PATCH 5/5] shell: Detect --symlink spec problems early.
2022-10-27 3:50 ` [bug#58812] [PATCH 1/5] Makefile.am: Sort EXTRA_DIST entries Maxim Cournoyer
` (2 preceding siblings ...)
2022-10-27 3:50 ` [bug#58812] [PATCH 4/5] guix: shell: Add '--symlink' option Maxim Cournoyer
@ 2022-10-27 3:51 ` Maxim Cournoyer
3 siblings, 0 replies; 60+ messages in thread
From: Maxim Cournoyer @ 2022-10-27 3:51 UTC (permalink / raw)
To: 58812; +Cc: Maxim Cournoyer
* guix/scripts/pack.scm (symlink-spec-option-parser): Remove extraneous
char-set. Raise an exception when the target is an absolute file name.
(guix-pack): Move with-error-handler earlier.
* guix/scripts/shell.scm (guix-shell): Likewise.
* guix/scripts/environment.scm (guix-environment): Wrap the whole
guix-environment* call with the with-error-handling handler.
* tests/guix-shell.sh: Add test.
* tests/guix-pack.sh: Adjust symlink spec.
---
guix/scripts/environment.scm | 294 +++++++++++++++++------------------
guix/scripts/pack.scm | 155 ++++++++++--------
guix/scripts/shell.scm | 77 ++++-----
tests/guix-pack.sh | 2 +-
tests/guix-shell.sh | 6 +-
5 files changed, 278 insertions(+), 256 deletions(-)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index bd95329c5c..0906b48508 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -975,158 +975,158 @@ (define-command (guix-environment . args)
(category development)
(synopsis "spawn one-off software environments (deprecated)")
- (guix-environment* (parse-args args)))
+ (with-error-handling
+ (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* ((pure? (assoc-ref opts 'pure))
- (container? (assoc-ref opts 'container?))
- (link-prof? (assoc-ref opts 'link-profile?))
- (symlinks (assoc-ref opts 'symlinks))
- (network? (assoc-ref opts 'network?))
- (no-cwd? (assoc-ref opts 'no-cwd?))
- (emulate-fhs? (assoc-ref opts 'emulate-fhs?))
- (user (assoc-ref opts 'user))
- (bootstrap? (assoc-ref opts 'bootstrap?))
- (system (assoc-ref opts 'system))
- (profile (assoc-ref opts 'profile))
- (command (or (assoc-ref opts 'exec)
- ;; Spawn a shell if the user didn't specify
- ;; anything in particular.
- (if container?
- ;; The user's shell is likely not available
- ;; within the container.
- '("/bin/sh")
- (list %default-shell))))
- (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 (not container?)
- (when link-prof?
- (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
- (when user
- (leave (G_ "'--user' cannot be used without '--container'~%")))
- (when no-cwd?
- (leave (G_ "--no-cwd cannot be used without '--container'~%")))
- (when emulate-fhs?
- (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
- (when (pair? symlinks)
- (leave (G_ "'--symlink' cannot be used without '--container~%'"))))
-
- (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
- (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
- (if container?
- (warning (G_ "'--check' is unnecessary \
+ (let* ((pure? (assoc-ref opts 'pure))
+ (container? (assoc-ref opts 'container?))
+ (link-prof? (assoc-ref opts 'link-profile?))
+ (symlinks (assoc-ref opts 'symlinks))
+ (network? (assoc-ref opts 'network?))
+ (no-cwd? (assoc-ref opts 'no-cwd?))
+ (emulate-fhs? (assoc-ref opts 'emulate-fhs?))
+ (user (assoc-ref opts 'user))
+ (bootstrap? (assoc-ref opts 'bootstrap?))
+ (system (assoc-ref opts 'system))
+ (profile (assoc-ref opts 'profile))
+ (command (or (assoc-ref opts 'exec)
+ ;; Spawn a shell if the user didn't specify
+ ;; anything in particular.
+ (if container?
+ ;; The user's shell is likely not available
+ ;; within the container.
+ '("/bin/sh")
+ (list %default-shell))))
+ (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 (not container?)
+ (when link-prof?
+ (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
+ (when user
+ (leave (G_ "'--user' cannot be used without '--container'~%")))
+ (when no-cwd?
+ (leave (G_ "--no-cwd cannot be used without '--container'~%")))
+ (when emulate-fhs?
+ (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
+ (when (pair? symlinks)
+ (leave (G_ "'--symlink' cannot be used without '--container~%'"))))
+
+ (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
+ (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
+ (if container?
+ (warning (G_ "'--check' is unnecessary \
when using '--container'; doing nothing~%"))
- (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?)
- #:emulate-fhs? emulate-fhs?
- #:symlinks symlinks
- #:setup-hook
- (and emulate-fhs?
- setup-fhs))))
-
- (else
- (return
- (exit/status
- (launch-environment/fork command profile manifest
- #:white-list white-list
- #:pure? pure?))))))))))))))
+ (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?)
+ #:emulate-fhs? emulate-fhs?
+ #:symlinks symlinks
+ #:setup-hook
+ (and emulate-fhs?
+ setup-fhs))))
+
+ (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)
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index e3bddc4274..a101900736 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -42,6 +42,7 @@ (define-module (guix scripts pack)
#:use-module (guix profiles)
#:use-module (guix describe)
#:use-module (guix derivations)
+ #:use-module (guix diagnostics)
#:use-module (guix search-paths)
#:use-module (guix build-system gnu)
#:use-module (guix scripts build)
@@ -59,6 +60,7 @@ (define-module (guix scripts pack)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:export (symlink-spec-option-parser
@@ -163,12 +165,27 @@ (define str (string-join names "-"))
((names ... _) (loop names))))))
(define (symlink-spec-option-parser opt name arg result)
- "A SRFI-37 option parser for the --symlink option."
+ "A SRFI-37 option parser for the --symlink option. The symlink spec accepts
+the link file name as its left-hand side value and its target as its
+right-hand side value. The target must be a relative link."
;; Note: Using 'string-split' allows us to handle empty
;; TARGET (as in "/opt/guile=", meaning that /opt/guile is
;; a symlink to the profile) correctly.
- (match (string-split arg (char-set #\=))
+ (match (string-split arg #\=)
((source target)
+ (when (string-prefix? "/" target)
+ (raise-exception
+ (make-compound-condition
+ (formatted-message (G_ "symlink target is absolute: '~a'~%") target)
+ (condition
+ (&fix-hint (hint (format #f (G_ "The target of the symlink must be
+relative rather than absolute, as it is relative to the profile created.
+Perhaps the source and target components of the symlink spec were inverted?
+Below is a valid example, where the @file{/usr/bin/env} symbolic link is to
+target the profile's @file{bin/env} file:
+@example
+--symlink=/usr/bin/env=bin/env
+@end example"))))))))
(let ((symlinks (assoc-ref result 'symlinks)))
(alist-cons 'symlinks
`((,source -> ,target) ,@symlinks)
@@ -1310,74 +1327,74 @@ (define-command (guix-pack . args)
(category development)
(synopsis "create application bundles")
- (define opts
- (parse-command-line args %options (list %default-options)))
-
- (define maybe-package-argument
- ;; Given an option pair, return a package, a package/output tuple, or #f.
- (match-lambda
- (('argument . spec)
- (call-with-values
- (lambda ()
- (specification->package+output spec))
- list))
- (('expression . exp)
- (read/eval-package-expression exp))
- (x #f)))
-
- (define (manifest-from-args store opts)
- (let* ((transform (options->transformation opts))
- (packages (map (match-lambda
- (((? package? package) output)
- (list (transform package) output))
- ((? package? package)
- (list (transform package) "out")))
- (reverse
- (filter-map maybe-package-argument opts))))
- (manifests (filter-map (match-lambda
- (('manifest . file) file)
- (_ #f))
- opts)))
- (define with-provenance
- (if (assoc-ref opts 'save-provenance?)
- (lambda (manifest)
- (map-manifest-entries
- (lambda (entry)
- (let ((entry (manifest-entry-with-provenance entry)))
- (unless (assq 'provenance (manifest-entry-properties entry))
- (warning (G_ "could not determine provenance of package ~a~%")
- (manifest-entry-name entry)))
- entry))
- manifest))
- identity))
-
- (with-provenance
- (cond
- ((and (not (null? manifests)) (not (null? packages)))
- (leave (G_ "both a manifest and a package list were given~%")))
- ((not (null? manifests))
- (concatenate-manifests
- (map (lambda (file)
- (let ((user-module (make-user-module
- '((guix profiles) (gnu)))))
- (load* file user-module)))
- manifests)))
- (else
- (packages->manifest packages))))))
-
- (define (process-file-arg opts name)
- ;; Validate that the file exists and return it as a <local-file> object,
- ;; else #f.
- (let ((value (assoc-ref opts name)))
- (match value
- ((and (? string?) (not (? file-exists?)))
- (leave (G_ "file provided with option ~a does not exist: ~a~%")
- (string-append "--" (symbol->string name)) value))
- ((? string?)
- (local-file value))
- (#f #f))))
-
(with-error-handling
+ (define opts
+ (parse-command-line args %options (list %default-options)))
+
+ (define maybe-package-argument
+ ;; Given an option pair, return a package, a package/output tuple, or #f.
+ (match-lambda
+ (('argument . spec)
+ (call-with-values
+ (lambda ()
+ (specification->package+output spec))
+ list))
+ (('expression . exp)
+ (read/eval-package-expression exp))
+ (x #f)))
+
+ (define (manifest-from-args store opts)
+ (let* ((transform (options->transformation opts))
+ (packages (map (match-lambda
+ (((? package? package) output)
+ (list (transform package) output))
+ ((? package? package)
+ (list (transform package) "out")))
+ (reverse
+ (filter-map maybe-package-argument opts))))
+ (manifests (filter-map (match-lambda
+ (('manifest . file) file)
+ (_ #f))
+ opts)))
+ (define with-provenance
+ (if (assoc-ref opts 'save-provenance?)
+ (lambda (manifest)
+ (map-manifest-entries
+ (lambda (entry)
+ (let ((entry (manifest-entry-with-provenance entry)))
+ (unless (assq 'provenance (manifest-entry-properties entry))
+ (warning (G_ "could not determine provenance of package ~a~%")
+ (manifest-entry-name entry)))
+ entry))
+ manifest))
+ identity))
+
+ (with-provenance
+ (cond
+ ((and (not (null? manifests)) (not (null? packages)))
+ (leave (G_ "both a manifest and a package list were given~%")))
+ ((not (null? manifests))
+ (concatenate-manifests
+ (map (lambda (file)
+ (let ((user-module (make-user-module
+ '((guix profiles) (gnu)))))
+ (load* file user-module)))
+ manifests)))
+ (else
+ (packages->manifest packages))))))
+
+ (define (process-file-arg opts name)
+ ;; Validate that the file exists and return it as a <local-file> object,
+ ;; else #f.
+ (let ((value (assoc-ref opts name)))
+ (match value
+ ((and (? string?) (not (? file-exists?)))
+ (leave (G_ "file provided with option ~a does not exist: ~a~%")
+ (string-append "--" (symbol->string name)) value))
+ ((? string?)
+ (local-file value))
+ (#f #f))))
+
(with-store store
(with-status-verbosity (assoc-ref opts 'verbosity)
;; Set the build options before we do anything else.
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index a2836629ad..7708ce62a9 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -533,43 +533,44 @@ (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
+ (with-error-handling
+ (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."))) )
- ;; Clean the cache in EXIT-HOOK so that (1) it happens after potential use
- ;; of cached profiles, and (2) cleanup actually happens, even when
- ;; 'guix-environment*' calls 'exit'.
- (add-hook! exit-hook
- (lambda _
- (maybe-remove-expired-cache-entries
- (%profile-cache-directory)
- cache-entries
- #:entry-expiration entry-expiration)))
-
- (if (assoc-ref opts 'export-manifest?)
- (export-manifest opts (current-output-port))
- (guix-environment* opts)))
+ ;; Clean the cache in EXIT-HOOK so that (1) it happens after potential use
+ ;; of cached profiles, and (2) cleanup actually happens, even when
+ ;; 'guix-environment*' calls 'exit'.
+ (add-hook! exit-hook
+ (lambda _
+ (maybe-remove-expired-cache-entries
+ (%profile-cache-directory)
+ cache-entries
+ #:entry-expiration entry-expiration)))
+
+ (if (assoc-ref opts 'export-manifest?)
+ (export-manifest opts (current-output-port))
+ (guix-environment* opts))))
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index f19a0f754e..6fc9e3723b 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -103,7 +103,7 @@ fi
guix pack --dry-run --bootstrap -f docker guile-bootstrap
# Build a Docker image with a symlink.
-guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
+guix pack --dry-run --bootstrap -f docker -S /opt/gnu= guile-bootstrap
# Build a tarball pack of cross-compiled software. Use coreutils because
# guile-bootstrap is not intended to be cross-compiled.
diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh
index 32dd997fe7..70dd852009 100644
--- a/tests/guix-shell.sh
+++ b/tests/guix-shell.sh
@@ -44,9 +44,13 @@ if has_container_support; then
--symlink=/usr/bin/guile=bin/guile -- \
/usr/bin/guile --version
- # A bad symlink spec causes the command to fail.
+ # An invalid symlink spec causes the command to fail.
! guix shell --bootstrap -CS bin/guile=/usr/bin/guile guile-bootstrap \
-- exit
+
+ # A dangling symlink causes the command to fail.
+ ! guix shell --bootstrap -CS /usr/bin/python=bin/python guile-bootstrap \
+ -- exit
fi
# '--ad-hoc' is a thing of the past.
--
2.37.3
^ permalink raw reply related [flat|nested] 60+ messages in thread