3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00

shell: Detect --symlink spec problems early.

* 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.
This commit is contained in:
Maxim Cournoyer 2022-10-26 15:56:27 -04:00
parent b31ea797ed
commit 788602b37f
No known key found for this signature in database
GPG key ID: 1260E46482E63562
5 changed files with 258 additions and 237 deletions

View file

@ -980,12 +980,12 @@ message if any test fails."
(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?))
@ -1131,7 +1131,7 @@ when using '--container'; doing nothing~%"))
(exit/status
(launch-environment/fork command profile manifest
#:white-list white-list
#:pure? pure?))))))))))))))
#:pure? pure?)))))))))))))
;;; Local Variables:
;;; eval: (put 'with-store/maybe 'scheme-indent-function 1)

View file

@ -42,6 +42,7 @@
#: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 @@
#: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 @@ its source property."
((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,6 +1343,7 @@ Create a bundle of PACKAGE.\n"))
(category development)
(synopsis "create application bundles")
(with-error-handling
(define opts
(parse-command-line args %options (list %default-options)))
@ -1393,7 +1411,6 @@ Create a bundle of PACKAGE.\n"))
(local-file value))
(#f #f))))
(with-error-handling
(with-store store
(with-status-verbosity (assoc-ref opts 'verbosity)
;; Set the build options before we do anything else.

View file

@ -534,6 +534,7 @@ concatenates MANIFESTS, a list of expressions."
(category development)
(synopsis "spawn one-off software environments")
(with-error-handling
(define (cache-entries directory)
(filter-map (match-lambda
((or "." "..") #f)
@ -573,4 +574,4 @@ to make sure your shell does not clobber environment variables."))) )
(if (assoc-ref opts 'export-manifest?)
(export-manifest opts (current-output-port))
(guix-environment* opts)))
(guix-environment* opts))))

View file

@ -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

View file

@ -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.