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

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'.
master
Ludovic Courtès 2018-06-13 23:39:24 +02:00
parent 844cc1c8f3
commit e2f8be0664
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 140 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
doc/guix.texi
View File

@ -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.

141
guix/scripts/pull.scm
View File

@ -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