3 files changed, 63 insertions(+), 3 deletions(-)

M doc/guix.texi
M guix/scripts/environment.scm
M tests/guix-environment.sh

@@ 5997,6 5997,21 @@ The @code{--container} option requires Linux-libre 3.19 or newer.
 The available options are summarized below.
 
 @table @code
+@item --root=@var{file}
+@itemx -r @var{file}
+@cindex persistent environment
+@cindex garbage collector root, for environments
+Make @var{file} a symlink to the profile for this environment, and
+register it as a garbage collector root.
+
+This is useful if you want to protect your environment from garbage
+collection, to make it ``persistent''.
+
+When this option is omitted, the environment is protected from garbage
+collection only for the duration of the @command{guix environment}
+session.  This means that next time you recreate the same environment,
+you could have to rebuild or re-download packages.
+
 @item --expression=@var{expr}
 @itemx -e @var{expr}
 Create an environment for the package or list of packages that

@@ 155,6 155,9 @@ COMMAND or an interactive shell in that environment.\n"))
   (display (_ "
   -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
   (display (_ "
+  -r, --root=FILE        make FILE a symlink to the result, and register it
+                         as a garbage collector root"))
+  (display (_ "
   -C, --container        run command within an isolated container"))
   (display (_ "
   -N, --network          allow containers to access the network"))


@@ 247,6 250,9 @@ COMMAND or an interactive shell in that environment.\n"))
                    (alist-cons 'file-system-mapping
                                (specification->file-system-mapping arg #f)
                                result)))
+         (option '(#\r "root") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'gc-root arg result)))
          (option '("bootstrap") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'bootstrap? #t result)))


@@ 523,7 529,26 @@ message if any test fails."
     (report-error (_ "cannot create container: /proc/self/setgroups does not exist\n"))
     (leave (_ "is your kernel version < 3.19?\n"))))
 
-;; Entry point.
+(define (register-gc-root target root)
+  "Make ROOT an indirect root to TARGET.  This is procedure is idempotent."
+  (let* ((root (string-append (canonicalize-path (dirname root))
+                              "/" root)))
+    (catch 'system-error
+      (lambda ()
+        (symlink target root)
+        ((store-lift add-indirect-root) root))
+      (lambda args
+        (if (and (= EEXIST (system-error-errno args))
+                 (equal? (false-if-exception (readlink root)) target))
+            (with-monad %store-monad
+              (return #t))
+            (apply throw args))))))
+
+
+;;;
+;;; Entry point.
+;;;
+
 (define (guix-environment . args)
   (with-error-handling
     (let* ((opts       (parse-args args))


@@ 579,7 604,9 @@ message if any test fails."
                                                                system))
                                  (prof-drv   (inputs->profile-derivation
                                               inputs system bootstrap?))
-                                 (profile -> (derivation->output-path prof-drv)))
+                                 (profile -> (derivation->output-path prof-drv))
+                                 (gc-root -> (assoc-ref opts 'gc-root)))
+
               ;; First build the inputs.  This is necessary even for
               ;; --search-paths.  Additionally, we might need to build bash for
               ;; a container.


@@ 588,6 615,9 @@ message if any test fails."
                                        (list prof-drv bash)
                                        (list prof-drv))
                                    opts)
+                (mwhen gc-root
+                  (register-gc-root profile gc-root))
+
                 (cond
                  ((assoc-ref opts 'dry-run?)
                   (return #t))

@@ 25,7 25,8 @@ set -e
 guix environment --version
 
 tmpdir="t-guix-environment-$$"
-trap 'rm -r "$tmpdir"' EXIT
+gcroot="t-guix-environment-gc-root-$$"
+trap 'rm -r "$tmpdir"; rm -f "$gcroot"' EXIT
 
 mkdir "$tmpdir"
 


@@ 61,6 62,20 @@ fi
 guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
      -- "$SHELL" -c 'test -f "$GUIX_ENVIRONMENT/bin/guile"'
 
+# Make sure '-r' works as expected.
+rm -f "$gcroot"
+expected="`guix environment --bootstrap --ad-hoc guile-bootstrap \
+             -- "$SHELL" -c 'echo $GUIX_ENVIRONMENT'`"
+guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
+     -- guile -c 1
+test `readlink "$gcroot"` = "$expected"
+
+# Make sure '-r' is idempotent.
+guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
+     -- guile -c 1
+test `readlink "$gcroot"` = "$expected"
+
+
 case "`uname -m`" in
     x86_64)
 	# On x86_64, we should be able to create a 32-bit environment.