TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

profiles: Add generation manipulation procedures. 

* guix/scripts/package.scm (delete-generations): Use
  'delete-generation*' instead of 'delete-generation'.
  (guix-package)[process-actions]: Use 'roll-back*' instead of
  'roll-back' and 'switch-to-generation*' instead of
  'switch-to-generation'.
  (link-to-empty-profile, switch-to-generation,
  switch-to-previous-generation, roll-back, delete-generation): Move
  to...
* guix/profiles.scm: ... here.  Adjust to not print messages and to
  return values that can be used by user interfaces.
* guix/ui.scm (display-generation-change, roll-back*,
  switch-to-generation*, delete-generation*): New procedures.
This commit is contained in:
Ludovic Courtès 2015-10-26 23:01:06 +01:00
parent 3bb168b099
commit 06d45f4566
3 changed files with 107 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
guix/profiles.scm
View File

@ -84,13 +84,17 @@
packages->manifest
%default-profile-hooks
profile-derivation
generation-number
generation-numbers
profile-generations
relative-generation
previous-generation-number
generation-time
generation-file-name))
generation-file-name
switch-to-generation
roll-back
delete-generation))
;;; Commentary:
;;;
@ -844,4 +848,78 @@ case when generations have been deleted (there are \"holes\")."
(make-time time-utc 0
(stat:ctime (stat (generation-file-name profile number)))))
(define (link-to-empty-profile store generation)
"Link GENERATION, a string, to the empty profile. An error is raised if
that fails."
(let* ((drv (run-with-store store
(profile-derivation (manifest '()))))
(prof (derivation->output-path drv "out")))
(build-derivations store (list drv))
(switch-symlinks generation prof)))
(define (switch-to-generation profile number)
"Atomically switch PROFILE to the generation NUMBER. Return the number of
the generation that was current before switching."
(let ((current (generation-number profile))
(generation (generation-file-name profile number)))
(cond ((not (file-exists? profile))
(raise (condition (&profile-not-found-error
(profile profile)))))
((not (file-exists? generation))
(raise (condition (&missing-generation-error
(profile profile)
(generation number)))))
(else
(switch-symlinks profile generation)
current))))
(define (switch-to-previous-generation profile)
"Atomically switch PROFILE to the previous generation. Return the former
generation number and the current one."
(let ((previous (previous-generation-number profile)))
(values (switch-to-generation profile previous)
previous)))
(define (roll-back store profile)
"Roll back to the previous generation of PROFILE. Return the number of the
generation that was current before switching and the new generation number."
(let* ((number (generation-number profile))
(previous-number (previous-generation-number profile number))
(previous-generation (generation-file-name profile previous-number)))
(cond ((not (file-exists? profile)) ;invalid profile
(raise (condition (&profile-not-found-error
(profile profile)))))
((zero? number) ;empty profile
(values number number))
((or (zero? previous-number) ;going to emptiness
(not (file-exists? previous-generation)))
(link-to-empty-profile store previous-generation)
(switch-to-previous-generation profile))
(else ;anything else
(switch-to-previous-generation profile)))))
(define (delete-generation store profile number)
"Delete generation with NUMBER from PROFILE. Return the file name of the
generation that has been deleted, or #f if nothing was done (for instance
because the NUMBER is zero.)"
(define (delete-and-return)
(let ((generation (generation-file-name profile number)))
(delete-file generation)
generation))
(let* ((current-number (generation-number profile))
(previous-number (previous-generation-number profile number))
(previous-generation (generation-file-name profile previous-number)))
(cond ((zero? number) #f) ;do not delete generation 0
((and (= number current-number)
(not (file-exists? previous-generation)))
(link-to-empty-profile store previous-generation)
(switch-to-previous-generation profile)
(delete-and-return))
((= number current-number)
(roll-back store profile)
(delete-and-return))
(else
(delete-and-return)))))
;;; profiles.scm ends here

83
guix/scripts/package.scm
View File

@ -48,11 +48,7 @@
#:use-module (gnu packages base)
#:use-module (gnu packages guile)
#:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
#:export (switch-to-generation
switch-to-previous-generation
roll-back
delete-generation
delete-generations
#:export (delete-generations
display-search-paths
guix-package))
@ -100,81 +96,10 @@ indirectly, or PROFILE."
%user-profile-directory
profile))
(define (link-to-empty-profile store generation)
"Link GENERATION, a string, to the empty profile."
(let* ((drv (run-with-store store
(profile-derivation (manifest '()))))
(prof (derivation->output-path drv "out")))
(when (not (build-derivations store (list drv)))
(leave (_ "failed to build the empty profile~%")))
(switch-symlinks generation prof)))
(define (switch-to-generation profile number)
"Atomically switch PROFILE to the generation NUMBER."
(let ((current (generation-number profile))
(generation (generation-file-name profile number)))
(cond ((not (file-exists? profile))
(raise (condition (&profile-not-found-error
(profile profile)))))
((not (file-exists? generation))
(raise (condition (&missing-generation-error
(profile profile)
(generation number)))))
(else
(format #t (_ "switching from generation ~a to ~a~%")
current number)
(switch-symlinks profile generation)))))
(define (switch-to-previous-generation profile)
"Atomically switch PROFILE to the previous generation."
(switch-to-generation profile
(previous-generation-number profile)))
(define (roll-back store profile)
"Roll back to the previous generation of PROFILE."
(let* ((number (generation-number profile))
(previous-number (previous-generation-number profile number))
(previous-generation (generation-file-name profile previous-number)))
(cond ((not (file-exists? profile)) ; invalid profile
(raise (condition (&profile-not-found-error
(profile profile)))))
((zero? number) ; empty profile
(format (current-error-port)
(_ "nothing to do: already at the empty profile~%")))
((or (zero? previous-number) ; going to emptiness
(not (file-exists? previous-generation)))
(link-to-empty-profile store previous-generation)
(switch-to-previous-generation profile))
(else
(switch-to-previous-generation profile))))) ; anything else
(define (delete-generation store profile number)
"Delete generation with NUMBER from PROFILE."
(define (display-and-delete)
(let ((generation (generation-file-name profile number)))
(format #t (_ "deleting ~a~%") generation)
(delete-file generation)))
(let* ((current-number (generation-number profile))
(previous-number (previous-generation-number profile number))
(previous-generation (generation-file-name profile previous-number)))
(cond ((zero? number)) ; do not delete generation 0
((and (= number current-number)
(not (file-exists? previous-generation)))
(link-to-empty-profile store previous-generation)
(switch-to-previous-generation profile)
(display-and-delete))
((= number current-number)
(roll-back store profile)
(display-and-delete))
(else
(display-and-delete)))))
(define (delete-generations store profile generations)
"Delete GENERATIONS from PROFILE.
GENERATIONS is a list of generation numbers."
(for-each (cut delete-generation store profile <>)
(for-each (cut delete-generation* store profile <>)
generations))
(define (delete-matching-generations store profile pattern)
@ -725,7 +650,7 @@ more information.~%"))
;; First roll back if asked to.
(cond ((and (assoc-ref opts 'roll-back?)
(not dry-run?))
(roll-back (%store) profile)
(roll-back* (%store) profile)
(process-actions (alist-delete 'roll-back? opts)))
((and (assoc-ref opts 'switch-generation)
(not dry-run?))
@ -739,7 +664,7 @@ more information.~%"))
(relative-generation profile number))
(else number)))))
(if number
(switch-to-generation profile number)
(switch-to-generation* profile number)
(leave (_ "cannot switch to generation '~a'~%")
pattern)))
(process-actions (alist-delete 'switch-generation opts)))

24
guix/ui.scm
View File

@ -86,6 +86,9 @@
matching-generations
display-generation
display-profile-content
roll-back*
switch-to-generation*
delete-generation*
run-guix-command
run-guix
program-name
@ -1035,6 +1038,27 @@ way."
(manifest-entries
(profile-manifest (generation-file-name profile number))))))
(define (display-generation-change previous current)
(format #t (_ "switched from generation ~a to ~a~%") previous current))
(define (roll-back* store profile)
"Like 'roll-back', but display what is happening."
(call-with-values
(lambda ()
(roll-back store profile))
display-generation-change))
(define (switch-to-generation* profile number)
"Like 'switch-generation', but display what is happening."
(let ((previous (switch-to-generation profile number)))
(display-generation-change previous number)))
(define (delete-generation* store profile generation)
"Like 'delete-generation', but display what is going on."
(format #t (_ "deleting ~a~%")
(generation-file-name profile generation))
(delete-generation store profile generation))
(define* (package-specification->name+version+output spec
#:optional (output "out"))
"Parse package specification SPEC and return three value: the specified