summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-10-30 22:08:35 +0100
committerLudovic Courtès <ludo@gnu.org>2013-10-30 22:09:33 +0100
commit477d30d0d8dddf1f92e4a2730cbc4434d8f81c0c (patch)
treeaae4c3a5a471cf9ccd50152fb537badf632ca6cf
parent1fcc3ba3090a1369afd50c47dc50c17695672120 (diff)
guix package: Factorize generation file name computation.
* guix/scripts/package.scm (generation-file-name): New procedure. Change all occurrences of (format #f "~a-~a-link" profile number) to use it.
-rw-r--r--guix/scripts/package.scm28
1 files changed, 15 insertions, 13 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 339d1afd36..008ae53b47 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -299,6 +299,10 @@ the given MANIFEST."
(compose string->number (cut match:substring <> 1)))
0))
+(define (generation-file-name profile generation)
+ "Return the file name for PROFILE's GENERATION."
+ (format #f "~a-~a-link" profile generation))
+
(define (link-to-empty-profile generation)
"Link GENERATION, a string, to the empty profile."
(let* ((drv (profile-derivation (%store) (manifest '())))
@@ -312,8 +316,7 @@ the given MANIFEST."
"Atomically switch PROFILE to the previous generation."
(let* ((number (generation-number profile))
(previous-number (previous-generation-number profile number))
- (previous-generation (format #f "~a-~a-link"
- profile previous-number)))
+ (previous-generation (generation-file-name profile previous-number)))
(format #t (_ "switching from generation ~a to ~a~%")
number previous-number)
(switch-symlinks profile previous-generation)))
@@ -322,8 +325,7 @@ the given MANIFEST."
"Roll back to the previous generation of PROFILE."
(let* ((number (generation-number profile))
(previous-number (previous-generation-number profile number))
- (previous-generation (format #f "~a-~a-link"
- profile previous-number))
+ (previous-generation (generation-file-name profile previous-number))
(manifest (string-append previous-generation "/manifest")))
(cond ((not (file-exists? profile)) ; invalid profile
(leave (_ "profile '~a' does not exist~%")
@@ -341,7 +343,7 @@ the given MANIFEST."
(define (generation-time profile number)
"Return the creation time of a generation in the UTC format."
(make-time time-utc 0
- (stat:ctime (stat (format #f "~a-~a-link" profile number)))))
+ (stat:ctime (stat (generation-file-name profile number)))))
(define* (matching-generations str #:optional (profile %current-profile)
#:key (duration-relation <=))
@@ -1029,15 +1031,15 @@ more information.~%"))
(generation-number profile))
(define (display-and-delete number)
- (let ((generation (format #f "~a-~a-link" profile number)))
+ (let ((generation (generation-file-name profile number)))
(unless (zero? number)
(format #t (_ "deleting ~a~%") generation)
(delete-file generation))))
(define (delete-generation number)
(let* ((previous-number (previous-generation-number profile number))
- (previous-generation (format #f "~a-~a-link"
- profile previous-number)))
+ (previous-generation
+ (generation-file-name profile previous-number)))
(cond ((zero? number)) ; do not delete generation 0
((and (= number current-generation-number)
(not (file-exists? previous-generation)))
@@ -1128,14 +1130,14 @@ more information.~%"))
#:dry-run? dry-run?)
(or dry-run?
- (let* ((prof (derivation->output-path prof-drv))
- (number (generation-number profile))
+ (let* ((prof (derivation->output-path prof-drv))
+ (number (generation-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))))
+ (name (generation-file-name profile
+ (+ 1 number))))
(and (build-derivations (%store) (list prof-drv))
(let ((count (length entries)))
(switch-symlinks name prof)
@@ -1173,7 +1175,7 @@ more information.~%"))
(reverse
(manifest-entries
(profile-manifest
- (format #f "~a-~a-link" profile number)))))
+ (generation-file-name profile number)))))
(newline)))
(cond ((not (file-exists? profile)) ; XXX: race condition