summaryrefslogtreecommitdiff
path: root/guix/profiles.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-10-26 23:01:06 +0100
committerLudovic Courtès <ludo@gnu.org>2015-10-27 00:01:20 +0100
commit06d45f4566469364b4c1fe6d3c71ecf58f5d4838 (patch)
tree20704b607a28fb48ee922485e400b353184c3c89 /guix/profiles.scm
parent3bb168b0997d2ba2ef15e8eef2890582c8a6df9c (diff)
downloadgnu-guix-06d45f4566469364b4c1fe6d3c71ecf58f5d4838.tar
gnu-guix-06d45f4566469364b4c1fe6d3c71ecf58f5d4838.tar.gz
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.
Diffstat (limited to 'guix/profiles.scm')
-rw-r--r--guix/profiles.scm80
1 files changed, 79 insertions, 1 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm
index fac322bbab..e8bd564efa 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -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