guix package: Make custom profiles actual indirect roots.

Before that, any profile generation built when '-p' is used would
effectively become a permanent GC root because the symlink in
/var/guix/gcroots/auto would point directly to /gnu/store/...-profile.

* guix/scripts/package.scm (maybe-register-gc-root): Rename to...
  (register-gc-root): ... this.  Remove conditional, and replace call to
  'canonicalize-path' with (string-append (getcwd) "/" ...).
  (guix-package): Call 'register-gc-root' only if PROFILE is different
  from %CURRENT-PROFILE.
* tests/guix-package.sh: Add test case.
master
Ludovic Courtès 2015-02-06 17:52:07 +01:00
parent 3df5acf332
commit c9323a4c69
2 changed files with 29 additions and 6 deletions

View File

@ -661,10 +661,20 @@ removed from MANIFEST."
(_ #f)) (_ #f))
options)) options))
(define (maybe-register-gc-root store profile) (define (register-gc-root store profile)
"Register PROFILE as a GC root, unless it doesn't need it." "Register PROFILE, a profile generation symlink, as a GC root, unless it
(unless (string=? profile %current-profile) doesn't need it."
(add-indirect-root store (canonicalize-path profile)))) (define absolute
;; We must pass the daemon an absolute file name for PROFILE. However, we
;; cannot use (canonicalize-path profile) because that would return us the
;; target of PROFILE in the store; using a store item as an indirect root
;; would mean that said store item will always remain live, which is not
;; what we want here.
(if (string-prefix? "/" profile)
profile
(string-append (getcwd) "/" profile)))
(add-indirect-root store absolute))
(define (readlink* file) (define (readlink* file)
"Call 'readlink' until the result is not a symlink." "Call 'readlink' until the result is not a symlink."
@ -857,7 +867,8 @@ more information.~%"))
(count (length entries))) (count (length entries)))
(switch-symlinks name prof) (switch-symlinks name prof)
(switch-symlinks profile name) (switch-symlinks profile name)
(maybe-register-gc-root (%store) profile) (unless (string=? profile %current-profile)
(register-gc-root (%store) name))
(format #t (N_ "~a package in profile~%" (format #t (N_ "~a package in profile~%"
"~a packages in profile~%" "~a packages in profile~%"
count) count)

View File

@ -32,7 +32,7 @@ module_dir="t-guix-package-$$"
profile="t-profile-$$" profile="t-profile-$$"
rm -f "$profile" rm -f "$profile"
trap 'rm "$profile" "$profile-"[0-9]* ; rm -rf "$module_dir" t-home-'"$$" EXIT trap 'rm -f "$profile" "$profile-"[0-9]* ; rm -rf "$module_dir" t-home-'"$$" EXIT
# Use `-e' with a non-package expression. # Use `-e' with a non-package expression.
if guix package --bootstrap -e +; if guix package --bootstrap -e +;
@ -203,6 +203,18 @@ if guix package -p "$profile" --delete-generations=12m;
then false; else true; fi then false; else true; fi
test "`readlink_base "$profile"`" = "$generation" test "`readlink_base "$profile"`" = "$generation"
# Make sure $profile is a GC root at this point.
real_profile="`readlink -f "$profile"`"
if guix gc -d "$real_profile"
then false; else true; fi
test -d "$real_profile"
# Now, let's remove all the symlinks to $real_profile, and make sure
# $real_profile is no longer a GC root.
rm "$profile" "$profile"-[0-9]-link
guix gc -d "$real_profile"
[ ! -d "$real_profile" ]
# #
# Try with the default profile. # Try with the default profile.
# #