guix package: Export generation procedures.
* guix/scripts/package.scm: Export 'roll-back', 'delete-generation', 'delete-generations'. (link-to-empty-profile, roll-back): Add 'store' argument. (delete-generations): New procedure. (guix-package): Adjust accordingly. [delete-generation]: Move to the top level. Add 'store' and 'profile' arguments. [display-and-delete]: Move to 'delete-generation'.master
parent
881c3f0163
commit
b72a312c30
|
@ -2,6 +2,7 @@
|
||||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||||
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
|
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
|
||||||
|
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -43,6 +44,9 @@
|
||||||
#:use-module (gnu packages guile)
|
#:use-module (gnu packages guile)
|
||||||
#:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
|
#:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
|
||||||
#:export (specification->package+output
|
#:export (specification->package+output
|
||||||
|
roll-back
|
||||||
|
delete-generation
|
||||||
|
delete-generations
|
||||||
guix-package))
|
guix-package))
|
||||||
|
|
||||||
(define %store
|
(define %store
|
||||||
|
@ -80,12 +84,12 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if
|
||||||
%current-profile
|
%current-profile
|
||||||
profile))
|
profile))
|
||||||
|
|
||||||
(define (link-to-empty-profile generation)
|
(define (link-to-empty-profile store generation)
|
||||||
"Link GENERATION, a string, to the empty profile."
|
"Link GENERATION, a string, to the empty profile."
|
||||||
(let* ((drv (run-with-store (%store)
|
(let* ((drv (run-with-store store
|
||||||
(profile-derivation (manifest '()))))
|
(profile-derivation (manifest '()))))
|
||||||
(prof (derivation->output-path drv "out")))
|
(prof (derivation->output-path drv "out")))
|
||||||
(when (not (build-derivations (%store) (list drv)))
|
(when (not (build-derivations store (list drv)))
|
||||||
(leave (_ "failed to build the empty profile~%")))
|
(leave (_ "failed to build the empty profile~%")))
|
||||||
|
|
||||||
(switch-symlinks generation prof)))
|
(switch-symlinks generation prof)))
|
||||||
|
@ -99,7 +103,7 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if
|
||||||
number previous-number)
|
number previous-number)
|
||||||
(switch-symlinks profile previous-generation)))
|
(switch-symlinks profile previous-generation)))
|
||||||
|
|
||||||
(define (roll-back profile)
|
(define (roll-back store profile)
|
||||||
"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))
|
||||||
|
@ -112,11 +116,39 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if
|
||||||
(_ "nothing to do: already at the empty profile~%")))
|
(_ "nothing to do: already at the empty profile~%")))
|
||||||
((or (zero? previous-number) ; going to emptiness
|
((or (zero? previous-number) ; going to emptiness
|
||||||
(not (file-exists? previous-generation)))
|
(not (file-exists? previous-generation)))
|
||||||
(link-to-empty-profile previous-generation)
|
(link-to-empty-profile store previous-generation)
|
||||||
(switch-to-previous-generation profile))
|
(switch-to-previous-generation profile))
|
||||||
(else
|
(else
|
||||||
(switch-to-previous-generation profile))))) ; anything 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 <>)
|
||||||
|
generations))
|
||||||
|
|
||||||
(define* (matching-generations str #:optional (profile %current-profile)
|
(define* (matching-generations str #:optional (profile %current-profile)
|
||||||
#:key (duration-relation <=))
|
#:key (duration-relation <=))
|
||||||
"Return the list of available generations matching a pattern in STR. See
|
"Return the list of available generations matching a pattern in STR. See
|
||||||
|
@ -680,32 +712,10 @@ more information.~%"))
|
||||||
(define current-generation-number
|
(define current-generation-number
|
||||||
(generation-number profile))
|
(generation-number profile))
|
||||||
|
|
||||||
(define (display-and-delete 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
|
|
||||||
(generation-file-name profile previous-number)))
|
|
||||||
(cond ((zero? number)) ; do not delete generation 0
|
|
||||||
((and (= number current-generation-number)
|
|
||||||
(not (file-exists? previous-generation)))
|
|
||||||
(link-to-empty-profile previous-generation)
|
|
||||||
(switch-to-previous-generation profile)
|
|
||||||
(display-and-delete number))
|
|
||||||
((= number current-generation-number)
|
|
||||||
(roll-back profile)
|
|
||||||
(display-and-delete number))
|
|
||||||
(else
|
|
||||||
(display-and-delete number)))))
|
|
||||||
|
|
||||||
;; First roll back if asked to.
|
;; First roll back if asked to.
|
||||||
(cond ((and (assoc-ref opts 'roll-back?) (not dry-run?))
|
(cond ((and (assoc-ref opts 'roll-back?) (not dry-run?))
|
||||||
(begin
|
(begin
|
||||||
(roll-back profile)
|
(roll-back (%store) profile)
|
||||||
(process-actions (alist-delete 'roll-back? opts))))
|
(process-actions (alist-delete 'roll-back? opts))))
|
||||||
((and (assoc-ref opts 'delete-generations)
|
((and (assoc-ref opts 'delete-generations)
|
||||||
(not dry-run?))
|
(not dry-run?))
|
||||||
|
@ -716,7 +726,8 @@ more information.~%"))
|
||||||
(leave (_ "profile '~a' does not exist~%")
|
(leave (_ "profile '~a' does not exist~%")
|
||||||
profile))
|
profile))
|
||||||
((string-null? pattern)
|
((string-null? pattern)
|
||||||
(for-each display-and-delete
|
(delete-generations
|
||||||
|
(%store) profile
|
||||||
(delete current-generation-number
|
(delete current-generation-number
|
||||||
(profile-generations profile))))
|
(profile-generations profile))))
|
||||||
;; Do not delete the zeroth generation.
|
;; Do not delete the zeroth generation.
|
||||||
|
@ -731,7 +742,7 @@ more information.~%"))
|
||||||
(lambda (numbers)
|
(lambda (numbers)
|
||||||
(if (null-list? numbers)
|
(if (null-list? numbers)
|
||||||
(exit 1)
|
(exit 1)
|
||||||
(for-each delete-generation numbers))))
|
(delete-generations (%store) profile numbers))))
|
||||||
(else
|
(else
|
||||||
(leave (_ "invalid syntax: ~a~%")
|
(leave (_ "invalid syntax: ~a~%")
|
||||||
pattern)))
|
pattern)))
|
||||||
|
|
Reference in New Issue