~ruther/guix-local

82fe08ed207a17c51370dc90e965c15ee9db9235 — Ludovic Courtès 13 years ago d930726
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.
3 files changed, 36 insertions(+), 33 deletions(-)

M doc/guix.texi
M guix-package.in
M tests/guix-package.sh
M doc/guix.texi => doc/guix.texi +4 -0
@@ 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.

M guix-package.in => guix-package.in +20 -25
@@ 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

M tests/guix-package.sh => tests/guix-package.sh +12 -8
@@ 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.