From mboxrd@z Thu Jan 1 00:00:00 1970 From: Alex Kost Subject: Re: [PATCH] guix package: Add '--switch-generation' option. Date: Wed, 08 Oct 2014 01:32:58 +0400 Message-ID: <87lhorin05.fsf@gmail.com> References: <87k3719v7p.fsf@gmail.com> <87a97taixl.fsf@gmail.com> <87sil2rbly.fsf@gnu.org> <87tx5idn7f.fsf_-_@gmail.com> <87egwlkcy1.fsf@gnu.org> <87ppg5el2i.fsf@gmail.com> <87d2c5h4if.fsf@gnu.org> <87lhqsev1d.fsf@gmail.com> <877g2c74xh.fsf@gnu.org> <87ha1gds3w.fsf@gmail.com> <8761hsmxkl.fsf@gnu.org> <87zjf4d1mh.fsf@gmail.com> <87mwb0b3fq.fsf@gnu.org> <87ha17ctyv.fsf_-_@gmail.com> <87ppfs6gxk.fsf@gnu.org> <87wq8fk979.fsf_-_@gmail.com> <87eguninyx.fsf@gnu.org> <8738b1jndu.fsf_-_@gmail.com> <87ppe5vw1b.fsf@gnu.org> <87y4ssi4ak.fsf@gmail.com> <87h9zfc1ko.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:56850) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XbcNX-00015O-VA for guix-devel@gnu.org; Tue, 07 Oct 2014 17:33:14 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XbcNR-0007Na-1H for guix-devel@gnu.org; Tue, 07 Oct 2014 17:33:07 -0400 In-Reply-To: <87h9zfc1ko.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Tue, 07 Oct 2014 18:00:07 +0200") List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: Ludovic =?utf-8?Q?Court=C3=A8s?= Cc: guix-devel@gnu.org --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Ludovic Court=C3=A8s (2014-10-07 20:00 +0400) wrote: > Alex Kost skribis: > > [...] > >> +(define (switch-to-generation profile number) >> + "Atomically switch PROFILE to the generation NUMBER." >> + (let ((current (generation-number profile)) >> + (file (generation-file-name profile number))) >> + (cond ((not (file-exists? profile)) >> + (format (current-error-port) >> + (_ "profile '~a' does not exist~%") >> + profile)) >> + ((not (file-exists? file)) >> + (format (current-error-port) >> + (_ "generation ~a does not exist~%") >> + number)) >> + (else >> + (format #t (_ "switching from generation ~a to ~a~%") >> + current number) >> + (switch-symlinks profile file))))) > > Could this procedure raise an exception instead of writing messages? > The reason is that I=E2=80=99d like UI code to remain in (guix scripts pa= ckage), > in the Emacs code, and in guix-web, with (guix profiles) remaining > generic. I see, thanks for the explanation. > It=E2=80=99d be enough for me to just call =E2=80=98switch-symlinks=E2=80= =99 and let it throw > =E2=80=98system-error=E2=80=99 if something=E2=80=99s wrong. The excepti= on will be caught, the > user will see a =E2=80=9CNo such file=E2=80=9D error, and =E2=80=98guix p= ackage=E2=80=99 with exit with > non-zero (this is done by =E2=80=98call-with-error-handling=E2=80=99.) =E2=80=98switch-symlinks=E2=80=99 does not throw an error even if files don= 't exist, so=E2=80=A6 > It=E2=80=99s less informative than what you did, though. The other optio= n would > be to define specific error condition types and throw them from here. > > WDYT? =E2=80=A6 I tried to make it this way, thank you for pointing. I made anot= her commit for adding and using condition types (3 patches are attached now). Also I moved =E2=80=98process-query=E2=80=99 inside =E2=80=98with-error-han= dling=E2=80=99 (because I used =E2=80=98raise=E2=80=99 there). Could there be unwanted consequences = after that? > My apologies for being sloppy and not catching it earlier! No problem at all. I hope you catch something now if it is there. > > [...] > >> + (('switch-generation . pattern) >> + (let* ((number (string->number pattern)) >> + (number (and number >> + (case (string-ref pattern 0) >> + ((#\+ #\-) >> + (relative-generation profile numb= er)) >> + (else number))))) >> + (if number >> + (switch-to-generation profile number) >> + (format (current-error-port) >> + "Cannot switch to generation '~a'~%" patte= rn))) > > Use =E2=80=98leave=E2=80=99 instead of =E2=80=98format=E2=80=99 here, wit= h lower-case =E2=80=9Ccannot=E2=80=9D. Done. --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-profiles-Add-condition-types-for-profile-and-generat.patch >From d5e9abb0395a21e79d4f77181597103d4daf138c Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Wed, 8 Oct 2014 00:32:28 +0400 Subject: [PATCH 1/3] profiles: Add condition types for profile and generation. * guix/profiles.scm (&profile-error, &generation-error): New condition types. * guix/ui.scm (call-with-error-handling): Handle these types. * guix/scripts/package.scm (roll-back, guix-package): Raise '&profile-error' where needed. --- guix/profiles.scm | 24 +++++++++++++++++++++++- guix/scripts/package.scm | 15 +++++++-------- guix/ui.scm | 7 +++++++ 3 files changed, 37 insertions(+), 9 deletions(-) diff --git a/guix/profiles.scm b/guix/profiles.scm index 18733a6..0e19d7a 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -35,7 +35,16 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) - #:export (manifest make-manifest + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:export (&profile-error + profile-error? + profile-error-profile + &generation-error + generation-error? + generation-error-generation + + manifest make-manifest manifest? manifest-entries @@ -84,6 +93,19 @@ ;;; +;;; Condition types. +;;; + +(define-condition-type &profile-error &error + profile-error? + (profile profile-error-profile)) + +(define-condition-type &generation-error &error + generation-error? + (generation generation-error-generation)) + + +;;; ;;; Manifests. ;;; diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index fc9c37b..7e2143c 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -38,6 +38,8 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) #:use-module (gnu packages) #:use-module (gnu packages base) @@ -109,8 +111,7 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if (previous-number (previous-generation-number profile number)) (previous-generation (generation-file-name profile previous-number))) (cond ((not (file-exists? profile)) ; invalid profile - (leave (_ "profile '~a' does not exist~%") - profile)) + (raise (condition (&profile-error (profile profile))))) ((zero? number) ; empty profile (format (current-error-port) (_ "nothing to do: already at the empty profile~%"))) @@ -723,8 +724,7 @@ more information.~%")) (match-lambda (('delete-generations . pattern) (cond ((not (file-exists? profile)) ; XXX: race condition - (leave (_ "profile '~a' does not exist~%") - profile)) + (raise (condition (&profile-error (profile profile))))) ((string-null? pattern) (delete-generations (%store) profile @@ -833,8 +833,7 @@ more information.~%")) (newline))) (cond ((not (file-exists? profile)) ; XXX: race condition - (leave (_ "profile '~a' does not exist~%") - profile)) + (raise (condition (&profile-error (profile profile))))) ((string-null? pattern) (for-each list-generation (profile-generations profile))) ((matching-generations pattern profile) @@ -915,8 +914,8 @@ more information.~%")) (_ #f)))) (let ((opts (parse-options))) - (or (process-query opts) - (with-error-handling + (with-error-handling + (or (process-query opts) (parameterize ((%store (open-connection))) (set-build-options-from-command-line (%store) opts) diff --git a/guix/ui.scm b/guix/ui.scm index 04345d4..9c0a5d2 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -23,6 +23,7 @@ #:use-module (guix store) #:use-module (guix config) #:use-module (guix packages) + #:use-module (guix profiles) #:use-module (guix build-system) #:use-module (guix derivations) #:use-module ((guix build utils) #:select (mkdir-p)) @@ -229,6 +230,12 @@ interpreted." (location->string loc) (package-full-name package) (build-system-name system)))) + ((profile-error? c) + (leave (_ "profile '~a' does not exist~%") + (profile-error-profile c))) + ((generation-error? c) + (leave (_ "generation '~a' does not exist~%") + (generation-error-generation c))) ((nix-connection-error? c) (leave (_ "failed to connect to `~a': ~a~%") (nix-connection-error-file c) -- 2.1.2 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-profiles-Add-procedures-for-switching-generations.patch >From e47644b43aaa73885ca648118b6fc59fdb499303 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Wed, 8 Oct 2014 00:39:42 +0400 Subject: [PATCH 2/3] profiles: Add procedures for switching generations. * guix/scripts/package.scm (switch-to-previous-generation): Move to... * guix/profiles.scm: ... here. Use 'switch-to-generation'. (relative-generation): New procedure. (previous-generation-number): Use it. (switch-to-generation): New procedure. --- guix/profiles.scm | 49 ++++++++++++++++++++++++++++++++++++++++-------- guix/scripts/package.scm | 9 --------- 2 files changed, 41 insertions(+), 17 deletions(-) diff --git a/guix/profiles.scm b/guix/profiles.scm index 0e19d7a..d064351 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -80,9 +80,12 @@ generation-number generation-numbers profile-generations + relative-generation previous-generation-number generation-time - generation-file-name)) + generation-file-name + switch-to-generation + switch-to-previous-generation)) ;;; Commentary: ;;; @@ -591,16 +594,28 @@ former profiles were found." '() generations))) -(define (previous-generation-number profile number) +(define* (relative-generation profile shift #:optional + (current (generation-number profile))) + "Return PROFILE's generation shifted from the CURRENT generation by SHIFT. +SHIFT is a positive or negative number. +Return #f if there is no such generation." + (let* ((abs-shift (abs shift)) + (numbers (profile-generations profile)) + (from-current (memq current + (if (negative? shift) + (reverse numbers) + numbers)))) + (and from-current + (< abs-shift (length from-current)) + (list-ref from-current abs-shift)))) + +(define* (previous-generation-number profile #:optional + (number (generation-number profile))) "Return the number of the generation before generation NUMBER of PROFILE, or 0 if none exists. It could be NUMBER - 1, but it's not the case when generations have been deleted (there are \"holes\")." - (fold (lambda (candidate highest) - (if (and (< candidate number) (> candidate highest)) - candidate - highest)) - 0 - (generation-numbers profile))) + (or (relative-generation profile -1 number) + 0)) (define (generation-file-name profile generation) "Return the file name for PROFILE's GENERATION." @@ -611,4 +626,22 @@ case when generations have been deleted (there are \"holes\")." (make-time time-utc 0 (stat:ctime (stat (generation-file-name profile number))))) +(define (switch-to-generation profile number) + "Atomically switch PROFILE to the generation NUMBER." + (let ((current (generation-number profile)) + (generation (generation-file-name profile number))) + (cond ((not (file-exists? profile)) + (raise (condition (&profile-error (profile profile))))) + ((not (file-exists? generation)) + (raise (condition (&generation-error (generation generation))))) + (else + (format #t (_ "switching from generation ~a to ~a~%") + current number) + (switch-symlinks profile generation))))) + +(define (switch-to-previous-generation profile) + "Atomically switch PROFILE to the previous generation." + (switch-to-generation profile + (previous-generation-number profile))) + ;;; profiles.scm ends here diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 7e2143c..df8a7f2 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -96,15 +96,6 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if (switch-symlinks generation prof))) -(define (switch-to-previous-generation profile) - "Atomically switch PROFILE to the previous generation." - (let* ((number (generation-number profile)) - (previous-number (previous-generation-number profile number)) - (previous-generation (generation-file-name profile previous-number))) - (format #t (_ "switching from generation ~a to ~a~%") - number previous-number) - (switch-symlinks profile previous-generation))) - (define (roll-back store profile) "Roll back to the previous generation of PROFILE." (let* ((number (generation-number profile)) -- 2.1.2 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0003-guix-package-Add-switch-generation-option.patch >From 003e5c192796e8ea07491a94a85824a533155825 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Wed, 8 Oct 2014 00:45:38 +0400 Subject: [PATCH 3/3] guix package: Add '--switch-generation' option. * guix/scripts/package.scm: Add '--switch-generation' option. (guix-package): Adjust accordingly. * tests/guix-package.sh: Test it. * doc/guix.texi (Invoking guix package): Document it. --- doc/guix.texi | 15 +++++++++++++++ guix/scripts/package.scm | 35 ++++++++++++++++++++++++++++++----- tests/guix-package.sh | 12 +++++++++++- 3 files changed, 56 insertions(+), 6 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index f6357bd..c6921b1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -784,6 +784,21 @@ Installing, removing, or upgrading packages from a generation that has been rolled back to overwrites previous future generations. Thus, the history of a profile's generations is always linear. +@item --switch-generation=@var{pattern} +@itemx -S @var{pattern} +Switch to a particular generation defined by @var{pattern}. + +@var{pattern} may be either a generation number or a number prefixed +with ``+'' or ``-''. The latter means: move forward/backward by a +specified number of generations. For example, if you want to return to +the latest generation after @code{--roll-back}, use +@code{--switch-generation=+1}. + +The difference between @code{--roll-back} and +@code{--switch-generation=-1} is that @code{--switch-generation} will +not make a zeroth generation, so if a specified generation does not +exist, the current generation will not be changed. + @item --search-paths @cindex search paths Report environment variable definitions, in Bash syntax, that may be diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index df8a7f2..0278f62 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -401,6 +401,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) -d, --delete-generations[=PATTERN] delete generations matching PATTERN")) (display (_ " + -S, --switch-generation=PATTERN + switch to a generation matching PATTERN")) + (display (_ " -p, --profile=PROFILE use PROFILE instead of the user's default profile")) (newline) (display (_ " @@ -480,6 +483,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (values (alist-cons 'delete-generations (or arg "") result) #f))) + (option '(#\S "switch-generation") #t #f + (lambda (opt name arg result arg-handler) + (values (alist-cons 'switch-generation arg result) + #f))) (option '("search-paths") #f #f (lambda (opt name arg result arg-handler) (values (cons `(query search-paths) result) @@ -705,13 +712,31 @@ more information.~%")) (generation-number profile)) ;; First roll back if asked to. - (cond ((and (assoc-ref opts 'roll-back?) (not dry-run?)) - (begin - (roll-back (%store) profile) - (process-actions (alist-delete 'roll-back? opts)))) + (cond ((and (assoc-ref opts 'roll-back?) + (not dry-run?)) + (roll-back (%store) profile) + (process-actions (alist-delete 'roll-back? opts))) + ((and (assoc-ref opts 'switch-generation) + (not dry-run?)) + (for-each + (match-lambda + (('switch-generation . pattern) + (let* ((number (string->number pattern)) + (number (and number + (case (string-ref pattern 0) + ((#\+ #\-) + (relative-generation profile number)) + (else number))))) + (if number + (switch-to-generation profile number) + (leave (_ "cannot switch to generation '~a'~%") + pattern))) + (process-actions (alist-delete 'switch-generation opts))) + (_ #f)) + opts)) ((and (assoc-ref opts 'delete-generations) (not dry-run?)) - (filter-map + (for-each (match-lambda (('delete-generations . pattern) (cond ((not (file-exists? profile)) ; XXX: race condition diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 9b0e75e..c01e914 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -86,6 +86,8 @@ then # Exit with 1 when a generation does not exist. if guix package -p "$profile" --list-generations=42; then false; else true; fi + if guix package -p "$profile" --switch-generation=99; + then false; else true; fi # Remove a package. guix package --bootstrap -p "$profile" -r "guile-bootstrap" @@ -100,6 +102,12 @@ then test "`readlink_base "$profile"`" = "$profile-1-link" test -x "$profile/bin/guile" && ! test -x "$profile/bin/make" + # Switch to the rolled generation and switch back. + guix package -p "$profile" --switch-generation=2 + test "`readlink_base "$profile"`" = "$profile-2-link" + guix package -p "$profile" --switch-generation=-1 + test "`readlink_base "$profile"`" = "$profile-1-link" + # Move to the empty profile. for i in `seq 1 3` do @@ -132,10 +140,12 @@ then grep "`guix build -e "$boot_make"`" "$profile/manifest" # Make a "hole" in the list of generations, and make sure we can - # roll back "over" it. + # roll back and switch "over" it. rm "$profile-1-link" guix package --bootstrap -p "$profile" --roll-back test "`readlink_base "$profile"`" = "$profile-0-link" + guix package -p "$profile" --switch-generation=+1 + test "`readlink_base "$profile"`" = "$profile-2-link" # Make sure LIBRARY_PATH gets listed by `--search-paths'. guix package --bootstrap -p "$profile" -i guile-bootstrap -i gcc-bootstrap -- 2.1.2 --=-=-=--