diff options
| -rw-r--r-- | doc/guix.texi | 4 | ||||
| -rw-r--r-- | guix-package.in | 45 | ||||
| -rw-r--r-- | tests/guix-package.sh | 20 |
3 files changed, 36 insertions, 33 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 1385cd4532..52c992044b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -514,6 +514,10 @@ installed packages, the profile is made to point to the @dfn{empty profile}, also known as @dfn{profile zero}---i.e., it contains no files apart from its own meta-data. +Installing, removing, or upgrading packages from a generation that has +been rolled back to overwrites previous future generations. Thus, the +history of a profile's generations is always linear. + @item --profile=@var{profile} @itemx -p @var{profile} Use @var{profile} instead of the user's default profile. diff --git a/guix-package.in b/guix-package.in index caddae1392..46d8d66d2e 100644 --- a/guix-package.in +++ b/guix-package.in @@ -144,16 +144,6 @@ former profiles were found." (cute regexp-exec (profile-regexp profile) <>)) profiles)))) -(define (latest-profile-number profile) - "Return the identifying number of the latest generation of PROFILE. -PROFILE is the name of the symlink to the current generation." - (fold (lambda (number highest) - (if (> number highest) - number - highest)) - 0 - (profile-numbers profile))) - (define (previous-profile-number profile number) "Return the number of the generation before generation NUMBER of PROFILE, or 0 if none exists. It could be NUMBER - 1, but it's not the @@ -203,9 +193,15 @@ all of PACKAGES, a list of name/version/output/path tuples." (compose string->number (cut match:substring <> 1))) 0)) +(define (switch-symlinks link target) + "Atomically switch LINK, a symbolic link, to point to TARGET. Works +both when LINK already exists and when it does not." + (let ((pivot (string-append link ".new"))) + (symlink target pivot) + (rename-file pivot link))) + (define (roll-back profile) "Roll back to the previous generation of PROFILE." - ;; XXX: Get the previous generation number from the manifest? (let* ((number (profile-number profile)) (previous-number (previous-profile-number profile number)) (previous-profile (format #f "~a-~a-link" @@ -214,11 +210,9 @@ all of PACKAGES, a list of name/version/output/path tuples." (define (switch-link) ;; Atomically switch PROFILE to the previous profile. - (let ((pivot (string-append previous-profile ".new"))) - (format #t (_ "switching from generation ~a to ~a~%") - number previous-number) - (symlink previous-profile pivot) - (rename-file pivot profile))) + (format #t (_ "switching from generation ~a to ~a~%") + number previous-number) + (switch-symlinks profile previous-profile)) (cond ((not (file-exists? profile)) ; invalid profile (format (current-error-port) @@ -237,7 +231,7 @@ all of PACKAGES, a list of name/version/output/path tuples." (when (not (build-derivations (%store) (list drv-path))) (leave (_ "failed to build the empty profile~%"))) - (symlink prof previous-profile) + (switch-symlinks previous-profile prof) (switch-link))) (else (switch-link))))) ; anything else @@ -499,10 +493,13 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (%store) (manifest-packages (profile-manifest profile)))) (old-prof (derivation-path->output-path old-drv)) - (number (latest-profile-number profile)) - (name (format #f "~a/~a-~a-link" - (dirname profile) - (basename profile) (+ 1 number)))) + (number (profile-number profile)) + + ;; Always use NUMBER + 1 for the new profile, + ;; possibly overwriting a "previous future + ;; generation". + (name (format #f "~a-~a-link" + profile (+ 1 number)))) (if (string=? old-prof prof) (when (or (pair? install) (pair? remove)) (format (current-error-port) @@ -515,10 +512,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (%make-void-port "w")))) (build-derivations (%store) (list prof-drv))) (begin - (symlink prof name) - (when (file-exists? profile) - (delete-file profile)) - (symlink name profile)))))))))) + (switch-symlinks name prof) + (switch-symlinks profile name)))))))))) (define (process-query opts) ;; Process any query specified by OPTS. Return #t when a query was diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 87b95236ff..bd63c21969 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -90,22 +90,26 @@ then test "`readlink_base "$profile"`" = "$profile-0-link" done - # Reinstall after roll-back to generation 1. + # Reinstall after roll-back to the empty profile. guix-package --bootstrap -p "$profile" -i "$boot_make" - test "`readlink_base "$profile"`" = "$profile-4-link" - test -x "$profile/bin/guile" && test -x "$profile/bin/make" + test "`readlink_base "$profile"`" = "$profile-1-link" + test -x "$profile/bin/guile" && ! test -x "$profile/bin/make" - # Roll-back to generation 3[*], and install---all at once. - # [*] FIXME: Eventually, this should roll-back to generation 1. + # Roll-back to generation 0, and install---all at once. guix-package --bootstrap -p "$profile" --roll-back -i "$boot_guile" - test "`readlink_base "$profile"`" = "$profile-5-link" + test "`readlink_base "$profile"`" = "$profile-1-link" + test -x "$profile/bin/guile" && ! test -x "$profile/bin/make" + + # Install Make. + guix-package --bootstrap -p "$profile" -i "$boot_make" + test "`readlink_base "$profile"`" = "$profile-2-link" test -x "$profile/bin/guile" && test -x "$profile/bin/make" # Make a "hole" in the list of generations, and make sure we can # roll back "over" it. - rm "$profile-4-link" + rm "$profile-1-link" guix-package --bootstrap -p "$profile" --roll-back - test "`readlink_base "$profile"`" = "$profile-3-link" + test "`readlink_base "$profile"`" = "$profile-0-link" fi # Make sure the `:' syntax works. |