nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

guix-package: Allow `--roll-back' to skip missing generations. 

* guix-package.in (profile-numbers): New procedure.
  (latest-profile-number): Use it.
  (previous-profile-number): New procedure.
  (roll-back): Use it lieu of `1-'.  Check whether PREVIOUS-NUMBER is
  zero, and raise an error when it is.
* tests/guix-package.sh: Test whether we can roll back over a "hole".
master
Ludovic Courtès 2013-01-17 22:41:47 +01:00
parent 24e262f086
commit 9241172c9d
2 changed files with 47 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
guix-package.in
View File

@ -95,9 +95,9 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
(make-regexp (string-append "^" (regexp-quote (basename profile)) (make-regexp (string-append "^" (regexp-quote (basename profile))
"-([0-9]+)"))) "-([0-9]+)")))
(define (latest-profile-number profile) (define (profile-numbers profile)
"Return the identifying number of the latest generation of PROFILE. "Return the list of generation numbers of PROFILE, or '(0) if no
PROFILE is the name of the symlink to the current generation." former profiles were found."
(define* (scandir name #:optional (select? (const #t)) (define* (scandir name #:optional (select? (const #t))
(entry<? (@ (ice-9 i18n) string-locale<?))) (entry<? (@ (ice-9 i18n) string-locale<?)))
;; XXX: Bug-fix version introduced in Guile v2.0.6-62-g139ce19. ;; XXX: Bug-fix version introduced in Guile v2.0.6-62-g139ce19.
@ -135,21 +135,35 @@ PROFILE is the name of the symlink to the current generation."
(match (scandir (dirname profile) (match (scandir (dirname profile)
(cute regexp-exec (profile-regexp profile) <>)) (cute regexp-exec (profile-regexp profile) <>))
(#f ; no profile directory (#f ; no profile directory
0) '(0))
(() ; no profiles (() ; no profiles
0) '(0))
((profiles ...) ; former profiles around ((profiles ...) ; former profiles around
(let ((numbers (map (compose string->number
(map (compose string->number (cut match:substring <> 1)
(cut match:substring <> 1) (cute regexp-exec (profile-regexp profile) <>))
(cut regexp-exec (profile-regexp profile) <>)) profiles))))
profiles)))
(fold (lambda (number highest) (define (latest-profile-number profile)
(if (> number highest) "Return the identifying number of the latest generation of PROFILE.
number PROFILE is the name of the symlink to the current generation."
highest)) (fold (lambda (number highest)
0 (if (> number highest)
numbers))))) 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
case when generations have been deleted (there are \"holes\")."
(fold (lambda (candidate highest)
(if (and (< candidate number) (> candidate highest))
candidate
highest))
0
(profile-numbers profile)))
(define (profile-derivation store packages) (define (profile-derivation store packages)
"Return a derivation that builds a profile (a user environment) with "Return a derivation that builds a profile (a user environment) with
@ -192,12 +206,12 @@ all of PACKAGES, a list of name/version/output/path tuples."
(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? ;; XXX: Get the previous generation number from the manifest?
(let* ((number (profile-number profile)) (let* ((number (profile-number profile))
(previous-number (1- number)) (previous-number (previous-profile-number profile number))
(previous-profile (format #f "~a/~a-~a-link" (previous-profile (format #f "~a/~a-~a-link"
(dirname profile) profile (dirname profile) profile
previous-number)) previous-number))
(manifest (string-append previous-profile "/manifest"))) (manifest (string-append previous-profile "/manifest")))
(define (switch-link) (define (switch-link)
;; Atomically switch PROFILE to the previous profile. ;; Atomically switch PROFILE to the previous profile.
@ -207,11 +221,14 @@ all of PACKAGES, a list of name/version/output/path tuples."
(symlink previous-profile pivot) (symlink previous-profile pivot)
(rename-file pivot profile))) (rename-file pivot profile)))
(if (= number 0) (cond ((zero? number)
(leave (_ "error: `~a' is not a valid profile~%") profile) (format (current-error-port)
(if (file-exists? previous-profile) (_ "error: `~a' is not a valid profile~%")
(switch-link) profile))
(leave (_ "error: no previous profile; not rolling back~%")))))) ((or (zero? previous-number)
(not (file-exists? previous-profile)))
(leave (_ "error: no previous profile; not rolling back~%")))
(else (switch-link)))))
;;; ;;;

6
tests/guix-package.sh
View File

@ -95,6 +95,12 @@ then
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-5-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
# roll back "over" it.
rm "$profile-4-link"
guix-package --bootstrap -p "$profile" --roll-back
test "`readlink_base "$profile"`" = "$profile-3-link"
fi fi
# Make sure the `:' syntax works. # Make sure the `:' syntax works.