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.
parent
b31ea797ed
commit
788602b37f
|
@ -980,12 +980,12 @@ message if any test fails."
|
||||||
(category development)
|
(category development)
|
||||||
(synopsis "spawn one-off software environments (deprecated)")
|
(synopsis "spawn one-off software environments (deprecated)")
|
||||||
|
|
||||||
(guix-environment* (parse-args args)))
|
(with-error-handling
|
||||||
|
(guix-environment* (parse-args args))))
|
||||||
|
|
||||||
(define (guix-environment* opts)
|
(define (guix-environment* opts)
|
||||||
"Run the 'guix environment' command on OPTS, an alist resulting for
|
"Run the 'guix environment' command on OPTS, an alist resulting for
|
||||||
command-line option processing with 'parse-command-line'."
|
command-line option processing with 'parse-command-line'."
|
||||||
(with-error-handling
|
|
||||||
(let* ((pure? (assoc-ref opts 'pure))
|
(let* ((pure? (assoc-ref opts 'pure))
|
||||||
(container? (assoc-ref opts 'container?))
|
(container? (assoc-ref opts 'container?))
|
||||||
(link-prof? (assoc-ref opts 'link-profile?))
|
(link-prof? (assoc-ref opts 'link-profile?))
|
||||||
|
@ -1131,7 +1131,7 @@ when using '--container'; doing nothing~%"))
|
||||||
(exit/status
|
(exit/status
|
||||||
(launch-environment/fork command profile manifest
|
(launch-environment/fork command profile manifest
|
||||||
#:white-list white-list
|
#:white-list white-list
|
||||||
#:pure? pure?))))))))))))))
|
#:pure? pure?)))))))))))))
|
||||||
|
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
;;; eval: (put 'with-store/maybe 'scheme-indent-function 1)
|
;;; eval: (put 'with-store/maybe 'scheme-indent-function 1)
|
||||||
|
|
|
@ -42,6 +42,7 @@
|
||||||
#:use-module (guix profiles)
|
#:use-module (guix profiles)
|
||||||
#:use-module (guix describe)
|
#:use-module (guix describe)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
|
#:use-module (guix diagnostics)
|
||||||
#:use-module (guix search-paths)
|
#:use-module (guix search-paths)
|
||||||
#:use-module (guix build-system gnu)
|
#:use-module (guix build-system gnu)
|
||||||
#:use-module (guix scripts build)
|
#:use-module (guix scripts build)
|
||||||
|
@ -59,6 +60,7 @@
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
|
#:use-module (srfi srfi-35)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:export (symlink-spec-option-parser
|
#:export (symlink-spec-option-parser
|
||||||
|
@ -163,12 +165,27 @@ its source property."
|
||||||
((names ... _) (loop names))))))
|
((names ... _) (loop names))))))
|
||||||
|
|
||||||
(define (symlink-spec-option-parser opt name arg result)
|
(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
|
;; Note: Using 'string-split' allows us to handle empty
|
||||||
;; TARGET (as in "/opt/guile=", meaning that /opt/guile is
|
;; TARGET (as in "/opt/guile=", meaning that /opt/guile is
|
||||||
;; a symlink to the profile) correctly.
|
;; a symlink to the profile) correctly.
|
||||||
(match (string-split arg (char-set #\=))
|
(match (string-split arg #\=)
|
||||||
((source target)
|
((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)))
|
(let ((symlinks (assoc-ref result 'symlinks)))
|
||||||
(alist-cons 'symlinks
|
(alist-cons 'symlinks
|
||||||
`((,source -> ,target) ,@symlinks)
|
`((,source -> ,target) ,@symlinks)
|
||||||
|
@ -1326,6 +1343,7 @@ Create a bundle of PACKAGE.\n"))
|
||||||
(category development)
|
(category development)
|
||||||
(synopsis "create application bundles")
|
(synopsis "create application bundles")
|
||||||
|
|
||||||
|
(with-error-handling
|
||||||
(define opts
|
(define opts
|
||||||
(parse-command-line args %options (list %default-options)))
|
(parse-command-line args %options (list %default-options)))
|
||||||
|
|
||||||
|
@ -1393,7 +1411,6 @@ Create a bundle of PACKAGE.\n"))
|
||||||
(local-file value))
|
(local-file value))
|
||||||
(#f #f))))
|
(#f #f))))
|
||||||
|
|
||||||
(with-error-handling
|
|
||||||
(with-store store
|
(with-store store
|
||||||
(with-status-verbosity (assoc-ref opts 'verbosity)
|
(with-status-verbosity (assoc-ref opts 'verbosity)
|
||||||
;; Set the build options before we do anything else.
|
;; Set the build options before we do anything else.
|
||||||
|
|
|
@ -534,6 +534,7 @@ concatenates MANIFESTS, a list of expressions."
|
||||||
(category development)
|
(category development)
|
||||||
(synopsis "spawn one-off software environments")
|
(synopsis "spawn one-off software environments")
|
||||||
|
|
||||||
|
(with-error-handling
|
||||||
(define (cache-entries directory)
|
(define (cache-entries directory)
|
||||||
(filter-map (match-lambda
|
(filter-map (match-lambda
|
||||||
((or "." "..") #f)
|
((or "." "..") #f)
|
||||||
|
@ -573,4 +574,4 @@ to make sure your shell does not clobber environment variables."))) )
|
||||||
|
|
||||||
(if (assoc-ref opts 'export-manifest?)
|
(if (assoc-ref opts 'export-manifest?)
|
||||||
(export-manifest opts (current-output-port))
|
(export-manifest opts (current-output-port))
|
||||||
(guix-environment* opts)))
|
(guix-environment* opts))))
|
||||||
|
|
|
@ -250,3 +250,6 @@ guix shell --bootstrap guile-bootstrap --container \
|
||||||
|
|
||||||
# A dangling symlink causes the command to fail.
|
# A dangling symlink causes the command to fail.
|
||||||
! guix shell --bootstrap -CS /usr/bin/python=bin/python guile-bootstrap -- exit
|
! 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
|
||||||
|
|
|
@ -103,7 +103,7 @@ fi
|
||||||
guix pack --dry-run --bootstrap -f docker guile-bootstrap
|
guix pack --dry-run --bootstrap -f docker guile-bootstrap
|
||||||
|
|
||||||
# Build a Docker image with a symlink.
|
# 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
|
# Build a tarball pack of cross-compiled software. Use coreutils because
|
||||||
# guile-bootstrap is not intended to be cross-compiled.
|
# guile-bootstrap is not intended to be cross-compiled.
|
||||||
|
|
Reference in New Issue