diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-10-16 10:41:37 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-11-21 23:09:16 +0100 |
commit | 5f93d97005897c2d859f0be1bdff34c88467ec61 (patch) | |
tree | 7300a455807b02f7dd416cbb7b33aad7bd83322e /guix/scripts | |
parent | fe9b3ec3ee208c5bac7844f3d0fecce2c6b1297d (diff) | |
download | gnu-guix-5f93d97005897c2d859f0be1bdff34c88467ec61.tar gnu-guix-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')
-rw-r--r-- | guix/scripts/pull.scm | 91 |
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 |