summaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
authorEfraim Flashner <efraim@flashner.co.il>2021-11-08 09:06:14 +0200
committerEfraim Flashner <efraim@flashner.co.il>2021-11-08 09:06:14 +0200
commit1c94392a13cbdf87e03a644633eb775bf45694a1 (patch)
tree74f11038dfc5f9d9db06660b1087253b28c5434f /guix/scripts
parentdd87bbb2b78b279248aaff15c0706fcd6d8cd7bb (diff)
parent9d25ee30b188f9202cc14f7cd25ba8a1c3ec1a72 (diff)
Merge remote-tracking branch 'origin/master' into core-updates-frozen
Diffstat (limited to 'guix/scripts')
-rw-r--r--guix/scripts/environment.scm48
-rw-r--r--guix/scripts/home/import.scm24
-rw-r--r--guix/scripts/import/egg.scm34
-rw-r--r--guix/scripts/shell.scm16
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))