From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id WE+/ObRk8mErwwAAgWs5BA (envelope-from ) for ; Thu, 27 Jan 2022 10:24:04 +0100 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id sDlxNrRk8mFzQgAAauVa8A (envelope-from ) for ; Thu, 27 Jan 2022 10:24:04 +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 347D129D80 for ; Thu, 27 Jan 2022 10:24:04 +0100 (CET) Received: from localhost ([::1]:34512 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nD10d-00047q-E4 for larch@yhetil.org; Thu, 27 Jan 2022 04:24:03 -0500 Received: from eggs.gnu.org ([209.51.188.92]:34042) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nD0Sn-0008AX-Hz for bug-guix@gnu.org; Thu, 27 Jan 2022 03:49:08 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:33145) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nD0Sk-0000vg-RO 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-0007lm-QC for bug-guix@gnu.org; Thu, 27 Jan 2022 03:49:02 -0500 X-Loop: help-debbugs@gnu.org Subject: bug#48007: [PATCH 1/4] inferior: Create the store proxy listening socket only once. 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.164327330229787 (code B ref 48007); Thu, 27 Jan 2022 08:49:02 +0000 Received: (at 48007) by debbugs.gnu.org; 27 Jan 2022 08:48:22 +0000 Received: from localhost ([127.0.0.1]:54274 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nD0S5-0007kG-ED for submit@debbugs.gnu.org; Thu, 27 Jan 2022 03:48:22 -0500 Received: from eggs.gnu.org ([209.51.188.92]:33140) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nD0S1-0007jr-Sn for 48007@debbugs.gnu.org; Thu, 27 Jan 2022 03:48:19 -0500 Received: from [2001:470:142:3::e] (port=51726 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 1nD0Rv-0000s9-BA; 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=CmsMqTnb6zyXeTmpN2nMLjXGuWMnR5VW0fxREJ53O+w=; b=MQfiR63el2GxCdYTZsfI oGAnVUltvNO3dL4MEbp2sB038CqWZos9/u1pb1KYZd9sPdgkAcXU7PByE3Z/j9VKnt4m/uHmIWV8Y ORN1l63XlVWEK7zcQxa/+SJ+V6L3kVeWXClPH6s4tuegSdTzHVAZTqmLx+qQRvVOuQR00P1CY9552 ii7v2mXRjbPDxWWAA6hNymaq5MGUnwSmV/+cuEKsqfVjwN9NM5oUVd9XXp5EKZ9Mo5BZdZzaxbp2f kEao4uyBj1Wv+aj6nu22IZSpBecT6V1zA+KdzJoxgMpKG634h/r1xXHA6r85XTOk2DV1D7OpIVwLC ISvlGSOBfnZnqw==; 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 1nD0Ru-0002sQ-RV; Thu, 27 Jan 2022 03:48:11 -0500 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Thu, 27 Jan 2022 09:47:40 +0100 Message-Id: <20220127084743.27130-1-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <87r18ufcft.fsf@gnu.org> References: <87r18ufcft.fsf@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=1643275444; 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=CmsMqTnb6zyXeTmpN2nMLjXGuWMnR5VW0fxREJ53O+w=; b=qpwjBEQKT9r1fCKldULWwvNip31yNwBKUR2hf1Ny9KxVjkDB11LmD8fxJCQHutMLaZKZJ9 /61eK0sVftHFY0jOlZ8chsRs5/YNo3clYdgoNwAFMxlALgdmj2VRTsMABhuXSSVRHn/LlE RS4yWrecsy/OOqWEqtBVghgJRcMu/2TS6xr5JQpU8eU0AgkmVSNLWYWH/jW/X9zOhnVy5n 5DdzipH8GVnoyNEaTztqzBKEBvTEhCV5SzfQ1484G1whTuJfiSu7UyrvKsShVzvai92A0z mw4yR6cG0MS1JqWX2ZmJZhG4+EL33YWDX/ocv3C05hXajME1sp2SdJP+Fpwikw== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1643275444; a=rsa-sha256; cv=none; b=KVQfaNzLw069mJRTrT69LVOosKadZeATnOHVr8/rwJTH+YtI2/300uW36aFeEbKjDCR3pk QgEWvNSmoud3ZprVdwfKUoTOEZ10WG6yGLpttsaBR4fZ6NzR3qDLjYdy26omoegyUTwAi9 I2Xt1R5xVdliV8LW7l7CeZJDEXRdAnROdZvTcf431rSJqFPFx3DmU06yKiiYKIS1QjO4gd BGcUTBVPFh5kuG12bW+IJI9s7WDjbBz45DFsc+TR6FGyrWs6QZH1fbU182PaSlIE9i/Nmm 1cj+lE5U2sa4QhTRIqJoOT3n9L3tRN5Pd/06wz01YuVKhCw9KmwKQuD51QQMUw== 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=MQfiR63e; 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: -3.63 Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=gnu.org header.s=fencepost-gnu-org header.b=MQfiR63e; 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: 347D129D80 X-Spam-Score: -3.63 X-Migadu-Scanner: scn0.migadu.com X-TUID: +6iqKWqPJ+RJ Previously, each 'inferior-eval-with-store' call would have the calling process create a temporary directory with a listening socket in there. Now that listening socket is created once and reused in subsequent calls. * guix/inferior.scm ()[bridge-file-name, bridge-socket]: New fields. (port->inferior): Adjust accordingly. (close-inferior): Close 'inferior-bridge-socket' and delete 'inferior-bridge-file-name' if set. (open-store-bridge!, ensure-store-bridge!): New procedures. (inferior-eval-with-store): Use them. --- guix/inferior.scm | 154 ++++++++++++++++++++++++++++------------------ 1 file changed, 93 insertions(+), 61 deletions(-) diff --git a/guix/inferior.scm b/guix/inferior.scm index 572114f626..a997c3ead4 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -25,7 +25,6 @@ (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) @@ -36,6 +35,8 @@ (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) @@ -112,14 +113,21 @@ (define-module (guix inferior) ;; Inferior Guix process. (define-record-type - (inferior pid socket close version packages table) + (inferior pid socket close version packages table + bridge-file-name bridge-socket) inferior? (pid inferior-pid) (socket inferior-socket) (close inferior-close-socket) ;procedure (version inferior-version) ;REPL protocol version (packages inferior-package-promise) ;promise of inferior packages - (table inferior-package-table)) ;promise of vhash + (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!)) (define (write-inferior inferior port) (match inferior @@ -172,7 +180,8 @@ (define* (port->inferior pipe #:optional (close close-port)) (('repl-version 0 rest ...) (letrec ((result (inferior 'pipe pipe close (cons 0 rest) (delay (%inferior-packages result)) - (delay (%inferior-package-table result))))) + (delay (%inferior-package-table result)) + #f #f))) ;; For protocol (0 1) and later, send the protocol version we support. (match rest @@ -205,7 +214,13 @@ (define pipe (define (close-inferior inferior) "Close INFERIOR." (let ((close (inferior-close-socket inferior))) - (close (inferior-socket inferior)))) + (close (inferior-socket 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)))))) ;; Non-self-quoting object of the inferior. (define-record-type @@ -524,67 +539,84 @@ (define (proxy client backend) ;adapted from (guix ssh) (unless (port-closed? client) (loop)))))) +(define (open-store-bridge! inferior) + "Open a \"store bridge\" for INFERIOR--a named socket in /tmp that will be +used to proxy store RPCs from the inferior to the store of the calling +process." + ;; Create a named socket in /tmp to let INFERIOR connect to it and use it as + ;; 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))) + +(define (ensure-store-bridge! inferior) + "Ensure INFERIOR has a connected bridge." + (or (inferior-bridge-socket inferior) + (begin + (open-store-bridge! inferior) + (inferior-bridge-socket inferior)))) + (define (inferior-eval-with-store inferior store code) "Evaluate CODE in INFERIOR, passing it STORE as its argument. CODE must thus be the code of a one-argument procedure that accepts a store." - ;; Create a named socket in /tmp and let INFERIOR connect to it and use it - ;; as 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). - (call-with-temporary-directory - (lambda (directory) - (chmod directory #o700) - (let* ((name (string-append directory "/inferior")) - (socket (socket AF_UNIX SOCK_STREAM 0)) - (major (store-connection-major-version store)) - (minor (store-connection-minor-version store)) - (proto (logior major minor))) - (bind socket AF_UNIX name) - (listen socket 1024) - (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 ,name) + (let* ((major (store-connection-major-version store)) + (minor (store-connection-minor-version store)) + (proto (logior major minor))) + (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) - (open-connection)))) - (dynamic-wind - (const #t) - (lambda () - ;; Serialize '&store-protocol-error' conditions. The - ;; exception serialization mechanism that - ;; 'read-repl-response' expects is unsuitable for SRFI-35 - ;; error conditions, hence this special case. - (guard (c ((error? c) - `(store-protocol-error ,(error-message c)))) - `(result ,(proc store)))) - (lambda () - (close-connection store) - (close-port socket))))) - inferior) - (match (accept socket) - ((client . address) - (proxy client (store-connection-socket store)))) - (close-port socket) + ;; '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) + (open-connection)))) + (dynamic-wind + (const #t) + (lambda () + ;; Serialize '&store-protocol-error' conditions. The + ;; exception serialization mechanism that + ;; 'read-repl-response' expects is unsuitable for SRFI-35 + ;; error conditions, hence this special case. + (guard (c ((error? c) + `(store-protocol-error ,(error-message c)))) + `(result ,(proc store)))) + (lambda () + (close-connection store) + (close-port socket))))) + inferior) + (match (accept (inferior-bridge-socket inferior)) + ((client . address) + (proxy client (store-connection-socket store)))) - (match (read-inferior-response inferior) - (('store-protocol-error message) - (raise (condition - (&store-protocol-error (message message) - (status 1))))) - (('result result) - result)))))) + (match (read-inferior-response inferior) + (('store-protocol-error message) + (raise (condition + (&store-protocol-error (message message) + (status 1))))) + (('result result) + result)))) (define* (inferior-package-derivation store package #:optional base-commit: 3993d33d1c0129b1ca6f0fd122fe2bbe48e4f093 -- 2.34.0