diff options
| -rw-r--r-- | doc/guix.texi | 15 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 61 | ||||
| -rw-r--r-- | tests/guix-package.sh | 12 |
3 files changed, 76 insertions, 12 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 13bcd103caf..bbe84ab2759 100644 --- a/doc/guix.texi +++ b/doc/guix.texi | |||
| @@ -806,6 +806,21 @@ Installing, removing, or upgrading packages from a generation that has | |||
| 806 | been rolled back to overwrites previous future generations. Thus, the | 806 | been rolled back to overwrites previous future generations. Thus, the |
| 807 | history of a profile's generations is always linear. | 807 | history of a profile's generations is always linear. |
| 808 | 808 | ||
| 809 | @item --switch-generation=@var{pattern} | ||
| 810 | @itemx -S @var{pattern} | ||
| 811 | Switch to a particular generation defined by @var{pattern}. | ||
| 812 | |||
| 813 | @var{pattern} may be either a generation number or a number prefixed | ||
| 814 | with ``+'' or ``-''. The latter means: move forward/backward by a | ||
| 815 | specified number of generations. For example, if you want to return to | ||
| 816 | the latest generation after @code{--roll-back}, use | ||
| 817 | @code{--switch-generation=+1}. | ||
| 818 | |||
| 819 | The difference between @code{--roll-back} and | ||
| 820 | @code{--switch-generation=-1} is that @code{--switch-generation} will | ||
| 821 | not make a zeroth generation, so if a specified generation does not | ||
| 822 | exist, the current generation will not be changed. | ||
| 823 | |||
| 809 | @item --search-paths | 824 | @item --search-paths |
| 810 | @cindex search paths | 825 | @cindex search paths |
| 811 | Report environment variable definitions, in Bash syntax, that may be | 826 | Report environment variable definitions, in Bash syntax, that may be |
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index ab9d303127d..3a72053766a 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm | |||
| @@ -46,6 +46,8 @@ | |||
| 46 | #:use-module (gnu packages guile) | 46 | #:use-module (gnu packages guile) |
| 47 | #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile)) | 47 | #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile)) |
| 48 | #:export (specification->package+output | 48 | #:export (specification->package+output |
| 49 | switch-to-generation | ||
| 50 | switch-to-previous-generation | ||
| 49 | roll-back | 51 | roll-back |
| 50 | delete-generation | 52 | delete-generation |
| 51 | delete-generations | 53 | delete-generations |
| @@ -96,14 +98,26 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if | |||
| 96 | 98 | ||
| 97 | (switch-symlinks generation prof))) | 99 | (switch-symlinks generation prof))) |
| 98 | 100 | ||
| 101 | (define (switch-to-generation profile number) | ||
| 102 | "Atomically switch PROFILE to the generation NUMBER." | ||
| 103 | (let ((current (generation-number profile)) | ||
| 104 | (generation (generation-file-name profile number))) | ||
| 105 | (cond ((not (file-exists? profile)) | ||
| 106 | (raise (condition (&profile-not-found-error | ||
| 107 | (profile profile))))) | ||
| 108 | ((not (file-exists? generation)) | ||
| 109 | (raise (condition (&missing-generation-error | ||
| 110 | (profile profile) | ||
| 111 | (generation number))))) | ||
| 112 | (else | ||
| 113 | (format #t (_ "switching from generation ~a to ~a~%") | ||
| 114 | current number) | ||
| 115 | (switch-symlinks profile generation))))) | ||
| 116 | |||
| 99 | (define (switch-to-previous-generation profile) | 117 | (define (switch-to-previous-generation profile) |
| 100 | "Atomically switch PROFILE to the previous generation." | 118 | "Atomically switch PROFILE to the previous generation." |
| 101 | (let* ((number (generation-number profile)) | 119 | (switch-to-generation profile |
| 102 | (previous-number (previous-generation-number profile number)) | 120 | (previous-generation-number profile))) |
| 103 | (previous-generation (generation-file-name profile previous-number))) | ||
| 104 | (format #t (_ "switching from generation ~a to ~a~%") | ||
| 105 | number previous-number) | ||
| 106 | (switch-symlinks profile previous-generation))) | ||
| 107 | 121 | ||
| 108 | (define (roll-back store profile) | 122 | (define (roll-back store profile) |
| 109 | "Roll back to the previous generation of PROFILE." | 123 | "Roll back to the previous generation of PROFILE." |
| @@ -411,6 +425,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) | |||
| 411 | -d, --delete-generations[=PATTERN] | 425 | -d, --delete-generations[=PATTERN] |
| 412 | delete generations matching PATTERN")) | 426 | delete generations matching PATTERN")) |
| 413 | (display (_ " | 427 | (display (_ " |
| 428 | -S, --switch-generation=PATTERN | ||
| 429 | switch to a generation matching PATTERN")) | ||
| 430 | (display (_ " | ||
| 414 | -p, --profile=PROFILE use PROFILE instead of the user's default profile")) | 431 | -p, --profile=PROFILE use PROFILE instead of the user's default profile")) |
| 415 | (newline) | 432 | (newline) |
| 416 | (display (_ " | 433 | (display (_ " |
| @@ -490,6 +507,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) | |||
| 490 | (values (alist-cons 'delete-generations (or arg "") | 507 | (values (alist-cons 'delete-generations (or arg "") |
| 491 | result) | 508 | result) |
| 492 | #f))) | 509 | #f))) |
| 510 | (option '(#\S "switch-generation") #t #f | ||
| 511 | (lambda (opt name arg result arg-handler) | ||
| 512 | (values (alist-cons 'switch-generation arg result) | ||
| 513 | #f))) | ||
| 493 | (option '("search-paths") #f #f | 514 | (option '("search-paths") #f #f |
| 494 | (lambda (opt name arg result arg-handler) | 515 | (lambda (opt name arg result arg-handler) |
| 495 | (values (cons `(query search-paths) result) | 516 | (values (cons `(query search-paths) result) |
| @@ -715,13 +736,31 @@ more information.~%")) | |||
| 715 | (generation-number profile)) | 736 | (generation-number profile)) |
| 716 | 737 | ||
| 717 | ;; First roll back if asked to. | 738 | ;; First roll back if asked to. |
| 718 | (cond ((and (assoc-ref opts 'roll-back?) (not dry-run?)) | 739 | (cond ((and (assoc-ref opts 'roll-back?) |
| 719 | (begin | 740 | (not dry-run?)) |
| 720 | (roll-back (%store) profile) | 741 | (roll-back (%store) profile) |
| 721 | (process-actions (alist-delete 'roll-back? opts)))) | 742 | (process-actions (alist-delete 'roll-back? opts))) |
| 743 | ((and (assoc-ref opts 'switch-generation) | ||
| 744 | (not dry-run?)) | ||
| 745 | (for-each | ||
| 746 | (match-lambda | ||
| 747 | (('switch-generation . pattern) | ||
| 748 | (let* ((number (string->number pattern)) | ||
| 749 | (number (and number | ||
| 750 | (case (string-ref pattern 0) | ||
| 751 | ((#\+ #\-) | ||
| 752 | (relative-generation profile number)) | ||
| 753 | (else number))))) | ||
| 754 | (if number | ||
| 755 | (switch-to-generation profile number) | ||
| 756 | (leave (_ "cannot switch to generation '~a'~%") | ||
| 757 | pattern))) | ||
| 758 | (process-actions (alist-delete 'switch-generation opts))) | ||
| 759 | (_ #f)) | ||
| 760 | opts)) | ||
| 722 | ((and (assoc-ref opts 'delete-generations) | 761 | ((and (assoc-ref opts 'delete-generations) |
| 723 | (not dry-run?)) | 762 | (not dry-run?)) |
| 724 | (filter-map | 763 | (for-each |
| 725 | (match-lambda | 764 | (match-lambda |
| 726 | (('delete-generations . pattern) | 765 | (('delete-generations . pattern) |
| 727 | (cond ((not (file-exists? profile)) ; XXX: race condition | 766 | (cond ((not (file-exists? profile)) ; XXX: race condition |
diff --git a/tests/guix-package.sh b/tests/guix-package.sh index e35871f2a24..3e0e36fa23c 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh | |||
| @@ -87,6 +87,8 @@ then | |||
| 87 | # Exit with 1 when a generation does not exist. | 87 | # Exit with 1 when a generation does not exist. |
| 88 | if guix package -p "$profile" --list-generations=42; | 88 | if guix package -p "$profile" --list-generations=42; |
| 89 | then false; else true; fi | 89 | then false; else true; fi |
| 90 | if guix package -p "$profile" --switch-generation=99; | ||
| 91 | then false; else true; fi | ||
| 90 | 92 | ||
| 91 | # Remove a package. | 93 | # Remove a package. |
| 92 | guix package --bootstrap -p "$profile" -r "guile-bootstrap" | 94 | guix package --bootstrap -p "$profile" -r "guile-bootstrap" |
| @@ -101,6 +103,12 @@ then | |||
| 101 | test "`readlink_base "$profile"`" = "$profile-1-link" | 103 | test "`readlink_base "$profile"`" = "$profile-1-link" |
| 102 | test -x "$profile/bin/guile" && ! test -x "$profile/bin/make" | 104 | test -x "$profile/bin/guile" && ! test -x "$profile/bin/make" |
| 103 | 105 | ||
| 106 | # Switch to the rolled generation and switch back. | ||
| 107 | guix package -p "$profile" --switch-generation=2 | ||
| 108 | test "`readlink_base "$profile"`" = "$profile-2-link" | ||
| 109 | guix package -p "$profile" --switch-generation=-1 | ||
| 110 | test "`readlink_base "$profile"`" = "$profile-1-link" | ||
| 111 | |||
| 104 | # Move to the empty profile. | 112 | # Move to the empty profile. |
| 105 | for i in `seq 1 3` | 113 | for i in `seq 1 3` |
| 106 | do | 114 | do |
| @@ -133,10 +141,12 @@ then | |||
| 133 | grep "`guix build -e "$boot_make"`" "$profile/manifest" | 141 | grep "`guix build -e "$boot_make"`" "$profile/manifest" |
| 134 | 142 | ||
| 135 | # Make a "hole" in the list of generations, and make sure we can | 143 | # Make a "hole" in the list of generations, and make sure we can |
| 136 | # roll back "over" it. | 144 | # roll back and switch "over" it. |
| 137 | rm "$profile-1-link" | 145 | rm "$profile-1-link" |
| 138 | guix package --bootstrap -p "$profile" --roll-back | 146 | guix package --bootstrap -p "$profile" --roll-back |
| 139 | test "`readlink_base "$profile"`" = "$profile-0-link" | 147 | test "`readlink_base "$profile"`" = "$profile-0-link" |
| 148 | guix package -p "$profile" --switch-generation=+1 | ||
| 149 | test "`readlink_base "$profile"`" = "$profile-2-link" | ||
| 140 | 150 | ||
| 141 | # Make sure LIBRARY_PATH gets listed by `--search-paths'. | 151 | # Make sure LIBRARY_PATH gets listed by `--search-paths'. |
| 142 | guix package --bootstrap -p "$profile" -i guile-bootstrap -i gcc-bootstrap | 152 | guix package --bootstrap -p "$profile" -i guile-bootstrap -i gcc-bootstrap |
