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'.
This commit is contained in:
Ludovic Courtès
parent
844cc1c8f3
commit
e2f8be0664
@ -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:
|
||||
|
||||
@example
|
||||
$ 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
|
||||
@end 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}.
|
||||
|
||||
@item --list-generations[=@var{pattern}]
|
||||
@itemx -l [@var{pattern}]
|
||||
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.
|
||||
|
||||
@ -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))
|
||||
@ -109,6 +110,9 @@ Download and deploy the latest version of Guix.\n"))
|
||||
--commit=COMMIT download the specified COMMIT"))
|
||||
(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)
|
||||
@ -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
|
||||
@ -273,6 +281,66 @@ certificates~%"))
|
||||
(lambda (key err)
|
||||
(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)
|
||||
@ -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)
|
||||
(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))
|
||||
;; 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)
|
||||
(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)))
|
||||
(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?))))))))))))
|
||||
(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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user