From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id yNZ5Cmxd8mFvjQAAgWs5BA (envelope-from ) for ; Thu, 27 Jan 2022 09:53:00 +0100 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id yM8kB2xd8mGqCQAAauVa8A (envelope-from ) for ; Thu, 27 Jan 2022 09:53:00 +0100 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 4BECA39A8E for ; Thu, 27 Jan 2022 09:52:59 +0100 (CET) Received: from localhost ([::1]:37190 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nD0WY-000378-Hm for larch@yhetil.org; Thu, 27 Jan 2022 03:52:58 -0500 Received: from eggs.gnu.org ([209.51.188.92]:34046) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nD0Sn-0008Ai-Iq for bug-guix@gnu.org; Thu, 27 Jan 2022 03:49:08 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:33144) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nD0Sk-0000vd-Jj for bug-guix@gnu.org; Thu, 27 Jan 2022 03:49:05 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nD0Sk-0007lf-E0 for bug-guix@gnu.org; Thu, 27 Jan 2022 03:49:02 -0500 X-Loop: help-debbugs@gnu.org Subject: bug#48007: [PATCH 2/4] inferior: Keep the store bridge connected. Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: bug-guix@gnu.org Resent-Date: Thu, 27 Jan 2022 08:49:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 48007 X-GNU-PR-Package: guix X-GNU-PR-Keywords: To: 48007@debbugs.gnu.org Received: via spool by 48007-submit@debbugs.gnu.org id=B48007.164327330129779 (code B ref 48007); Thu, 27 Jan 2022 08:49:02 +0000 Received: (at 48007) by debbugs.gnu.org; 27 Jan 2022 08:48:21 +0000 Received: from localhost ([127.0.0.1]:54270 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nD0S4-0007kD-Hu for submit@debbugs.gnu.org; Thu, 27 Jan 2022 03:48:21 -0500 Received: from eggs.gnu.org ([209.51.188.92]:33142) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nD0S1-0007js-V1 for 48007@debbugs.gnu.org; Thu, 27 Jan 2022 03:48:18 -0500 Received: from [2001:470:142:3::e] (port=51728 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nD0Rw-0000sF-Dr; Thu, 27 Jan 2022 03:48:12 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=249/nWybbQ7ipeqdDBp2and84w7AN9yCbk0zSe7Uo/w=; b=NVIecgF0FtFD7O6e9WuD FkAb3xyg4PkZSXysxdHeUsxtu6eY2SULEXcGaDUUiKzEVfHZgXetffTW5r/WAiP4DxWJWzeC58BdX 8ZN1wuJPaP5U1+3/wyzdANor9AFmkSMoRBoJ5jDlW/bpyzUTrfqE8xJeXK6H76B4fye3IKQXnvt3e K4M1eyrqnzsrVsqIgzQrpX8qXFSCQ+acvlzGwqO7rY2/CWhy/xwALytGmOvsPRZQ3wS+zLO5k4cy7 SLutQEO7ZZ472JmXYS1o1+ssTekxWAzi9sTJJe8+q53q29cmUX1JTMugM2DGjN8xMnbgP9AsSU7Z+ XLqMGtQmDsQ5xg==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:60148 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nD0Rv-0002sQ-HY; Thu, 27 Jan 2022 03:48:11 -0500 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Thu, 27 Jan 2022 09:47:41 +0100 Message-Id: <20220127084743.27130-2-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <20220127084743.27130-1-ludo@gnu.org> References: <87r18ufcft.fsf@gnu.org> <20220127084743.27130-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-guix@gnu.org List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+larch=yhetil.org@gnu.org Sender: "bug-Guix" X-Migadu-Flow: FLOW_IN X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1643273579; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=249/nWybbQ7ipeqdDBp2and84w7AN9yCbk0zSe7Uo/w=; b=cmVLAlICXjlY6C/hftmKxHjI2f3c68OzTpEIMf/Fe3FBjNLzUhX/jtP/SwIAp63U7UU5Ur o/xRlmaC2YRB5hQwCuQ8cZTnl3ZeJnoj6rEC5Yx0cZOPWwclxsqncBrONTYN1LD59+xTfZ h2Y4x6HkvJoIWn9J3lenhDmNUreNtOW1nWrcTXpqN3kgopyvM7acel4F+bi38T+8B/wYPR 30pPhmG1hp/uDfm/QihTrbSes66u3HA7mWrkz9Fq1U4H7X8O2JSpARoCAvT1q8L9pqxo4F DQCiwbUjHpsMykBi8X1bIK1kdQ9PScjo/BBqJ5zjFLl1lSbaLkkSJU+geS2Z5w== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1643273579; a=rsa-sha256; cv=none; b=heQ8vPZpyTQYWMSnFuYvb4H4YSg8/q3MY4F/fofhjvWP6bTeAdIxHEfROeDtH6xI4xHXJM BS4lQ02JJqg1Hgq7Kuu4fpsNSxu2wwCamYhaLUogY16tLhEERqXQd3L2J2iVnJfMhPnC/o fP7lRX4HW+TpWDW/HF9XxS+HnaYQ9sFoamTybP/r1Zihs26mbycHjYJl62pVxc4GsUFXq0 StB9rKZSC56XhEPmS/cdtyWb0wd7880xGKUxPx/H0Z9deyTL69pq+GaZjNAy0IlBxDQqMD lOdbaNTWqwLURBiE8hLMBA6wBLduNUZrtuecwRS38FLA+ruGLA4Kz7Bzcb3TNA== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=gnu.org header.s=fencepost-gnu-org header.b=NVIecgF0; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "bug-guix-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="bug-guix-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -2.33 Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=gnu.org header.s=fencepost-gnu-org header.b=NVIecgF0; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "bug-guix-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="bug-guix-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: 4BECA39A8E X-Spam-Score: -2.33 X-Migadu-Scanner: scn1.migadu.com X-TUID: 3wDEGeH1G+Ef 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 ()[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. --- guix/inferior.scm | 167 +++++++++++++++++++++++++++++----------------- 1 file changed, 104 insertions(+), 63 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 @@ (define-module (guix inferior) #: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 @@ (define-module (guix inferior) &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 @@ (define-module (guix inferior) #: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 @@ (define-module (guix inferior) ;; Inferior Guix process. (define-record-type (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 @@ (define-record-type (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 @@ (define (write-inferior inferior port) (set-record-type-printer! 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 @@ (define* (port->inferior pipe #:optional (close close-port)) (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 @@ (define* (open-inferior directory (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 @@ (define (close-inferior inferior) ;; 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 @@ -512,22 +539,32 @@ (define (inferior-package-provenance package) '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 . (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 @@ (define (proxy client backend) ;adapted from (guix ssh) (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 @@ (define (open-store-bridge! inferior) ;; 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"))) + (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) - (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))) + (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 @@ (define (inferior-eval-with-store inferior store code) (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 @@ (define (inferior-eval-with-store inferior store code) `(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) -- 2.34.0