summaryrefslogtreecommitdiff
path: root/guix/scripts/pull.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-10-16 10:41:37 +0200
committerLudovic Courtès <ludo@gnu.org>2017-11-21 23:09:16 +0100
commit5f93d97005897c2d859f0be1bdff34c88467ec61 (patch)
tree7300a455807b02f7dd416cbb7b33aad7bd83322e /guix/scripts/pull.scm
parentfe9b3ec3ee208c5bac7844f3d0fecce2c6b1297d (diff)
downloadguix-patches-5f93d97005897c2d859f0be1bdff34c88467ec61.tar
guix-patches-5f93d97005897c2d859f0be1bdff34c88467ec61.tar.gz
Add (guix self) and use it when pulling.
This mitigates <https://bugs.gnu.org/27284>. * guix/self.scm: New file. * Makefile.am (MODULES): Add it. * build-aux/build-self.scm (libgcrypt, zlib, gzip, bzip2, xz) (false-if-wrong-guile, package-for-current-guile, guile-json) (guile-ssh, guile-git, guile-bytestructures): Remove. (build): Rewrite to simply delegate to 'compiled-guix'. * gnu/packages.scm (%distro-root-directory): Rewrite to try different directories. * guix/discovery.scm (guix): Export 'scheme-files'. * guix/scripts/pull.scm (build-and-install): Split into... (install-latest): ... this. New procedure. And... (build-and-install): ... this, which now takes a monadic value argument. (indirect-root-added): Remove. (guix-pull): Call 'add-indirect-root'. Call 'build-from-source' and pass the result to 'build-and-install'.
Diffstat (limited to 'guix/scripts/pull.scm')
-rw-r--r--guix/scripts/pull.scm91
1 files changed, 57 insertions, 34 deletions
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 3e95bd511f..083b5c3711 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -149,8 +149,6 @@ Download and deploy the latest version of Guix.\n"))
(define what-to-build
(store-lift show-what-to-build))
-(define indirect-root-added
- (store-lift add-indirect-root))
(define %self-build-file
;; The file containing code to build Guix. This serves the same purpose as
@@ -171,33 +169,48 @@ contained therein. Use COMMIT as the version string."
;; tree.
(build source #:verbose? verbose? #:version commit)))
-(define* (build-and-install source config-dir
- #:key verbose? commit)
- "Build the tool from SOURCE, and install it in CONFIG-DIR."
- (mlet* %store-monad ((source (build-from-source source
- #:commit commit
- #:verbose? verbose?))
- (source-dir -> (derivation->output-path source))
- (to-do? (what-to-build (list source)))
- (built? (built-derivations (list source))))
- ;; Always update the 'latest' symlink, regardless of whether SOURCE was
- ;; already built or not.
- (if built?
- (mlet* %store-monad
- ((latest -> (string-append config-dir "/latest"))
- (done (indirect-root-added latest)))
- (if (and (file-exists? latest)
- (string=? (readlink latest) source-dir))
- (begin
- (display (G_ "Guix already up to date\n"))
- (return #t))
- (begin
- (switch-symlinks latest source-dir)
- (format #t
- (G_ "updated ~a successfully deployed under `~a'~%")
- %guix-package-name latest)
- (return #t))))
- (leave (G_ "failed to update Guix, check the build log~%")))))
+(define* (install-latest source-dir config-dir)
+ "Make SOURCE-DIR, a store file name, the latest Guix in CONFIG-DIR."
+ (let ((latest (string-append config-dir "/latest")))
+ (if (and (file-exists? latest)
+ (string=? (readlink latest) source-dir))
+ (begin
+ (display (G_ "Guix already up to date\n"))
+ #t)
+ (begin
+ (switch-symlinks latest source-dir)
+ (format #t
+ (G_ "updated ~a successfully deployed under `~a'~%")
+ %guix-package-name latest)
+ #t))))
+
+(define (build-and-install mdrv)
+ "Bind MDRV, a monadic value for a derivation, build it, and finally install
+it as the latest Guix."
+ (define do-it
+ ;; Weirdness follows! Before we were called, the Guix modules have
+ ;; probably been reloaded, leading to a "parallel universe" with disjoint
+ ;; record types. However, procedures in this file have already cached the
+ ;; module relative to which they lookup global bindings (see
+ ;; 'toplevel-box' documentation), so they're stuck in the old world. To
+ ;; work around that, evaluate our procedure in the context of the "new"
+ ;; (guix scripts pull) module--which has access to the new <derivation>
+ ;; record, and so on.
+ (eval '(lambda (mdrv cont)
+ ;; Reopen a connection to the daemon so that we have a record
+ ;; with the new type.
+ (with-store store
+ (run-with-store store
+ (mlet %store-monad ((drv mdrv))
+ (mbegin %store-monad
+ (what-to-build (list drv))
+ (built-derivations (list drv))
+ (return (cont (derivation->output-path drv))))))))
+ (resolve-module '(guix scripts pull)))) ;the new module
+
+ (do-it mdrv
+ (lambda (result)
+ (install-latest result (config-directory)))))
(define (honor-lets-encrypt-certificates! store)
"Tell Guile-Git to use the Let's Encrypt certificates."
@@ -258,6 +271,10 @@ certificates~%"))
(when (use-le-certs? url)
(honor-lets-encrypt-certificates! store))
+ ;; Ensure the 'latest' symlink is registered as a GC root.
+ (add-indirect-root store
+ (string-append (config-directory) "/latest"))
+
(format (current-error-port)
(G_ "Updating from Git repository at '~a'...~%")
url)
@@ -276,10 +293,16 @@ certificates~%"))
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
(canonical-package guile-2.0)))))
- (run-with-store store
- (build-and-install checkout (config-directory)
- #:commit commit
- #:verbose?
- (assoc-ref opts 'verbose?))))))))))))
+
+ ;; 'build-from-source' may cause a reload of the Guix
+ ;; modules. This leads to a parallel world: its record types
+ ;; are disjoint from those we've seen until now (because we
+ ;; use "generative" record types), and so on. Thus, special
+ ;; care must be taken once we have return from that call.
+ (build-and-install
+ (build-from-source checkout
+ #:commit commit
+ #:verbose?
+ (assoc-ref opts 'verbose?))))))))))))
;;; pull.scm ends here