pull: Always install the ~/.config/guix/latest symlink.

Before that, if two users on the same machine ran 'guix pull', the
second one would have the "Guix already up to date" message and their
~/.config/guix/latest link would be left unchanged---effectively
preventing them from updating.

* guix/scripts/pull.scm (build-and-install): Install the 'latest'
  symlink regardless of whether TO-DO? is true or false.
master
Ludovic Courtès 2015-02-06 17:39:10 +01:00
parent 95c559c145
commit 3df5acf332
1 changed files with 17 additions and 13 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -188,22 +188,26 @@ contained therein."
(mlet* %store-monad ((source (build-from-source tarball (mlet* %store-monad ((source (build-from-source tarball
#:verbose? verbose?)) #:verbose? verbose?))
(source-dir -> (derivation->output-path source)) (source-dir -> (derivation->output-path source))
(to-do? (what-to-build (list source)))) (to-do? (what-to-build (list source)))
(if to-do? (built? (built-derivations (list source))))
(mlet* %store-monad ((built? (built-derivations (list source)))) ;; Always update the 'latest' symlink, regardless of whether SOURCE was
(if built? ;; already built or not.
(mlet* %store-monad (if built?
((latest -> (string-append config-dir "/latest")) (mlet* %store-monad
(done (indirect-root-added latest))) ((latest -> (string-append config-dir "/latest"))
(done (indirect-root-added latest)))
(if (and (file-exists? latest)
(string=? (readlink latest) source-dir))
(begin
(display (_ "Guix already up to date\n"))
(return #t))
(begin
(switch-symlinks latest source-dir) (switch-symlinks latest source-dir)
(format #t (format #t
(_ "updated ~a successfully deployed under `~a'~%") (_ "updated ~a successfully deployed under `~a'~%")
%guix-package-name latest) %guix-package-name latest)
(return #t)) (return #t))))
(leave (_ "failed to update Guix, check the build log~%")))) (leave (_ "failed to update Guix, check the build log~%")))))
(begin
(display (_ "Guix already up to date\n"))
(return #t)))))
(define (guix-pull . args) (define (guix-pull . args)
(define (parse-options) (define (parse-options)