diff options
author | Efraim Flashner <efraim@flashner.co.il> | 2021-11-08 09:06:14 +0200 |
---|---|---|
committer | Efraim Flashner <efraim@flashner.co.il> | 2021-11-08 09:06:14 +0200 |
commit | 1c94392a13cbdf87e03a644633eb775bf45694a1 (patch) | |
tree | 74f11038dfc5f9d9db06660b1087253b28c5434f /guix/scripts | |
parent | dd87bbb2b78b279248aaff15c0706fcd6d8cd7bb (diff) | |
parent | 9d25ee30b188f9202cc14f7cd25ba8a1c3ec1a72 (diff) |
Merge remote-tracking branch 'origin/master' into core-updates-frozen
Diffstat (limited to 'guix/scripts')
-rw-r--r-- | guix/scripts/environment.scm | 48 | ||||
-rw-r--r-- | guix/scripts/home/import.scm | 24 | ||||
-rw-r--r-- | guix/scripts/import/egg.scm | 34 | ||||
-rw-r--r-- | guix/scripts/shell.scm | 16 |
4 files changed, 99 insertions, 23 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. diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm index 7a7712dd96..fbf89069a7 100644 --- a/guix/scripts/home/import.scm +++ b/guix/scripts/home/import.scm @@ -27,6 +27,9 @@ #:use-module (gnu packages) #:use-module (ice-9 match) #:use-module (ice-9 pretty-print) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 regex) + #:use-module (ice-9 popen) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (import-manifest @@ -56,12 +59,33 @@ FILE-NAME with \"-\", and return the basename of it." (define (destination-append path) (string-append destination-directory "/" path)) + (define (bash-alias->pair line) + (if (string-prefix? "alias" line) + (let ((matched (string-match "alias (.+)=\"?'?([^\"']+)\"?'?" line))) + `(,(match:substring matched 1) . ,(match:substring matched 2))) + '())) + + (define (parse-aliases input) + (let loop ((line (read-line input)) + (result '())) + (if (eof-object? line) + (reverse result) + (loop (read-line input) + (cons (bash-alias->pair line) result))))) + (let ((rc (destination-append ".bashrc")) (profile (destination-append ".bash_profile")) (logout (destination-append ".bash_logout"))) `((service home-bash-service-type (home-bash-configuration ,@(if (file-exists? rc) + `((aliases + ',(let* ((port (open-pipe* OPEN_READ "bash" "-i" "-c" "alias")) + (alist (parse-aliases port))) + (close-port port) + (filter (negate null?) alist)))) + '()) + ,@(if (file-exists? rc) `((bashrc (list (local-file ,rc ,(basename+remove-dots rc))))) diff --git a/guix/scripts/import/egg.scm b/guix/scripts/import/egg.scm index 829cdc2ca0..6a9657d12c 100644 --- a/guix/scripts/import/egg.scm +++ b/guix/scripts/import/egg.scm @@ -26,6 +26,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) + #:use-module (srfi srfi-71) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-egg)) @@ -83,21 +84,24 @@ Import and convert the egg package for PACKAGE-NAME.\n")) (_ #f)) (reverse opts)))) (match args - ((package-name) - (if (assoc-ref opts 'recursive) - ;; Recursive import - (map (match-lambda - ((and ('package ('name name) . rest) pkg) - `(define-public ,(string->symbol name) - ,pkg)) - (_ #f)) - (egg-recursive-import package-name)) - ;; Single import - (let ((sexp (egg->guix-package package-name))) - (unless sexp - (leave (G_ "failed to download meta-data for package '~a'~%") - package-name)) - sexp))) + ((spec) + (let ((name version (package-name->name+version spec))) + (if (assoc-ref opts 'recursive) + ;; Recursive import + (map (match-lambda + ((and ('package ('name name) . rest) pkg) + `(define-public ,(string->symbol name) + ,pkg)) + (_ #f)) + (egg-recursive-import name version)) + ;; Single import + (let ((sexp (egg->guix-package name version))) + (unless sexp + (leave (G_ "failed to download meta-data for package '~a'~%") + (if version + (string-append name "@" version) + name))) + sexp)))) (() (leave (G_ "too few arguments~%"))) ((many ...) diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm index 5749485a44..bd62803cb1 100644 --- a/guix/scripts/shell.scm +++ b/guix/scripts/shell.scm @@ -387,8 +387,14 @@ echo ~a >> ~a (display-hint (G_ "Consider passing the @option{--check} option once to make sure your shell does not clobber environment variables."))) ) - (let ((result (guix-environment* opts))) - (maybe-remove-expired-cache-entries (%profile-cache-directory) - cache-entries - #:entry-expiration entry-expiration) - result)) + ;; 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))) + + (guix-environment* opts)) |