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:
parent
2f608c1489
commit
790c3e019a
|
@ -265,8 +265,20 @@ person's version identifier."
|
||||||
(loop (cdr spin))))
|
(loop (cdr spin))))
|
||||||
|
|
||||||
(match (command-line)
|
(match (command-line)
|
||||||
((_ source system version)
|
((_ source system version protocol-version)
|
||||||
(with-store store
|
;; 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
|
(call-with-new-thread
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(spin system)))
|
(spin system)))
|
||||||
|
@ -297,15 +309,28 @@ files."
|
||||||
;; SOURCE.
|
;; SOURCE.
|
||||||
(mlet %store-monad ((build (build-program source version guile-version
|
(mlet %store-monad ((build (build-program source version guile-version
|
||||||
#:pull-version pull-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
|
(mbegin %store-monad
|
||||||
(show-what-to-build* (list build))
|
(show-what-to-build* (list build))
|
||||||
(built-derivations (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
|
(setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive
|
||||||
(open-pipe* OPEN_READ
|
(open-pipe* OPEN_READ
|
||||||
(derivation->output-path build)
|
(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))
|
(str (get-string-all pipe))
|
||||||
(status (close-pipe pipe)))
|
(status (close-pipe pipe)))
|
||||||
(match str
|
(match str
|
||||||
|
|
Loading…
Reference in New Issue