inferior: Keep the store bridge connected.

Previously, each 'inferior-eval-with-store' would lead the inferior to
connect to the named socket the parent is listening to.  With this
change, the connection is established once for all and reused
afterwards.

* guix/inferior.scm (<inferior>)[bridge-file-name]: Remove.
(open-bidirectional-pipe): New procedure.
(inferior-pipe): Use it instead of 'open-pipe*' and return two values.
(port->inferior): Adjust call to 'inferior'.
(open-inferior): Adjust to 'inferior-pipe' changes.
(close-inferior): Remove 'inferior-bridge-file-name' handling.
(open-store-bridge!): Switch back to 'call-with-temporary-directory'.
Define '%bridge-socket' in the inferior, connected to the caller.
(proxy): Change first argument to be an inferior.  Add 'reponse-port'
and call to 'drain-input'.  Pass 'reponse-port' to 'select' and use it
as a loop termination clause.
(inferior-eval-with-store): Remove 'socket' and 'connect' calls from the
inferior code, and use '%bridge-socket' instead.

1 files changed, 105 insertions, 64 deletions

diff --git a/guix/inferior.scm b/guix/inferior.scm
index a997c3ead4..1c19527b8f 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -25,6 +25,7 @@
                 #:select (source-properties->location))
   #:use-module ((guix utils)
                 #:select (%current-system
+                          call-with-temporary-directory
                           version>? version-prefix?
                           cache-directory))
   #:use-module ((guix store)
@@ -35,8 +36,6 @@
                           &store-protocol-error))
   #:use-module ((guix derivations)
                 #:select (read-derivation-from-file))
-  #:use-module ((guix build syscalls)
-                #:select (mkdtemp!))
   #:use-module (guix gexp)
   #:use-module (guix search-paths)
   #:use-module (guix profiles)
@@ -56,7 +55,6 @@
   #:use-module (srfi srfi-71)
   #:autoload   (ice-9 ftw) (scandir)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 popen)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 binary-ports)
   #:use-module ((rnrs bytevectors) #:select (string->utf8))
@@ -114,7 +112,7 @@
 ;; Inferior Guix process.
 (define-record-type <inferior>
   (inferior pid socket close version packages table
-            bridge-file-name bridge-socket)
+            bridge-socket)
   inferior?
   (pid      inferior-pid)
   (socket   inferior-socket)
@@ -124,8 +122,6 @@
   (table    inferior-package-table)              ;promise of vhash
 
   ;; Bridging with a store.
-  (bridge-file-name inferior-bridge-file-name     ;#f | string
-                    set-inferior-bridge-file-name!)
   (bridge-socket    inferior-bridge-socket        ;#f | port
                     set-inferior-bridge-socket!))
 
@@ -138,37 +134,69 @@
 
 (set-record-type-printer! <inferior> write-inferior)
 
+(define (open-bidirectional-pipe command . args)
+  "Open a bidirectional pipe to COMMAND invoked with ARGS and return it, as a
+regular file port (socket).
+
+This is equivalent to (open-pipe* OPEN_BOTH ...) except that the result is a
+regular file port that can be passed to 'select' ('open-pipe*' returns a
+custom binary port)."
+  (match (socketpair AF_UNIX SOCK_STREAM 0)
+    ((parent . child)
+     (match (primitive-fork)
+       (0
+        (dynamic-wind
+          (lambda ()
+            #t)
+          (lambda ()
+            (close-port parent)
+            (close-fdes 0)
+            (close-fdes 1)
+            (dup2 (fileno child) 0)
+            (dup2 (fileno child) 1)
+            ;; Mimic 'open-pipe*'.
+            (unless (file-port? (current-error-port))
+              (close-fdes 2)
+              (dup2 (open-fdes "/dev/null" O_WRONLY) 2))
+            (apply execlp command command args))
+          (lambda ()
+            (primitive-_exit 127))))
+       (pid
+        (close-port child)
+        (values parent pid))))))
+
 (define* (inferior-pipe directory command error-port)
-  "Return an input/output pipe on the Guix instance in DIRECTORY.  This runs
-'DIRECTORY/COMMAND repl' if it exists, or falls back to some other method if
-it's an old Guix."
-  (let ((pipe (with-error-to-port error-port
-                (lambda ()
-                  (open-pipe* OPEN_BOTH
-                              (string-append directory "/" command)
-                              "repl" "-t" "machine")))))
+  "Return two values: an input/output pipe on the Guix instance in DIRECTORY
+and its PID.  This runs 'DIRECTORY/COMMAND repl' if it exists, or falls back
+to some other method if it's an old Guix."
+  (let ((pipe pid (with-error-to-port error-port
+                    (lambda ()
+                      (open-bidirectional-pipe
+                       (string-append directory "/" command)
+                       "repl" "-t" "machine")))))
     (if (eof-object? (peek-char pipe))
         (begin
-          (close-pipe pipe)
+          (close-port pipe)
 
           ;; Older versions of Guix didn't have a 'guix repl' command, so
           ;; emulate it.
           (with-error-to-port error-port
             (lambda ()
-              (open-pipe* OPEN_BOTH "guile"
-                          "-L" (string-append directory "/share/guile/site/"
-                                              (effective-version))
-                          "-C" (string-append directory "/share/guile/site/"
-                                              (effective-version))
-                          "-C" (string-append directory "/lib/guile/"
-                                              (effective-version) "/site-ccache")
-                          "-c"
-                          (object->string
-                           `(begin
-                              (primitive-load ,(search-path %load-path
-                                                            "guix/repl.scm"))
-                              ((@ (guix repl) machine-repl))))))))
-        pipe)))
+              (open-bidirectional-pipe
+               "guile"
+               "-L" (string-append directory "/share/guile/site/"
+                                   (effective-version))
+               "-C" (string-append directory "/share/guile/site/"
+                                   (effective-version))
+               "-C" (string-append directory "/lib/guile/"
+                                   (effective-version) "/site-ccache")
+               "-c"
+               (object->string
+                `(begin
+                   (primitive-load ,(search-path %load-path
+                                                 "guix/repl.scm"))
+                   ((@ (guix repl) machine-repl))))))))
+        (values pipe pid))))
 
 (define* (port->inferior pipe #:optional (close close-port))
   "Given PIPE, an input/output port, return an inferior that talks over PIPE.
@@ -181,7 +209,7 @@ inferior."
      (letrec ((result (inferior 'pipe pipe close (cons 0 rest)
                                 (delay (%inferior-packages result))
                                 (delay (%inferior-package-table result))
-                                #f #f)))
+                                #f)))
 
        ;; For protocol (0 1) and later, send the protocol version we support.
        (match rest
@@ -206,10 +234,11 @@ inferior."
                         (error-port (%make-void-port "w")))
   "Open the inferior Guix in DIRECTORY, running 'DIRECTORY/COMMAND repl' or
 equivalent.  Return #f if the inferior could not be launched."
-  (define pipe
-    (inferior-pipe directory command error-port))
-
-  (port->inferior pipe close-pipe))
+  (let ((pipe pid (inferior-pipe directory command error-port)))
+    (port->inferior pipe
+                    (lambda (port)
+                      (close-port port)
+                      (waitpid pid)))))
 
 (define (close-inferior inferior)
   "Close INFERIOR."
@@ -218,9 +247,7 @@ equivalent.  Return #f if the inferior could not be launched."
 
     ;; Close and delete the store bridge, if any.
     (when (inferior-bridge-socket inferior)
-      (close-port (inferior-bridge-socket inferior))
-      (delete-file (inferior-bridge-file-name inferior))
-      (rmdir (dirname (inferior-bridge-file-name inferior))))))
+      (close-port (inferior-bridge-socket inferior)))))
 
 ;; Non-self-quoting object of the inferior.
 (define-record-type <inferior-object>
@@ -512,22 +539,32 @@ is similar to the sexp returned by 'package-provenance' for regular packages."
                                                 'package-provenance))))
                              (or provenance (const #f)))))
 
-(define (proxy client backend)                    ;adapted from (guix ssh)
-  "Proxy communication between CLIENT and BACKEND until CLIENT closes the
-connection, at which point CLIENT is closed (both CLIENT and BACKEND must be
-input/output ports.)"
+(define (proxy inferior store)                    ;adapted from (guix ssh)
+  "Proxy communication between INFERIOR and STORE, until the connection to
+STORE is closed or INFERIOR has data available for input (a REPL response)."
+  (define client
+    (inferior-bridge-socket inferior))
+  (define backend
+    (store-connection-socket store))
+  (define response-port
+    (inferior-socket inferior))
+
   ;; Use buffered ports so that 'get-bytevector-some' returns up to the
   ;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>.
   (setvbuf client 'block 65536)
   (setvbuf backend 'block 65536)
 
+  ;; RESPONSE-PORT may typically contain a leftover newline that 'read' didn't
+  ;; consume.  Drain it so that 'select' doesn't immediately stop.
+  (drain-input response-port)
+
   (let loop ()
-    (match (select (list client backend) '() '())
+    (match (select (list client backend response-port) '() '())
       ((reads () ())
        (when (memq client reads)
          (match (get-bytevector-some client)
            ((? eof-object?)
-            (close-port client))
+            #t)
            (bv
             (put-bytevector backend bv)
             (force-output backend))))
@@ -536,7 +573,8 @@ input/output ports.)"
            (bv
             (put-bytevector client bv)
             (force-output client))))
-       (unless (port-closed? client)
+       (unless (or (port-closed? client)
+                   (memq response-port reads))
          (loop))))))
 
 (define (open-store-bridge! inferior)
@@ -547,17 +585,25 @@ process."
   ;; its store.  This ensures the inferior uses the same store, with the same
   ;; options, the same per-session GC roots, etc.
   ;; FIXME: This strategy doesn't work for remote inferiors (SSH).
-  (define directory
-    (mkdtemp! (string-append (or (getenv "TMPDIR") "/tmp")
-                             "/guix-inferior.XXXXXX")))
-
-  (chmod directory #o700)
-  (let ((name   (string-append directory "/inferior"))
-        (socket (socket AF_UNIX SOCK_STREAM 0)))
-    (bind socket AF_UNIX name)
-    (listen socket 2)
-    (set-inferior-bridge-file-name! inferior name)
-    (set-inferior-bridge-socket! inferior socket)))
+  (call-with-temporary-directory
+   (lambda (directory)
+     (chmod directory #o700)
+     (let ((name   (string-append directory "/inferior"))
+           (socket (socket AF_UNIX SOCK_STREAM 0)))
+       (bind socket AF_UNIX name)
+       (listen socket 2)
+
+       (send-inferior-request
+        `(define %bridge-socket
+           (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
+             (connect socket AF_UNIX ,name)
+             socket))
+        inferior)
+       (match (accept socket)
+         ((client . address)
+          (close-port socket)
+          (set-inferior-bridge-socket! inferior client)))
+       (read-inferior-response inferior)))))
 
 (define (ensure-store-bridge! inferior)
   "Ensure INFERIOR has a connected bridge."
@@ -575,22 +621,19 @@ thus be the code of a one-argument procedure that accepts a store."
     (ensure-store-bridge! inferior)
     (send-inferior-request
      `(let ((proc   ,code)
-            (socket (socket AF_UNIX SOCK_STREAM 0))
             (error? (if (defined? 'store-protocol-error?)
                         store-protocol-error?
                         nix-protocol-error?))
             (error-message (if (defined? 'store-protocol-error-message)
                                store-protocol-error-message
                                nix-protocol-error-message)))
-        (connect socket AF_UNIX
-                 ,(inferior-bridge-file-name inferior))
 
         ;; 'port->connection' appeared in June 2018 and we can hardly
         ;; emulate it on older versions.  Thus fall back to
         ;; 'open-connection', at the risk of talking to the wrong daemon or
         ;; having our build result reclaimed (XXX).
         (let ((store (if (defined? 'port->connection)
-                         (port->connection socket #:version ,proto)
+                         (port->connection %bridge-socket #:version ,proto)
                          (open-connection))))
           (dynamic-wind
             (const #t)
@@ -603,12 +646,10 @@ thus be the code of a one-argument procedure that accepts a store."
                          `(store-protocol-error ,(error-message c))))
                 `(result ,(proc store))))
             (lambda ()
-              (close-connection store)
-              (close-port socket)))))
+              (unless (defined? 'port->connection)
+                (close-port store))))))
      inferior)
-    (match (accept (inferior-bridge-socket inferior))
-      ((client . address)
-       (proxy client (store-connection-socket store))))
+    (proxy inferior store)
 
     (match (read-inferior-response inferior)
       (('store-protocol-error message)