guix-package: Always use the next number for new generations.
Suggested by Andreas Enge <andreas@enge.fr> at <http://lists.gnu.org/archive/html/bug-guix/2013-01/msg00325.html>. * guix-package.in (latest-profile-number): Remove. (switch-symlinks): New procedure. (roll-back)[switch-link]: Use it. (guix-package)[process-actions]: Always choose NUMBER + 1 for the new profile. Use `switch-symlinks' instead of `symlink'. Remove code to delete PROFILE when it exists since `switch-symlinks' has the same effect. * tests/guix-package.sh: Adjust existing `--roll-back' tests. * doc/guix.texi (Invoking guix-package): Document this `--roll-back' behavior.
This commit is contained in:
parent
d9307267b3
commit
82fe08ed20
|
@ -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
|
profile}, also known as @dfn{profile zero}---i.e., it contains no files
|
||||||
apart from its own meta-data.
|
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}
|
@item --profile=@var{profile}
|
||||||
@itemx -p @var{profile}
|
@itemx -p @var{profile}
|
||||||
Use @var{profile} instead of the user's default profile.
|
Use @var{profile} instead of the user's default profile.
|
||||||
|
|
|
@ -144,16 +144,6 @@ former profiles were found."
|
||||||
(cute regexp-exec (profile-regexp profile) <>))
|
(cute regexp-exec (profile-regexp profile) <>))
|
||||||
profiles))))
|
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)
|
(define (previous-profile-number profile number)
|
||||||
"Return the number of the generation before generation NUMBER of
|
"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
|
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)))
|
(compose string->number (cut match:substring <> 1)))
|
||||||
0))
|
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)
|
(define (roll-back profile)
|
||||||
"Roll back to the previous generation of PROFILE."
|
"Roll back to the previous generation of PROFILE."
|
||||||
;; XXX: Get the previous generation number from the manifest?
|
|
||||||
(let* ((number (profile-number profile))
|
(let* ((number (profile-number profile))
|
||||||
(previous-number (previous-profile-number profile number))
|
(previous-number (previous-profile-number profile number))
|
||||||
(previous-profile (format #f "~a-~a-link"
|
(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)
|
(define (switch-link)
|
||||||
;; Atomically switch PROFILE to the previous profile.
|
;; Atomically switch PROFILE to the previous profile.
|
||||||
(let ((pivot (string-append previous-profile ".new")))
|
(format #t (_ "switching from generation ~a to ~a~%")
|
||||||
(format #t (_ "switching from generation ~a to ~a~%")
|
number previous-number)
|
||||||
number previous-number)
|
(switch-symlinks profile previous-profile))
|
||||||
(symlink previous-profile pivot)
|
|
||||||
(rename-file pivot profile)))
|
|
||||||
|
|
||||||
(cond ((not (file-exists? profile)) ; invalid profile
|
(cond ((not (file-exists? profile)) ; invalid profile
|
||||||
(format (current-error-port)
|
(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)))
|
(when (not (build-derivations (%store) (list drv-path)))
|
||||||
(leave (_ "failed to build the empty profile~%")))
|
(leave (_ "failed to build the empty profile~%")))
|
||||||
|
|
||||||
(symlink prof previous-profile)
|
(switch-symlinks previous-profile prof)
|
||||||
(switch-link)))
|
(switch-link)))
|
||||||
(else (switch-link))))) ; anything else
|
(else (switch-link))))) ; anything else
|
||||||
|
|
||||||
|
@ -499,10 +493,13 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
||||||
(%store) (manifest-packages
|
(%store) (manifest-packages
|
||||||
(profile-manifest profile))))
|
(profile-manifest profile))))
|
||||||
(old-prof (derivation-path->output-path old-drv))
|
(old-prof (derivation-path->output-path old-drv))
|
||||||
(number (latest-profile-number profile))
|
(number (profile-number profile))
|
||||||
(name (format #f "~a/~a-~a-link"
|
|
||||||
(dirname profile)
|
;; Always use NUMBER + 1 for the new profile,
|
||||||
(basename profile) (+ 1 number))))
|
;; possibly overwriting a "previous future
|
||||||
|
;; generation".
|
||||||
|
(name (format #f "~a-~a-link"
|
||||||
|
profile (+ 1 number))))
|
||||||
(if (string=? old-prof prof)
|
(if (string=? old-prof prof)
|
||||||
(when (or (pair? install) (pair? remove))
|
(when (or (pair? install) (pair? remove))
|
||||||
(format (current-error-port)
|
(format (current-error-port)
|
||||||
|
@ -515,10 +512,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
||||||
(%make-void-port "w"))))
|
(%make-void-port "w"))))
|
||||||
(build-derivations (%store) (list prof-drv)))
|
(build-derivations (%store) (list prof-drv)))
|
||||||
(begin
|
(begin
|
||||||
(symlink prof name)
|
(switch-symlinks name prof)
|
||||||
(when (file-exists? profile)
|
(switch-symlinks profile name))))))))))
|
||||||
(delete-file profile))
|
|
||||||
(symlink name profile))))))))))
|
|
||||||
|
|
||||||
(define (process-query opts)
|
(define (process-query opts)
|
||||||
;; Process any query specified by OPTS. Return #t when a query was
|
;; Process any query specified by OPTS. Return #t when a query was
|
||||||
|
|
|
@ -90,22 +90,26 @@ then
|
||||||
test "`readlink_base "$profile"`" = "$profile-0-link"
|
test "`readlink_base "$profile"`" = "$profile-0-link"
|
||||||
done
|
done
|
||||||
|
|
||||||
# Reinstall after roll-back to generation 1.
|
# Reinstall after roll-back to the empty profile.
|
||||||
guix-package --bootstrap -p "$profile" -i "$boot_make"
|
guix-package --bootstrap -p "$profile" -i "$boot_make"
|
||||||
test "`readlink_base "$profile"`" = "$profile-4-link"
|
test "`readlink_base "$profile"`" = "$profile-1-link"
|
||||||
test -x "$profile/bin/guile" && test -x "$profile/bin/make"
|
test -x "$profile/bin/guile" && ! test -x "$profile/bin/make"
|
||||||
|
|
||||||
# Roll-back to generation 3[*], and install---all at once.
|
# Roll-back to generation 0, and install---all at once.
|
||||||
# [*] FIXME: Eventually, this should roll-back to generation 1.
|
|
||||||
guix-package --bootstrap -p "$profile" --roll-back -i "$boot_guile"
|
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"
|
test -x "$profile/bin/guile" && test -x "$profile/bin/make"
|
||||||
|
|
||||||
# Make a "hole" in the list of generations, and make sure we can
|
# Make a "hole" in the list of generations, and make sure we can
|
||||||
# roll back "over" it.
|
# roll back "over" it.
|
||||||
rm "$profile-4-link"
|
rm "$profile-1-link"
|
||||||
guix-package --bootstrap -p "$profile" --roll-back
|
guix-package --bootstrap -p "$profile" --roll-back
|
||||||
test "`readlink_base "$profile"`" = "$profile-3-link"
|
test "`readlink_base "$profile"`" = "$profile-0-link"
|
||||||
fi
|
fi
|
||||||
|
|
||||||
# Make sure the `:' syntax works.
|
# Make sure the `:' syntax works.
|
||||||
|
|
Loading…
Reference in New Issue