diff options
| -rw-r--r-- | doc/guix.texi | 44 | ||||
| -rw-r--r-- | guix/scripts/pull.scm | 149 |
2 files changed, 144 insertions, 49 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index e734147681..4871bbcfe4 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: + +@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. diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 499de0ec45..7202e3cc16 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 |