~ruther/guix-local

b3bb82f1542ec0805b87305482829102f2faaa92 — Alex Kost 11 years ago 3ccde08
guix package: Add '--switch-generation' option.

* guix/scripts/package.scm (switch-to-generation): New procedure.
  (switch-to-previous-generation): Use it.
  (guix-package): Adjust for '--switch-generation' option.
* tests/guix-package.sh: Test it.
* doc/guix.texi (Invoking guix package): Document it.
3 files changed, 76 insertions(+), 12 deletions(-)

M doc/guix.texi
M guix/scripts/package.scm
M tests/guix-package.sh
M doc/guix.texi => doc/guix.texi +15 -0
@@ 806,6 806,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

M guix/scripts/package.scm => guix/scripts/package.scm +50 -11
@@ 46,6 46,8 @@
  #:use-module (gnu packages guile)
  #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
  #:export (specification->package+output
            switch-to-generation
            switch-to-previous-generation
            roll-back
            delete-generation
            delete-generations


@@ 96,14 98,26 @@ return PROFILE unchanged.  The goal is to treat '-p ~/.guix-profile' as if

    (switch-symlinks generation prof)))

(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-not-found-error
                              (profile profile)))))
          ((not (file-exists? generation))
           (raise (condition (&missing-generation-error
                              (profile profile)
                              (generation number)))))
          (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."
  (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)))
  (switch-to-generation profile
                        (previous-generation-number profile)))

(define (roll-back store profile)
  "Roll back to the previous generation of PROFILE."


@@ 411,6 425,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 (_ "


@@ 490,6 507,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)


@@ 715,13 736,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

M tests/guix-package.sh => tests/guix-package.sh +11 -1
@@ 87,6 87,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"


@@ 101,6 103,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


@@ 133,10 141,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