From 5f93d97005897c2d859f0be1bdff34c88467ec61 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 16 Oct 2017 10:41:37 +0200 Subject: Add (guix self) and use it when pulling. This mitigates . * 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'. --- guix/scripts/pull.scm | 91 ++++++++++++++++++++++++++++++++------------------- 1 file changed, 57 insertions(+), 34 deletions(-) (limited to 'guix/scripts') 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 + ;; 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 -- cgit v1.2.3