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".
This commit is contained in:
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

47
guix-package.in
View File

@ -95,9 +95,9 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
(make-regexp (string-append "^" (regexp-quote (basename profile))
"-([0-9]+)")))
(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."
(define (profile-numbers profile)
"Return the list of generation numbers of PROFILE, or '(0) if no
former profiles were found."
(define* (scandir name #:optional (select? (const #t))
(entry<? (@ (ice-9 i18n) string-locale<?)))
;; 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)
(cute regexp-exec (profile-regexp profile) <>))
(#f ; no profile directory
0)
'(0))
(() ; no profiles
0)
'(0))
((profiles ...) ; former profiles around
(let ((numbers
(map (compose string->number
(cut match:substring <> 1)
(cut regexp-exec (profile-regexp profile) <>))
profiles)))
(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
numbers)))))
(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)
"Return a derivation that builds a profile (a user environment) with
@ -193,7 +207,7 @@ all of PACKAGES, a list of name/version/output/path tuples."
"Roll back to the previous generation of PROFILE."
;; XXX: Get the previous generation number from the manifest?
(let* ((number (profile-number profile))
(previous-number (1- number))
(previous-number (previous-profile-number profile number))
(previous-profile (format #f "~a/~a-~a-link"
(dirname profile) profile
previous-number))
@ -207,11 +221,14 @@ all of PACKAGES, a list of name/version/output/path tuples."
(symlink previous-profile pivot)
(rename-file pivot profile)))
(if (= number 0)
(leave (_ "error: `~a' is not a valid profile~%") profile)
(if (file-exists? previous-profile)
(switch-link)
(leave (_ "error: no previous profile; not rolling back~%"))))))
(cond ((zero? number)
(format (current-error-port)
(_ "error: `~a' is not a valid profile~%")
profile))
((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"
test "`readlink_base "$profile"`" = "$profile-5-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"
guix-package --bootstrap -p "$profile" --roll-back
test "`readlink_base "$profile"`" = "$profile-3-link"
fi
# Make sure the `:' syntax works.