aboutsummaryrefslogtreecommitdiff
path: root/build-aux/build-self.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-06-25 18:41:01 +0200
committerLudovic Courtès <ludo@gnu.org>2018-06-26 14:27:57 +0200
commit790c3e019a5410018bd31596c2dcda5d0efb0d36 (patch)
tree5eb5871c662d196ac6f74efa7cc86549cf04222a /build-aux/build-self.scm
parent2f608c14893a025b471bcd993096f92331a45a12 (diff)
downloadguix-790c3e019a5410018bd31596c2dcda5d0efb0d36.tar
guix-790c3e019a5410018bd31596c2dcda5d0efb0d36.tar.gz
build-self: Inherit the daemon connection from the parent process.
Fixes <https://bugs.gnu.org/31892>. Reported by Vagrant Cascadian <vagrant@debian.org>. * build-aux/build-self.scm (build): Define 'port' and wrap 'open-pipe*' call in 'with-input-from-port'. (build-program): Use 'port->connection' or 'open-connection' instead of 'with-store.'
Diffstat (limited to 'build-aux/build-self.scm')
-rw-r--r--build-aux/build-self.scm41
1 files changed, 33 insertions, 8 deletions
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index e1b2c7fdc4..3ecdc931a5 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
@@ -265,8 +265,20 @@ person's version identifier."
(loop (cdr spin))))
(match (command-line)
- ((_ source system version)
- (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)))
@@ -297,15 +309,28 @@ files."
;; SOURCE.
(mlet %store-monad ((build (build-program source version guile-version
#:pull-version pull-version))
- (system (if system (return system) (current-system))))
+ (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 version)))
+
+ ;; 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