[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/01: pull: Add '--list-generations'.
|
From: |
Ludovic Courtès |
|
Subject: |
01/01: pull: Add '--list-generations'. |
|
Date: |
Wed, 13 Jun 2018 17:42:04 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit e2f8be0664609223369f01290b69b44196783ab3
Author: Ludovic Courtès <address@hidden>
Date: Wed Jun 13 23:39:24 2018 +0200
pull: Add '--list-generations'.
* guix/scripts/pull.scm (show-help, %options): Add '--list-generations'.
(display-profile-content, process-query): New procedures.
(guix-pull): Honor '--list-generations'.
---
doc/guix.texi | 44 +++++++++++----
guix/scripts/pull.scm | 149 +++++++++++++++++++++++++++++++++++++-------------
2 files changed, 144 insertions(+), 49 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index e734147..4871bbc 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2756,25 +2756,40 @@ export PATH="$HOME/.config/guix/current/bin:$PATH"
export INFOPATH="$HOME/.config/guix/current/share/info:$INFOPATH"
@end example
+The @code{--list-generations} or @code{-l} option lists past generations
+produced by @command{guix pull}, along with details about their provenance:
+
address@hidden
+$ guix pull -l
+Generation 1 Jun 10 2018 00:18:18
+ guix 65956ad
+ repository URL: https://git.savannah.gnu.org/git/guix.git
+ branch: origin/master
+ commit: 65956ad3526ba09e1f7a40722c96c6ef7c0936fe
+
+Generation 2 Jun 11 2018 11:02:49
+ guix e0cc7f6
+ repository URL: https://git.savannah.gnu.org/git/guix.git
+ branch: origin/master
+ commit: e0cc7f669bec22c37481dd03a7941c7d11a64f1d
+
+Generation 3 Jun 13 2018 23:31:07 (current)
+ guix 844cc1c
+ repository URL: https://git.savannah.gnu.org/git/guix.git
+ branch: origin/master
+ commit: 844cc1c8f394f03b404c5bb3aee086922373490c
address@hidden example
+
This @code{~/.config/guix/current} profile works like any other profile
created by @command{guix package} (@pxref{Invoking guix package}). That
is, you can list generations, roll back to the previous
generation---i.e., the previous Guix---and so on:
@example
-$ guix package -p ~/.config/guix/current -l
-Generation 1 May 25 2018 10:06:41
- guix 221951a out
/gnu/store/i4dfk7vw5k112s49jrhl6hwsfnh6wr7l-guix-221951af4
-
-Generation 2 May 27 2018 19:07:47
- + guix 2fbae00 out
/gnu/store/44cv9hyvxg34xf5kblf5dz57hc52y4bm-guix-2fbae006f
- - guix 221951a out
/gnu/store/i4dfk7vw5k112s49jrhl6hwsfnh6wr7l-guix-221951af4
-
-Generation 3 May 30 2018 16:11:39 (current)
- + guix a076f19 out
/gnu/store/332czkicwwg6lc3x4aqbw5q2mq12s7fj-guix-a076f1990
- - guix 2fbae00 out
/gnu/store/44cv9hyvxg34xf5kblf5dz57hc52y4bm-guix-2fbae006f
$ guix package -p ~/.config/guix/current --roll-back
switched from generation 3 to 2
+$ guix package -p ~/.config/guix/current --delete-generations=1
+deleting /home/charlie/.config/guix/current-1-link
@end example
The @command{guix pull} command is usually invoked with no arguments,
@@ -2800,6 +2815,13 @@ string.
Deploy the tip of @var{branch}, the name of a Git branch available on
the repository at @var{url}.
address@hidden address@hidden
address@hidden -l address@hidden
+List all the generations of @file{~/.config/guix/current} or, if @var{pattern}
+is provided, the subset of generations that match @var{pattern}.
+The syntax of @var{pattern} is the same as with @code{guix package
+--list-generations} (@pxref{Invoking guix package}).
+
@item --bootstrap
Use the bootstrap Guile to build the latest Guix. This option is only
useful to Guix developers.
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 499de0e..7202e3c 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -45,6 +45,7 @@
#:use-module ((gnu packages certs) #:select (le-certs))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:export (guix-pull))
@@ -110,6 +111,9 @@ Download and deploy the latest version of Guix.\n"))
(display (G_ "
--branch=BRANCH download the tip of the specified BRANCH"))
(display (G_ "
+ -l, --list-generations[=PATTERN]
+ list generations matching PATTERN"))
+ (display (G_ "
--bootstrap use the bootstrap Guile to build the new Guix"))
(newline)
(show-build-options-help)
@@ -125,6 +129,10 @@ Download and deploy the latest version of Guix.\n"))
(cons* (option '("verbose") #f #f
(lambda (opt name arg result)
(alist-cons 'verbose? #t result)))
+ (option '(#\l "list-generations") #f #t
+ (lambda (opt name arg result)
+ (cons `(query list-generations ,(or arg ""))
+ result)))
(option '("url") #t #f
(lambda (opt name arg result)
(alist-cons 'repository-url arg
@@ -274,6 +282,66 @@ certificates~%"))
(report-git-error err))))
+;;;
+;;; Queries.
+;;;
+
+(define (display-profile-content profile number)
+ "Display the packages in PROFILE, generation NUMBER, in a human-readable
+way and displaying details about the channel's source code."
+ (for-each (lambda (entry)
+ (format #t " ~a ~a~%"
+ (manifest-entry-name entry)
+ (manifest-entry-version entry))
+ (match (assq 'source (manifest-entry-properties entry))
+ (('source ('repository ('version 0)
+ ('url url)
+ ('branch branch)
+ ('commit commit)
+ _ ...))
+ (format #t (G_ " repository URL: ~a~%") url)
+ (when branch
+ (format #t (G_ " branch: ~a~%") branch))
+ (format #t (G_ " commit: ~a~%") commit))
+ (_ #f)))
+
+ ;; Show most recently installed packages last.
+ (reverse
+ (manifest-entries
+ (profile-manifest (generation-file-name profile number))))))
+
+(define (process-query opts)
+ "Process any query specified by OPTS."
+ (define profile
+ (string-append (config-directory) "/current"))
+
+ (match (assoc-ref opts 'query)
+ (('list-generations pattern)
+ (define (list-generation display-function number)
+ (unless (zero? number)
+ (display-generation profile number)
+ (display-function profile number)
+ (newline)))
+
+ (leave-on-EPIPE
+ (cond ((not (file-exists? profile)) ; XXX: race condition
+ (raise (condition (&profile-not-found-error
+ (profile profile)))))
+ ((string-null? pattern)
+ (for-each (lambda (generation)
+ (list-generation display-profile-content generation))
+ (profile-generations profile)))
+ ((matching-generations pattern profile)
+ =>
+ (match-lambda
+ (()
+ (exit 1))
+ ((numbers ...)
+ (for-each (lambda (generation)
+ (list-generation display-profile-content
generation))
+ numbers)))))))))
+
+
(define (guix-pull . args)
(define (use-le-certs? url)
(string-prefix? "https://git.savannah.gnu.org/"; url))
@@ -287,43 +355,48 @@ certificates~%"))
(cache (string-append (cache-directory) "/pull")))
(ensure-guile-git!)
- (unless (assoc-ref opts 'dry-run?) ;XXX: not very useful
- (with-store store
- (parameterize ((%graft? (assoc-ref opts 'graft?)))
- (set-build-options-from-command-line store opts)
-
- ;; For reproducibility, always refer to the LE certificates when
we
- ;; know we're talking to Savannah.
- (when (use-le-certs? url)
- (honor-lets-encrypt-certificates! store))
-
- (format (current-error-port)
- (G_ "Updating from Git repository at '~a'...~%")
- url)
-
- (let-values (((checkout commit)
- (latest-repository-commit store url
- #:ref ref
- #:cache-directory cache)))
-
- (format (current-error-port)
- (G_ "Building from Git commit ~a...~%")
- commit)
- (parameterize ((%guile-for-build
- (package-derivation
- store
- (if (assoc-ref opts 'bootstrap?)
- %bootstrap-guile
- (canonical-package guile-2.2)))))
- (run-with-store store
- (build-and-install checkout (config-directory)
- #:url url
- #:branch (match ref
- (('branch . branch)
- branch)
- (_ #f))
- #:commit commit
- #:verbose?
- (assoc-ref opts 'verbose?))))))))))))
+ (cond ((assoc-ref opts 'query)
+ (process-query opts))
+ ((assoc-ref opts 'dry-run?)
+ #t) ;XXX: not very useful
+ (else
+ (with-store store
+ (parameterize ((%graft? (assoc-ref opts 'graft?)))
+ (set-build-options-from-command-line store opts)
+
+ ;; For reproducibility, always refer to the LE certificates
+ ;; when we know we're talking to Savannah.
+ (when (use-le-certs? url)
+ (honor-lets-encrypt-certificates! store))
+
+ (format (current-error-port)
+ (G_ "Updating from Git repository at '~a'...~%")
+ url)
+
+ (let-values (((checkout commit)
+ (latest-repository-commit store url
+ #:ref ref
+ #:cache-directory
+ cache)))
+
+ (format (current-error-port)
+ (G_ "Building from Git commit ~a...~%")
+ commit)
+ (parameterize ((%guile-for-build
+ (package-derivation
+ store
+ (if (assoc-ref opts 'bootstrap?)
+ %bootstrap-guile
+ (canonical-package guile-2.2)))))
+ (run-with-store store
+ (build-and-install checkout (config-directory)
+ #:url url
+ #:branch (match ref
+ (('branch . branch)
+ branch)
+ (_ #f))
+ #:commit commit
+ #:verbose?
+ (assoc-ref opts
'verbose?)))))))))))))
;;; pull.scm ends here