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

@ -534,43 +534,44 @@ concatenates MANIFESTS, a list of expressions."
(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) '())))
(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* (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 opts
(parse-args args))
(define interactive?
(not (assoc-ref opts 'exec)))
(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
(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)))
;; 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)))
(if (assoc-ref opts 'export-manifest?)
(export-manifest opts (current-output-port))
(guix-environment* opts))))