diff options
Diffstat (limited to 'build-aux')
-rw-r--r-- | build-aux/build-self.scm | 126 | ||||
-rw-r--r-- | build-aux/compile-as-derivation.scm | 5 | ||||
-rw-r--r-- | build-aux/hydra/gnu-system.scm | 3 | ||||
-rw-r--r-- | build-aux/hydra/guix-modular.scm | 1 | ||||
-rw-r--r-- | build-aux/pre-inst-env.in | 6 |
5 files changed, 96 insertions, 45 deletions
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm index bccb7a959e..3ecdc931a5 100644 --- a/build-aux/build-self.scm +++ b/build-aux/build-self.scm @@ -53,7 +53,7 @@ (define %dependency-variables ;; (guix config) variables corresponding to dependencies. - '(%libgcrypt %libz %xz %gzip %bzip2 %nix-instantiate)) + '(%libgcrypt %libz %xz %gzip %bzip2)) (define %persona-variables ;; (guix config) variables that define Guix's persona. @@ -63,17 +63,14 @@ %guix-home-page-url)) (define %config-variables - ;; (guix config) variables corresponding to Guix configuration (storedir, - ;; localstatedir, etc.) - (sort (filter pair? - (module-map (lambda (name var) - (and (not (memq name %dependency-variables)) - (not (memq name %persona-variables)) - (cons name (variable-ref var)))) - (resolve-interface '(guix config)))) - (lambda (name+value1 name+value2) - (string<? (symbol->string (car name+value1)) - (symbol->string (car name+value2)))))) + ;; (guix config) variables corresponding to Guix configuration. + (letrec-syntax ((variables (syntax-rules () + ((_) + '()) + ((_ variable rest ...) + (cons `(variable . ,variable) + (variables rest ...)))))) + (variables %localstatedir %storedir %sysconfdir %system))) (define* (make-config.scm #:key libgcrypt zlib gzip xz bzip2 (package-name "GNU Guix") @@ -91,12 +88,15 @@ %guix-version %guix-bug-report-address %guix-home-page-url + %store-directory + %state-directory + %store-database-directory + %config-directory %libgcrypt %libz %gzip %bzip2 - %xz - %nix-instantiate)) + %xz)) ;; XXX: Work around <http://bugs.gnu.org/15602>. (eval-when (expand load eval) @@ -105,6 +105,26 @@ #~(define-public #$name #$value))) %config-variables) + (define %store-directory + (or (and=> (getenv "NIX_STORE_DIR") canonicalize-path) + %storedir)) + + (define %state-directory + ;; This must match `NIX_STATE_DIR' as defined in + ;; `nix/local.mk'. + (or (getenv "NIX_STATE_DIR") + (string-append %localstatedir "/guix"))) + + (define %store-database-directory + (or (getenv "NIX_DB_DIR") + (string-append %state-directory "/db"))) + + (define %config-directory + ;; This must match `GUIX_CONFIGURATION_DIRECTORY' as + ;; defined in `nix/local.mk'. + (or (getenv "GUIX_CONFIGURATION_DIRECTORY") + (string-append %sysconfdir "/guix"))) + (define %guix-package-name #$package-name) (define %guix-version #$package-version) (define %guix-bug-report-address #$bug-report-address) @@ -122,10 +142,7 @@ (file-append libgcrypt "/lib/libgcrypt"))) (define %libz #+(and zlib - (file-append zlib "/lib/libz"))) - - (define %nix-instantiate ;for (guix import snix) - "nix-instantiate"))))) + (file-append zlib "/lib/libz"))))))) ;;; @@ -184,7 +201,8 @@ person's version identifier." (date->string (current-date 0) "~Y~m~d.~H")) (define* (build-program source version - #:optional (guile-version (effective-version))) + #:optional (guile-version (effective-version)) + #:key (pull-version 0)) "Return a program that computes the derivation to build Guix from SOURCE." (define select? ;; Select every module but (guix config) and non-Guix modules. @@ -214,11 +232,12 @@ person's version identifier." ;; (gnu packages …) modules are going to be looked up ;; under SOURCE. (guix config) is looked up in FRONT. - (match %load-path - ((#$source _ ...) - #t) ;already done - ((front _ ...) - (set! %load-path (list #$source front)))) + (match (command-line) + ((_ source _ ...) + (match %load-path + ((front _ ...) + (unless (string=? front source) ;already done? + (set! %load-path (list source front))))))) ;; Only load our own modules or those of Guile. (match %load-compiled-path @@ -246,18 +265,33 @@ person's version identifier." (loop (cdr spin)))) (match (command-line) - ((_ _ system) - (with-store store + ((_ source system version protocol-version) + ;; The current input port normally wraps a file + ;; descriptor connected to the daemon, or it is + ;; connected to /dev/null. In the former case, reuse + ;; the connection such that we inherit build options + ;; such as substitute URLs and so on; in the latter + ;; case, attempt to open a new connection. + (let* ((proto (string->number protocol-version)) + (store (if (integer? proto) + (port->connection (duplicate-port + (current-input-port) + "w+0") + #:version proto) + (open-connection)))) (call-with-new-thread (lambda () (spin system))) (display - (derivation-file-name + (and=> (run-with-store store - (guix-derivation #$source #$version - #$guile-version) - #:system system))))))) + (guix-derivation source version + #$guile-version + #:pull-version + #$pull-version) + #:system system) + derivation-file-name)))))) #:module-path (list source)))) ;; The procedure below is our return value. @@ -266,22 +300,37 @@ person's version identifier." (guile-version (match ((@ (guile) version)) ("2.2.2" "2.2.2") (_ (effective-version)))) + (pull-version 0) #:allow-other-keys #:rest rest) "Return a derivation that unpacks SOURCE into STORE and compiles Scheme files." ;; Build the build program and then use it as a trampoline to build from ;; SOURCE. - (mlet %store-monad ((build (build-program source version guile-version)) - (system (if system (return system) (current-system)))) + (mlet %store-monad ((build (build-program source version guile-version + #:pull-version pull-version)) + (system (if system (return system) (current-system))) + (port ((store-lift nix-server-socket))) + (major ((store-lift nix-server-major-version))) + (minor ((store-lift nix-server-minor-version)))) (mbegin %store-monad (show-what-to-build* (list build)) (built-derivations (list build)) - (let* ((pipe (begin - (setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive - (open-pipe* OPEN_READ - (derivation->output-path build) - source system))) + + ;; Use the port beneath the current store as the stdin of BUILD. This + ;; way, we know 'open-pipe*' will not close it on 'exec'. If PORT is + ;; not a file port (e.g., it's an SSH channel), then the subprocess's + ;; stdin will actually be /dev/null. + (let* ((pipe (with-input-from-port port + (lambda () + (setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive + (open-pipe* OPEN_READ + (derivation->output-path build) + source system version + (if (file-port? port) + (number->string + (logior major minor)) + "none"))))) (str (get-string-all pipe)) (status (close-pipe pipe))) (match str @@ -292,6 +341,9 @@ files." (return (newline (current-output-port))) ((store-lift add-temp-root) drv) (return (read-derivation-from-file drv)))) + ("#f" + ;; Unsupported PULL-VERSION. + (return #f)) ((? string? str) (error "invalid build result" (list build str)))))))) diff --git a/build-aux/compile-as-derivation.scm b/build-aux/compile-as-derivation.scm index afb134a92a..59a84b1415 100644 --- a/build-aux/compile-as-derivation.scm +++ b/build-aux/compile-as-derivation.scm @@ -25,7 +25,8 @@ (and=> (or (getenv "XDG_CONFIG_HOME") (and=> (getenv "HOME") (cut string-append <> "/.config"))) - (cut string-append <> "/guix/latest"))) + (cute string-append <> "/guix/current/share/guile/site/" + (effective-version)))) (use-modules (guix) (guix ui) (guix git-download) @@ -43,7 +44,7 @@ (mlet* %store-monad ((source (interned-file source "guix-source" #:select? git? #:recursive? #t)) - (drv (build source))) + (drv (build source #:pull-version 1))) (mbegin %store-monad (show-what-to-build* (list drv)) (built-derivations (list drv)) diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm index 654f3ecf3e..b1554ced4c 100644 --- a/build-aux/hydra/gnu-system.scm +++ b/build-aux/hydra/gnu-system.scm @@ -43,7 +43,8 @@ (and=> (assoc-ref (current-source-location) 'filename) (lambda (file) - (let ((dir (string-append (dirname file) "/../.."))) + (let ((dir (canonicalize-path + (string-append (dirname file) "/../..")))) (format (current-error-port) "prepending ~s to the load path~%" dir) (set! %load-path (cons dir %load-path)))))) diff --git a/build-aux/hydra/guix-modular.scm b/build-aux/hydra/guix-modular.scm index 58e09e1831..9ff9e090fc 100644 --- a/build-aux/hydra/guix-modular.scm +++ b/build-aux/hydra/guix-modular.scm @@ -46,6 +46,7 @@ for SYSTEM. Use VERSION as the version identifier." `((derivation . ,(derivation-file-name (run-with-store store (build source #:version version #:system system + #:pull-version 1 #:guile-version "2.2")))) ;the latest 2.2.x (description . "Modular Guix") (long-description diff --git a/build-aux/pre-inst-env.in b/build-aux/pre-inst-env.in index 14315d40d4..286a81591c 100644 --- a/build-aux/pre-inst-env.in +++ b/build-aux/pre-inst-env.in @@ -1,7 +1,7 @@ #!/bin/sh # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2012, 2013, 2014, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org> # Copyright © 2017 Eric Bavier <bavier@cray.com> # # This file is part of GNU Guix. @@ -55,10 +55,6 @@ NIX_BUILD_HOOK="$abs_top_builddir/nix/scripts/offload" @BUILD_DAEMON_OFFLOAD_FALSE@# No offloading support. @BUILD_DAEMON_OFFLOAD_FALSE@unset NIX_BUILD_HOOK -# The 'guix-register' program. -GUIX_REGISTER="$abs_top_builddir/guix-register" -export GUIX_REGISTER - # The following variables need only be defined when compiling Guix # modules, but we define them to be on the safe side in case of # auto-compilation. |