ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-16 03:45:24 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

environment: Suggest command upon 'execlp' failure.

Browse source 
* guix/scripts/environment.scm (launch-environment): Call
'primitive-_exit' upon 'system-error.
(suggest-command-name, validate-exit-status): New procedures.
(launch-environment/fork): Call 'validate-exit-status'.
(launch-environment/container)[exit/status*]: New procedure.
Use it instead of 'exit/status'.
This commit is contained in:
Ludovic Courtès 2021-10-26 17:09:51 +02:00
parent 3c1158ac4e
commit 5d2d87fed7
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 45 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
guix/scripts/environment.scm
View file

@ -34,6 +34,7 @@ (define-module (guix scripts environment)
#:use-module (guix scripts)
#:use-module (guix scripts build)
#:use-module (guix transformations)
#:autoload (ice-9 ftw) (scandir)
#:autoload (gnu build linux-container) (call-with-container %namespaces
user-namespace-supported?
unprivileged-user-namespace-supported?
@ -401,7 +402,12 @@ (define* (launch-environment command profile manifest
(match command
((program . args)
(apply execlp program program args))))
(catch 'system-error
(lambda ()
(apply execlp program program args))
(lambda _
;; Following established convention, exit with 127 upon ENOENT.
(primitive-_exit 127))))))
(define (child-shell-environment shell profile manifest)
"Create a child process, load PROFILE and MANIFEST, and then run SHELL in
@ -552,6 +558,38 @@ (define-syntax-rule (warn exp ...)
(info (G_ "All is good! The shell gets correct environment \
variables.~%")))))
(define (suggest-command-name profile command)
"COMMAND was not found in PROFILE so display a hint suggesting the closest
command name."
(define not-dot?
(match-lambda
((or "." "..") #f)
(_ #t)))
(match (scandir (string-append profile "/bin") not-dot?)
(() #f)
(available
(match command
((executable _ ...)
;; Look for a suggestion with a high threshold: a suggestion is
;; usually better than no suggestion.
(let ((closest (string-closest executable available
#:threshold 12)))
(unless (or (not closest) (string=? closest executable))
(display-hint (format #f (G_ "Did you mean '~a'?~%")
closest)))))))))
(define (validate-exit-status profile command status)
"When STATUS, an integer as returned by 'waitpid', is 127, raise a \"command
not found\" error. Otherwise return STATUS."
;; Most likely, exit value 127 means ENOENT.
(when (eqv? (status:exit-val status) 127)
(report-error (G_ "~a: command not found~%")
(first command))
(suggest-command-name profile command)
(exit 1))
status)
(define* (launch-environment/fork command profile manifest
#:key pure? (white-list '()))
"Run COMMAND in a new process with an environment containing PROFILE, with
@ -563,7 +601,8 @@ (define* (launch-environment/fork command profile manifest
#:pure? pure?
#:white-list white-list))
(pid (match (waitpid pid)
((_ . status) status)))))
((_ . status)
(validate-exit-status profile command status))))))
(define* (launch-environment/container #:key command bash user user-mappings
profile manifest link-profile? network?
@ -584,6 +623,9 @@ (define (optional-mapping->fs mapping)
(and (file-exists? (file-system-mapping-source mapping))
(file-system-mapping->bind-mount mapping)))
(define (exit/status* status)
(exit/status (validate-exit-status profile command status)))
(mlet %store-monad ((reqs (inputs->requisites
(list (direct-store-path bash) profile))))
(return
@ -640,7 +682,7 @@ (define (optional-mapping->fs mapping)
'())
(map file-system-mapping->bind-mount
mappings))))
(exit/status
(exit/status*
(call-with-container file-systems
(lambda ()
;; Setup global shell.