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.'
This commit is contained in:
Ludovic Courtès 2018-06-25 18:41:01 +02:00
parent 2f608c1489
commit 790c3e019a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5

@ -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
;; 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)))
source system version
(if (file-port? port)
(number->string
(logior major minor))
"none")))))
(str (get-string-all pipe))
(status (close-pipe pipe)))
(match str