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

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.
This commit is contained in:
Ludovic Courtès 2013-10-30 22:08:35 +01:00
parent 1fcc3ba309
commit 477d30d0d8
1 changed files with 15 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
guix/scripts/package.scm
View File

@ -299,6 +299,10 @@ the given MANIFEST."
(compose string->number (cut match:substring <> 1))) (compose string->number (cut match:substring <> 1)))
0)) 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) (define (link-to-empty-profile generation)
"Link GENERATION, a string, to the empty profile." "Link GENERATION, a string, to the empty profile."
(let* ((drv (profile-derivation (%store) (manifest '()))) (let* ((drv (profile-derivation (%store) (manifest '())))
@ -312,8 +316,7 @@ the given MANIFEST."
"Atomically switch PROFILE to the previous generation." "Atomically switch PROFILE to the previous generation."
(let* ((number (generation-number profile)) (let* ((number (generation-number profile))
(previous-number (previous-generation-number profile number)) (previous-number (previous-generation-number profile number))
(previous-generation (format #f "~a-~a-link" (previous-generation (generation-file-name profile previous-number)))
profile previous-number)))
(format #t (_ "switching from generation ~a to ~a~%") (format #t (_ "switching from generation ~a to ~a~%")
number previous-number) number previous-number)
(switch-symlinks profile previous-generation))) (switch-symlinks profile previous-generation)))
@ -322,8 +325,7 @@ the given MANIFEST."
"Roll back to the previous generation of PROFILE." "Roll back to the previous generation of PROFILE."
(let* ((number (generation-number profile)) (let* ((number (generation-number profile))
(previous-number (previous-generation-number profile number)) (previous-number (previous-generation-number profile number))
(previous-generation (format #f "~a-~a-link" (previous-generation (generation-file-name profile previous-number))
profile previous-number))
(manifest (string-append previous-generation "/manifest"))) (manifest (string-append previous-generation "/manifest")))
(cond ((not (file-exists? profile)) ; invalid profile (cond ((not (file-exists? profile)) ; invalid profile
(leave (_ "profile '~a' does not exist~%") (leave (_ "profile '~a' does not exist~%")
@ -341,7 +343,7 @@ the given MANIFEST."
(define (generation-time profile number) (define (generation-time profile number)
"Return the creation time of a generation in the UTC format." "Return the creation time of a generation in the UTC format."
(make-time time-utc 0 (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) (define* (matching-generations str #:optional (profile %current-profile)
#:key (duration-relation <=)) #:key (duration-relation <=))
@ -1029,15 +1031,15 @@ more information.~%"))
(generation-number profile)) (generation-number profile))
(define (display-and-delete number) (define (display-and-delete number)
(let ((generation (format #f "~a-~a-link" profile number))) (let ((generation (generation-file-name profile number)))
(unless (zero? number) (unless (zero? number)
(format #t (_ "deleting ~a~%") generation) (format #t (_ "deleting ~a~%") generation)
(delete-file generation)))) (delete-file generation))))
(define (delete-generation number) (define (delete-generation number)
(let* ((previous-number (previous-generation-number profile number)) (let* ((previous-number (previous-generation-number profile number))
(previous-generation (format #f "~a-~a-link" (previous-generation
profile previous-number))) (generation-file-name profile previous-number)))
(cond ((zero? number)) ; do not delete generation 0 (cond ((zero? number)) ; do not delete generation 0
((and (= number current-generation-number) ((and (= number current-generation-number)
(not (file-exists? previous-generation))) (not (file-exists? previous-generation)))
@ -1134,8 +1136,8 @@ more information.~%"))
;; Always use NUMBER + 1 for the new profile, ;; Always use NUMBER + 1 for the new profile,
;; possibly overwriting a "previous future ;; possibly overwriting a "previous future
;; generation". ;; generation".
(name (format #f "~a-~a-link" (name (generation-file-name profile
profile (+ 1 number)))) (+ 1 number))))
(and (build-derivations (%store) (list prof-drv)) (and (build-derivations (%store) (list prof-drv))
(let ((count (length entries))) (let ((count (length entries)))
(switch-symlinks name prof) (switch-symlinks name prof)
@ -1173,7 +1175,7 @@ more information.~%"))
(reverse (reverse
(manifest-entries (manifest-entries
(profile-manifest (profile-manifest
(format #f "~a-~a-link" profile number))))) (generation-file-name profile number)))))
(newline))) (newline)))
(cond ((not (file-exists? profile)) ; XXX: race condition (cond ((not (file-exists? profile)) ; XXX: race condition