From patchwork Wed Jan 15 22:14:50 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 37082 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 7A63727BBE2; Wed, 15 Jan 2025 22:16:30 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-7.6 required=5.0 tests=BAYES_00,DKIMWL_WL_HIGH, DKIM_SIGNED,DKIM_VALID,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id C1B7127BBE2 for ; Wed, 15 Jan 2025 22:16:29 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tYBgF-0003g3-3L; Wed, 15 Jan 2025 17:16:07 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tYBgE-0003fo-73 for guix-patches@gnu.org; Wed, 15 Jan 2025 17:16:06 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tYBgD-0004J1-Sc; Wed, 15 Jan 2025 17:16:05 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=rQnzBH2YYtmHCRWCZdYn9Ha9Qi4HOLtOX+vGS0/Aco0=; b=OmsVduTDryUamHeONWO1FkIRjdxG3Ydz2hSoTHfnlZogugYJM+6MjIAfWzPhBY/YMweG7mveeu5KkNZVBMnVQgJxca6z+rDMiltBHAGSlHZVgqn6KXwZp9FeY2ExuteC/PEURbliki8HAYlxStSRTsZx1p1jZpzM3XTe7r8qla6nqv8qDI/dCKIkjW6SRUVzIdvZg/DZtYnI9XX2KvSqqHSLUV3mTJpAv00haKvdowaA8m2EMtjewbQ4RGWr5m+ZvP+MZSlYd/7BwHv7LfVGt5dWwtsnrbRBywa15TWKPTl4oWsiLwiIxaT6JOQKNrhByGksayw0gv4f2TqkopQ6Vw==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tYBgB-0002u3-Ma; Wed, 15 Jan 2025 17:16:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#75595] [PATCH 4/4] inferior: Allow running inferiors in a container. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Wed, 15 Jan 2025 22:16:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 75595 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 75595@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 75595-submit@debbugs.gnu.org id=B75595.173697931711076 (code B ref 75595); Wed, 15 Jan 2025 22:16:03 +0000 Received: (at 75595) by debbugs.gnu.org; 15 Jan 2025 22:15:17 +0000 Received: from localhost ([127.0.0.1]:59082 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tYBfR-0002sa-03 for submit@debbugs.gnu.org; Wed, 15 Jan 2025 17:15:17 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:36440) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tYBfH-0002lt-BX for 75595@debbugs.gnu.org; Wed, 15 Jan 2025 17:15:08 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tYBfC-00042x-1L; Wed, 15 Jan 2025 17:15:02 -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=rQnzBH2YYtmHCRWCZdYn9Ha9Qi4HOLtOX+vGS0/Aco0=; b=eydUVbvZm2wImr5U6D2G vaCocnBxkednjtR+ja1X4g6H6p37sBhaPn85fiZ6CY29HoOgKr+JWLZhujI+G8ljJcGrFxHue2qk+ RFJPopmc2Ali1G//Dm/FPMHkLp6FYM6k3TSmdEqdHqry9Vxo2jXpgT330HIip1FjQ13HRrjjhYIvq vuzgAK+XI9tKMKf4WSkFwj2wP/oiYZf6dw5xKUPwISHFMNsVZajvpfHrTDsuVE2doL2WGquUh7n0F hOJWdj8GEixEC+aDdTeb3efM0hhYT0iw0nM+HywLmu6mLeaBdjttCbpqMYjYOcqkE8kafB44UFSIP Cf90inREYwta/Q==; From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Wed, 15 Jan 2025 23:14:50 +0100 Message-ID: X-Mailer: git-send-email 2.47.1 In-Reply-To: References: MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * guix/inferior.scm (container-command-wrapper): New procedures. (open-bidirectional-pipe): Add #:isolated? and #:bridge-directory. Call ‘container-command-wrapper’ when #:isolated? is true. Adjust the argument to ‘spawn’ and ‘execlp’ accordingly. (inferior-pipe): Add #:isolated? and #:bridge-directory; pass them on to ‘open-bidirectional-pipe’. (port->inferior): Add #:bridge-directory and honor it. (open-inferior): Add #:isolated? and honor it. Call ‘allocate-temporary-directory’ when #:isolated? is true. Change-Id: Ie0a56de59aac0611d478bda858ab75f48a0853ff --- guix/inferior.scm | 118 +++++++++++++++++++++++++++++++++------------- 1 file changed, 84 insertions(+), 34 deletions(-) diff --git a/guix/inferior.scm b/guix/inferior.scm index ead6148667..a74e9d8665 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -36,6 +36,7 @@ (define-module (guix inferior) &store-protocol-error)) #:use-module ((guix derivations) #:select (read-derivation-from-file)) + #:autoload (guix describe) (current-profile) #:autoload (guix build syscalls) (mkdtemp!) #:use-module (guix gexp) #:use-module (guix search-paths) @@ -139,13 +140,37 @@ (define (write-inferior inferior port) (set-record-type-printer! write-inferior) -(define (open-bidirectional-pipe command . args) +(define (container-command-wrapper command bridge-directory) + "Return a command (list of strings) wrapping COMMAND such that it is spawned +in a new container that shared BRIDGE-DIRECTORY with the host." + (let ((guix (or (and=> (current-profile) + (cut string-append <> "/bin/guix")) + "guix"))) + `(,guix "container" "run" "--bare" "--feature=guix" "--no-cwd" + ,(string-append "--expose=" bridge-directory) + "--" + ,@command))) + +(define* (open-bidirectional-pipe command args + #:key isolated? bridge-directory) "Open a bidirectional pipe to COMMAND invoked with ARGS and return it, as a regular file port (socket). +When ISOLATED? is true, run COMMAND in a container that only shares +BRIDGE-DIRECTORY with the host. + 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)." + (define wrap + ;; Optionally wrap the command so it is spawned via 'guix container run'. + ;; This is not as elegant as using 'call-with-container' directly, but the + ;; advantage is that it allows us to use 'posix_spawn' below, thus making + ;; it reliable in a multi-threaded context. + (if isolated? + (cut container-command-wrapper <> bridge-directory) + identity)) + ;; Make sure the sockets are close-on-exec; failing to do that, a second ;; inferior (for instance) would inherit the underlying file descriptor, and ;; thus (close-port PARENT) in the original process would have no effect: @@ -156,12 +181,14 @@ (define (open-bidirectional-pipe command . args) (let* ((void (open-fdes "/dev/null" O_WRONLY)) (pid (catch 'system-error (lambda () - (spawn command (cons command args) - #:input child - #:output child - #:error (if (file-port? (current-error-port)) - (current-error-port) - void))) + (match (wrap (cons command args)) + ((and (command . _) args) + (spawn command args + #:input child + #:output child + #:error (if (file-port? (current-error-port)) + (current-error-port) + void))))) (const #f)))) ;can't exec, for instance ENOENT (close-fdes void) (close-port child) @@ -187,22 +214,31 @@ (define (open-bidirectional-pipe command . args) 2))) (dup2 (open-fdes "/dev/null" O_WRONLY) 2)) - (apply execlp command command args)) + (match (wrap (cons command args)) + ((and (command . _) args) + (apply execlp command args)))) (lambda () (primitive-_exit 127)))) (pid (close-port child) (values parent pid))))))) -(define* (inferior-pipe directory command error-port) +(define* (inferior-pipe directory command error-port + #:key isolated? bridge-directory) "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"))))) +to some other method if it's an old Guix. + +When ISOLATED? is true, run COMMAND in a container that only shares +BRIDGE-DIRECTORY with the host." + (let* ((bridge-directory (and isolated? bridge-directory)) + (pipe pid (with-error-to-port error-port + (lambda () + (open-bidirectional-pipe + (string-append directory "/" command) + '("repl" "-t" "machine") + #:isolated? isolated? + #:bridge-directory bridge-directory))))) (if (eof-object? (peek-char pipe)) (begin (close-port pipe) @@ -213,30 +249,33 @@ (define* (inferior-pipe directory command error-port) (lambda () (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)))))))) + (list "-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))))) + #:isolated? isolated? + #:bridge-directory bridge-directory)))) (values pipe pid)))) -(define* (port->inferior pipe #:optional (close close-port)) +(define* (port->inferior pipe #:optional (close close-port) + #:key bridge-directory) "Given PIPE, an input/output port, return an inferior that talks over PIPE. PIPE is closed with CLOSE when 'close-inferior' is called on the returned -inferior." +inferior. Associate the new inferior with BRIDGE-DIRECTORY." (setvbuf pipe 'line) (match (read pipe) (('repl-version 0 rest ...) (letrec ((result (inferior 'pipe pipe close (cons 0 rest) - #f ;bridge directory + bridge-directory (delay (%inferior-packages result)) (delay (%inferior-package-table result)) #f))) @@ -306,14 +345,25 @@ (define* (port->inferior pipe #:optional (close close-port)) (define* (open-inferior directory #:key (command "bin/guix") - (error-port (%make-void-port "w"))) + (error-port (%make-void-port "w")) + isolated?) "Open the inferior Guix in DIRECTORY, running 'DIRECTORY/COMMAND repl' or -equivalent. Return #f if the inferior could not be launched." - (let ((pipe pid (inferior-pipe directory command error-port))) +equivalent. Return #f if the inferior could not be launched. + +When ISOLATED? is true, run COMMAND in a container isolated from the host." + ;; When running the command in a container, allocate the directory that will + ;; contain the "bridge socket" upfront so it can be bind-mounted in the + ;; container. + (let* ((bridge-directory (and isolated? + (allocate-temporary-directory))) + (pipe pid (inferior-pipe directory command error-port + #:isolated? isolated? + #:bridge-directory bridge-directory))) (port->inferior pipe (lambda (port) (close-port port) - (waitpid pid))))) + (waitpid pid)) + #:bridge-directory bridge-directory))) (define (close-inferior inferior) "Close INFERIOR."