02/02: scripts: environment: Add --no-cwd.

[guix-commits]

carl pushed a commit to branch master
in repository guix.

commit b6dc08393e6a8313b88ce422fc3c1e4e9c0efc6f
Author: Carl Dong <address@hidden>
Date:   Sat Jun 29 17:15:11 2019 -0400

    scripts: environment: Add --no-cwd.
    
    * doc/guix.texi (Invoking guix environment): Add --no-cwd.
    * guix/scripts/environment.scm (show-help, %options): Add --no-cwd.
    (launch-environment/container): Add 'map-cwd?' param; only add mapping
    for cwd if #t.  Only change to cwd within container if #t, otherwise
    home.
    (guix-environment): Error if --no-cwd without --container.  Provide
    '(not no-cwd?)' to launch-environment/container as 'map-cwd?'.
    * tests/guix-environment.sh: Add test for no-cwd.
    
    Co-authored-by: Mike Gerwitz <address@hidden>
---
 doc/guix.texi                |  8 ++++++++
 guix/scripts/environment.scm | 36 +++++++++++++++++++++++++++---------
 tests/guix-environment.sh    |  8 ++++++++
 3 files changed, 43 insertions(+), 9 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 0b50482..3e0788e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4657,6 +4657,14 @@ While this will limit the leaking of user identity 
through home paths
 and each of the user fields, this is only one useful component of a
 broader privacy/anonymity solution---not one in and of itself.
 
+@item --no-cwd
+For containers, the default behavior is to share the current working
+directory with the isolated container and immediately change to that
+directory within the container.  If this is undesirable, @code{--no-cwd}
+will cause the current working directory to @emph{not} be automatically
+shared and will change to the user's home directory within the container
+instead.  See also @code{--user}.
+
 @item --expose=@var{source}[=@var{target}]
 For containers, expose the file system @var{source} from the host system
 as the read-only file system @var{target} within the container.  If
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 949ba11..cf58768 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -162,6 +162,10 @@ COMMAND or an interactive shell in that environment.\n"))
                          user into an isolated container, use the name USER
                          with home directory /home/USER"))
   (display (G_ "
+      --no-cwd           do not share current working directory with an
+                         isolated container"))
+
+  (display (G_ "
       --share=SPEC       for containers, share writable host file system
                          according to SPEC"))
   (display (G_ "
@@ -269,6 +273,9 @@ use '--preserve' instead~%"))
                  (lambda (opt name arg result)
                    (alist-cons 'user arg
                                (alist-delete 'user result eq?))))
+         (option '("no-cwd") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'no-cwd? #t result)))
          (option '("share") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'file-system-mapping
@@ -444,7 +451,8 @@ regexps in WHITE-LIST."
            ((_ . status) status)))))
 
 (define* (launch-environment/container #:key command bash user user-mappings
-                                       profile manifest link-profile? network?)
+                                       profile manifest link-profile? network?
+                                       map-cwd?)
   "Run COMMAND within a container that features the software in PROFILE.
 Environment variables are set according to the search paths of MANIFEST.
 The global shell is BASH, a file name for a GNU Bash binary in the
@@ -483,11 +491,13 @@ will be used for the passwd entry.  LINK-PROFILE? creates 
a symbolic link from
               (override-user-mappings
                user home
                (append user-mappings
-                       ;; Current working directory.
-                       (list (file-system-mapping
-                              (source cwd)
-                              (target cwd)
-                              (writable? #t)))))
+                       ;; Share current working directory, unless asked not to.
+                       (if map-cwd?
+                           (list (file-system-mapping
+                                  (source cwd)
+                                  (target cwd)
+                                  (writable? #t)))
+                           '())))
               ;; When in Rome, do as Nix build.cc does: Automagically
               ;; map common network configuration files.
               (if network?
@@ -537,8 +547,10 @@ will be used for the passwd entry.  LINK-PROFILE? creates 
a symbolic link from
             (write-group groups)
 
             ;; For convenience, start in the user's current working
-            ;; directory rather than the root directory.
-            (chdir (override-user-dir user home cwd))
+            ;; directory or, if unmapped, the home directory.
+            (chdir (if map-cwd?
+                       (override-user-dir user home cwd)
+                       home-dir))
 
             (primitive-exit/status
              ;; A container's environment is already purified, so no need to
@@ -665,6 +677,7 @@ message if any test fails."
            (container? (assoc-ref opts 'container?))
            (link-prof? (assoc-ref opts 'link-profile?))
            (network?   (assoc-ref opts 'network?))
+           (no-cwd?    (assoc-ref opts 'no-cwd?))
            (user       (assoc-ref opts 'user))
            (bootstrap? (assoc-ref opts 'bootstrap?))
            (system     (assoc-ref opts 'system))
@@ -685,6 +698,9 @@ message if any test fails."
         (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
       (when (and (not container?) user)
         (leave (G_ "'--user' cannot be used without '--container'~%")))
+      (when (and (not container?) no-cwd?)
+        (leave (G_ "--no-cwd cannot be used without --container~%")))
+
 
       (with-store store
         (with-status-verbosity (assoc-ref opts 'verbosity)
@@ -741,7 +757,9 @@ message if any test fails."
                                                     #:profile profile
                                                     #:manifest manifest
                                                     #:link-profile? link-prof?
-                                                    #:network? network?)))
+                                                    #:network? network?
+                                                    #:map-cwd? (not no-cwd?))))
+
                    (else
                     (return
                      (exit/status
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index a670db3..5a5a69d 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -84,6 +84,14 @@ echo "(use-modules (guix profiles) (gnu packages bootstrap))
 guix environment --bootstrap --manifest=$tmpdir/manifest.scm --pure \
      -- "$SHELL" -c 'test -f "$GUIX_ENVIRONMENT/bin/guile"'
 
+# if not sharing CWD, chdir home
+(
+  cd "$tmpdir" \
+    && guix environment --bootstrap --container --no-cwd --user=foo  \
+            --ad-hoc guile-bootstrap --pure \
+            -- /bin/sh -c 'test $(pwd) == "/home/foo" -a ! -d '"$tmpdir"
+)
+
 # Make sure '-r' works as expected.
 rm -f "$gcroot"
 expected="`guix environment --bootstrap --ad-hoc guile-bootstrap \