diff options
author | Ludovic Courtès <ludo@gnu.org> | 2021-10-26 17:09:51 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2021-11-06 23:01:21 +0100 |
commit | 5d2d87fed7efcb8f0cee040125f7768bab3df3f4 (patch) | |
tree | d3e16f855af17be7294a4a413ffa3a7404a1e1e6 /guix | |
parent | 3c1158ac4e5ef825a9b9a229a233fabd7cef334e (diff) |
environment: Suggest command upon 'execlp' failure.
* 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'.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/scripts/environment.scm | 48 |
1 files changed, 45 insertions, 3 deletions
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index cca0ad991b..8176de4a5e 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -34,6 +34,7 @@ #: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 @@ regexps in WHITE-LIST." (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 @@ running in a \"container\", immune to the issue described above.")) (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 @@ regexps in WHITE-LIST." #: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 @@ WHILE-LIST." (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 @@ WHILE-LIST." '()) (map file-system-mapping->bind-mount mappings)))) - (exit/status + (exit/status* (call-with-container file-systems (lambda () ;; Setup global shell. |