From c9323a4c69d48bc9af3825674e43a3febbb42091 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 6 Feb 2015 17:52:07 +0100 Subject: [PATCH] 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. --- guix/scripts/package.scm | 21 ++++++++++++++++----- tests/guix-package.sh | 14 +++++++++++++- 2 files changed, 29 insertions(+), 6 deletions(-) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 1ff898d8dd..fc116d8f6c 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -661,10 +661,20 @@ (define (options->removable options manifest) (_ #f)) options)) -(define (maybe-register-gc-root store profile) - "Register PROFILE as a GC root, unless it doesn't need it." - (unless (string=? profile %current-profile) - (add-indirect-root store (canonicalize-path profile)))) +(define (register-gc-root store profile) + "Register PROFILE, a profile generation symlink, as a GC root, unless it +doesn't need it." + (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) "Call 'readlink' until the result is not a symlink." @@ -857,7 +867,8 @@ (define current-generation-number (count (length entries))) (switch-symlinks name prof) (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~%" "~a packages in profile~%" count) diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 3959269d44..d4917bbf90 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -32,7 +32,7 @@ module_dir="t-guix-package-$$" profile="t-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. if guix package --bootstrap -e +; @@ -203,6 +203,18 @@ if guix package -p "$profile" --delete-generations=12m; then false; else true; fi 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. #