From 4be0c2bfd2e2e9a03d860cfb2ff92aa66cbfaa70 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Thu, 8 Oct 2015 21:23:09 -0400 Subject: [PATCH] scripts: environment: Use system* instead of system. This allows for direct program invokation without needing a shell to act as a command interpreter. * guix/scripts/environment.scm (%default-shell): New variable. (show-help): Adjust description. Remove '--exec' reference. (%default-options): Use '%default-shell'. (%options): Adjust '--exec' to run command via the default shell. (parse-args): New procedure. (guix-environment): Use 'parse-args'. Use 'system*' instead of 'system'. * guix/utils.scm (split): New procedure. * tests/guix-environment.sh: Adjust tests to use '--' instead of '--exec'. * tests/utils.scm: Add tests for 'split'. * doc/guix.texi ("Invoking guix environment"): Use new syntax. Remove '--exec' documentation. --- doc/guix.texi | 16 ++++++---------- guix/scripts/environment.scm | 38 ++++++++++++++++++++++++++------------ guix/utils.scm | 18 ++++++++++++++++++ tests/guix-environment.sh | 4 ++-- tests/utils.scm | 14 ++++++++++++++ 5 files changed, 66 insertions(+), 24 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 6da7281..39b76c7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4538,11 +4538,12 @@ and Emacs are available: guix environment guile emacs @end example -Sometimes an interactive shell session is not desired. The address@hidden option can be used to specify the command to run instead. +Sometimes an interactive shell session is not desired. An arbitrary +command may be invoked by placing the @code{--} token to separate the +command from the rest of the arguments: @example -guix environment guile --exec=make +guix environment guile -- make -j4 @end example In other situations, it is more convenient to specify the list of @@ -4551,7 +4552,7 @@ runs @command{python} from an environment containing address@hidden and NumPy: @example -guix environment --ad-hoc python2-numpy python-2.7 -E python +guix environment --ad-hoc python2-numpy python-2.7 -- python @end example The available options are summarized below. @@ -4582,11 +4583,6 @@ As an example, @var{file} might contain a definition like this @verbatiminclude environment-gdb.scm @end example - address@hidden address@hidden address@hidden -E @var{command} -Execute @var{command} in the new environment. - @item --ad-hoc Include all specified packages in the resulting environment, as if an @i{ad hoc} package were defined with them as inputs. This option is @@ -4596,7 +4592,7 @@ package expression to contain the desired inputs. For instance, the command: @example -guix environment --ad-hoc guile guile-sdl -E guile +guix environment --ad-hoc guile guile-sdl -- guile @end example runs @command{guile} in an environment where Guile and Guile-SDL are diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 7aa52e8..d35ab18 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -57,6 +57,9 @@ OUTPUT) tuples." (define %precious-variables '("HOME" "USER" "LOGNAME" "DISPLAY" "TERM" "TZ" "PAGER")) +(define %default-shell + (or (getenv "SHELL") "/bin/sh")) + (define (purify-environment) "Unset almost all environment variables. A small number of variables such as 'HOME' and 'USER' are left untouched." @@ -103,9 +106,9 @@ existing environment variables with additional search paths." ,@(package-transitive-propagated-inputs package))) (define (show-help) - (display (_ "Usage: guix environment [OPTION]... PACKAGE... -Build an environment that includes the dependencies of PACKAGE and execute a -shell command in that environment.\n")) + (display (_ "Usage: guix environment [OPTION]... PACKAGE... [-- COMMAND...] +Build an environment that includes the dependencies of PACKAGE and execute +COMMAND or an interactive shell in that environment.\n")) (display (_ " -e, --expression=EXPR create environment for the package that EXPR evaluates to")) @@ -113,8 +116,6 @@ shell command in that environment.\n")) -l, --load=FILE create environment for the package that the code within FILE evaluates to")) (display (_ " - -E, --exec=COMMAND execute COMMAND in new environment")) - (display (_ " --ad-hoc include all specified packages in the environment instead of only their inputs")) (display (_ " @@ -135,7 +136,7 @@ shell command in that environment.\n")) (define %default-options ;; Default to opening a new shell. - `((exec . ,(or (getenv "SHELL") "/bin/sh")) + `((exec . (,%default-shell)) (system . ,(%current-system)) (substitutes? . #t) (max-silent-time . 3600) @@ -155,7 +156,7 @@ shell command in that environment.\n")) (alist-cons 'pure #t result))) (option '(#\E "exec") #t #f (lambda (opt name arg result) - (alist-cons 'exec arg result))) + (alist-cons 'exec (list %default-shell "-c" arg) result))) (option '("search-paths") #f #f (lambda (opt name arg result) (alist-cons 'search-paths #t result))) @@ -230,14 +231,24 @@ OUTPUT) tuples, using the build options in OPTS." (built-derivations derivations) (return derivations)))))))) -;; Entry point. -(define (guix-environment . args) +(define (parse-args args) + "Parse the list of command line arguments ARGS." (define (handle-argument arg result) (alist-cons 'package arg result)) + ;; The '--' token is used to separate the command to run from the rest of + ;; the operands. + (let-values (((args command) (split args "--"))) + (let ((opts (parse-command-line args %options (list %default-options) + #:argument-handler handle-argument))) + (if (null? command) + opts + (alist-cons 'exec command opts))))) + +;; Entry point. +(define (guix-environment . args) (with-error-handling - (let* ((opts (parse-command-line args %options (list %default-options) - #:argument-handler handle-argument)) + (let* ((opts (parse-args args)) (pure? (assoc-ref opts 'pure)) (ad-hoc? (assoc-ref opts 'ad-hoc?)) (command (assoc-ref opts 'exec)) @@ -282,4 +293,7 @@ OUTPUT) tuples, using the build options in OPTS." (return #t)) (else (create-environment inputs paths pure?) - (return (exit (status:exit-val (system command))))))))))))) + (return + (exit + (status:exit-val + (apply system* command))))))))))))) diff --git a/guix/utils.scm b/guix/utils.scm index 1d4b2ff..070f804 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -79,6 +79,7 @@ fold2 fold-tree fold-tree-leaves + split filtered-port compressed-port @@ -684,6 +685,23 @@ are connected to NODE in the tree, or '() or #f if NODE is a leaf node." (else result))) init children roots)) +(define (split lst e) + "Return two values, a list containing the elements of the list LST that +appear before the first occurence of the object E and a list containing the +elements after E." + (define (same? x) + (equal? e x)) + + (let loop ((rest lst) + (acc '())) + (match rest + (() + (values lst '())) + (((? same?) . tail) + (values (reverse acc) tail)) + ((head . tail) + (loop tail (cons head acc)))))) + ;;; ;;; Source location. diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh index 32faf71..279692f 100644 --- a/tests/guix-environment.sh +++ b/tests/guix-environment.sh @@ -40,7 +40,7 @@ test "`wc -l < "$tmpdir/a"`" = 1 cmp "$tmpdir/a" "$tmpdir/b" # Make sure the exit value is preserved. -if guix environment --ad-hoc guile-bootstrap --pure -E 'guile -c "(exit 42)"' +if guix environment --ad-hoc guile-bootstrap --pure -- guile -c '(exit 42)' then false else @@ -66,7 +66,7 @@ then # as returned by '--search-paths'. guix environment -e '(@@ (gnu packages commencement) gnu-make-boot0)' \ --no-substitutes --pure \ - --exec='echo $PATH $CPATH $LIBRARY_PATH' > "$tmpdir/b" + -- /bin/sh -c 'echo $PATH $CPATH $LIBRARY_PATH' > "$tmpdir/b" ( . "$tmpdir/a" ; echo $PATH $CPATH $LIBRARY_PATH ) > "$tmpdir/c" cmp "$tmpdir/b" "$tmpdir/c" diff --git a/tests/utils.scm b/tests/utils.scm index 115868c..b65d6d2 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -121,6 +121,20 @@ '(0 1 2 3))) list)) +(test-equal "split, element is in list" + '((foo) (baz)) + (call-with-values + (lambda () + (split '(foo bar baz) 'bar)) + list)) + +(test-equal "split, element is not in list" + '((foo bar baz) ()) + (call-with-values + (lambda () + (split '(foo bar baz) 'quux)) + list)) + (test-equal "strip-keyword-arguments" '(a #:b b #:c c) (strip-keyword-arguments '(#:foo #:bar #:baz) -- 2.5.0