From patchwork Wed Jan 15 22:14:47 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: 37083 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 162FA27BBEA; Wed, 15 Jan 2025 22:16:37 +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 2CD0027BBE2 for ; Wed, 15 Jan 2025 22:16:36 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tYBgE-0003g2-W5; 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 1tYBgD-0003ec-AU for guix-patches@gnu.org; Wed, 15 Jan 2025 17:16:05 -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 1tYBgC-0004Ik-O3; Wed, 15 Jan 2025 17:16:04 -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=13u6fOIDbADLF4w9/BD9fWokUtcwkgJVmoylI1L/8Do=; b=SGxF2nEKAu6qFXl7YsZn8ZoJpdWi5d1bz47LAPFE/1WD/Yev1N2YUKv5fPl/AkFuRsSPbMpFvauh8yjKl8BwiYJpM2Jwb2vtdW/kjaH5GjLCpeTgri/wWKp6Tlolwe6m7k1LtWIB0be5oXUPdDGfk4zFDHAkMdEwx3GRaqZsXEdNK8CF2Jc8sX42DmUOkKvH0TyaDL4qMgV6XaG57KspqvBwdJxMYLGvzMQO3O7+kTaC0OUkK5CqyEQekeRjsGJdGf6A5SD3SnAtRZAq+cyg1ngli+tV57ww9Y1kl0Buy0tJwT7veKj2TY6ysp8x1A8QkD3rIg//U9ConErvowZxWg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tYBgA-0002td-4J; Wed, 15 Jan 2025 17:16:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#75595] [PATCH 1/4] DRAFT container: Add =?utf-8?b?4oCYcnVu4oCZ?= sub-command. 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:02 +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.173697930710897 (code B ref 75595); Wed, 15 Jan 2025 22:16:02 +0000 Received: (at 75595) by debbugs.gnu.org; 15 Jan 2025 22:15:07 +0000 Received: from localhost ([127.0.0.1]:59072 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tYBfG-0002pR-4O for submit@debbugs.gnu.org; Wed, 15 Jan 2025 17:15:07 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:60064) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tYBfD-0002lB-Nm for 75595@debbugs.gnu.org; Wed, 15 Jan 2025 17:15:04 -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 1tYBf8-00041w-EE; Wed, 15 Jan 2025 17:14:58 -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=13u6fOIDbADLF4w9/BD9fWokUtcwkgJVmoylI1L/8Do=; b=Mo1SVjOaS1G2WEj1KVwc skibGYrMuU6joTHFCRGUkqd5sNzVMlixb9NJouMduu/NgyDeLXllF/Ik7Y3pJSsKw7ipDKytiWKuX oKMvvjNE9tticytHqr3bzzSNslxTQD2XRAyf9Lrp40ER0VxMvtVCEB2PeJn/mrf/hOLbHbtCqxVQQ 0oW/Vnk6cu+jwVuizLqhQtBX6kvdWmgzLFnFave3XufNSpiFyCNZjqql8EbWB3lOhLGK5VUtmx8si OZsYvvo3cttN1GFia0jgAyqC+JqwGSPB5MT6E2xvMHK2vPgY9uDP1ImWXFv1X3bSabYjvAUeYxF2C 5RZcZBOgIavBxg==; From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Wed, 15 Jan 2025 23:14:47 +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 DRAFT missing doc and tests. * guix/scripts/container.scm (show-help, %actions): Add “run”. * guix/scripts/container/run.scm: New file. * Makefile.am (MODULES): Add it. Change-Id: I0ca1d085649ac059aab597f48bea6e480004bf4c --- Makefile.am | 3 +- guix/scripts/container.scm | 4 +- guix/scripts/container/run.scm | 301 +++++++++++++++++++++++++++++++++ 3 files changed, 306 insertions(+), 2 deletions(-) create mode 100644 guix/scripts/container/run.scm diff --git a/Makefile.am b/Makefile.am index f911d432dd..6a3c14278a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012-2024 Ludovic Courtès +# Copyright © 2012-2025 Ludovic Courtès # Copyright © 2013 Andreas Enge # Copyright © 2015, 2017 Alex Kost # Copyright © 2016, 2018 Mathieu Lirzin @@ -380,6 +380,7 @@ MODULES = \ guix/scripts/weather.scm \ guix/scripts/container.scm \ guix/scripts/container/exec.scm \ + guix/scripts/container/run.scm \ guix/scripts/deploy.scm \ guix/scripts/time-machine.scm \ guix.scm \ diff --git a/guix/scripts/container.scm b/guix/scripts/container.scm index 70637bca29..becc096744 100644 --- a/guix/scripts/container.scm +++ b/guix/scripts/container.scm @@ -31,6 +31,8 @@ (define (show-help) (newline) (display (G_ "\ exec execute a command inside of an existing container\n")) + (display (G_ "\ + run run the given command in a new container\n")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -39,7 +41,7 @@ (define (show-help) (newline) (show-bug-report-information)) -(define %actions '("exec")) +(define %actions '("exec" "run")) (define (resolve-action name) (let ((module (resolve-interface diff --git a/guix/scripts/container/run.scm b/guix/scripts/container/run.scm new file mode 100644 index 0000000000..fd4e8a5547 --- /dev/null +++ b/guix/scripts/container/run.scm @@ -0,0 +1,301 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018-2020, 2025 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix scripts container run) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix store) + #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module ((guix build utils) #:select (which mkdir-p)) + #:use-module (gnu build linux-container) + #:use-module (gnu system file-systems) + #:use-module (gnu packages) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9 gnu) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:use-module (srfi srfi-71) + #:use-module (ice-9 match) + #:export (guix-container-run)) + + +;;; +;;; Strongbox. +;;; + +(define (bind-mount-spec/ro item) + (and (file-exists? item) + (file-system + (device item) + (mount-point item) + (type "none") + (flags '(bind-mount read-only)) + (check? #f)))) + +(define (bind-mount-spec/rw item) + (and (file-exists? item) + (file-system + (inherit (bind-mount-spec/ro item)) + (flags '(bind-mount))))) + +;; Safe in which applications run. +(define-immutable-record-type + (safe namespaces mappings environment) + safe? + (namespaces safe-namespaces) + (mappings safe-mappings) + (environment safe-environment-variables)) + +(define (store-item-features store items) + "Return a list of \"features\" for ITEM, where features are symbols such as +'x11, 'dbus, 'alsa, etc. The feature list is determined as a function of the +packages presumably among ITEMS." + (define packages + (map (compose (cut package-name->name+version <> #\-) + store-path-package-name) + items)) + + (letrec-syntax ((features (syntax-rules (->) + ((_ (package -> feature) rest ...) + (let ((lst (features rest ...))) + (if (member package packages) + (cons 'feature lst) + lst))) + ((_) + '())))) + (features ("libx11" -> x11) + ("dbus" -> dbus) + ("alsa-lib" -> alsa) + ("pulseaudio" -> pulseaudio) + ("guix" -> guix)))) + +(define (features->safe features) + "Return a safe for the given FEATURES, a list of symbols." + (define x11? (memq 'x11 features)) + (define network? (memq 'network features)) + (define dbus? (memq 'dbus features)) + (define alsa? (memq 'alsa features)) + (define pulseaudio? (memq 'pulseaudio features)) + (define guix? (memq 'guix features)) + + (define mappings + (let-syntax ((if (syntax-rules () + ((_ condition body) + (if condition + (or (and=> body list) '()) + '())))) + (ro (identifier-syntax bind-mount-spec/ro)) + (rw (identifier-syntax bind-mount-spec/rw))) + `(,@(if network? (ro "/var/run/nscd/socket")) + ,@(if network? (ro "/etc/ssl")) + ,@(if (and guix? (string-prefix? "/" (%daemon-socket-uri))) + (ro (%daemon-socket-uri))) + ,@(if (or guix? network?) ;/etc/ssl/certs/* points to the store + (ro (%store-prefix))) ;the entire store + ,@(if guix? + (rw (string-append (getenv "HOME") "/.cache/guix"))) + ,@(if x11? (rw (string-append (getenv "HOME") "/.Xauthority"))) + ,@(if x11? (rw "/tmp/.X11-unix")) + ,@(if x11? (rw (string-append "/run/user/" + (number->string (getuid))))) + ,@(if dbus? (ro "/etc/machine-id")) + ,@(if alsa? (rw "/dev/snd")) + ,@(if pulseaudio? (rw (string-append (getenv "HOME") "/.pulse")))))) + + (define namespaces + ;; X11 applications need to run in the same IPC namespace as + ;; the server. + (let ((withdrawn `(,@(if x11? '(ipc) '()) + ,@(if network? '(net) '())))) + (fold delq %namespaces withdrawn))) + + (define environment-variables + `("HOME" + ,@(if x11? '("DISPLAY") '()) + ,@(if (or dbus? x11?) '("XDG_RUNTIME_DIR") '()))) + + (safe namespaces mappings environment-variables)) + +(define (store-mapping? file-system) + "Return true if FILE-SYSTEM mounts the store." + (string=? (file-system-mount-point file-system) + (%store-prefix))) + + +;;; +;;; Options. +;;; + +(define %options + (list (option '("bare") #f #f + (lambda (opt name arg result) + (alist-cons 'bare? #t result))) + (option '(#\N "network") #f #f + (lambda (opt name arg result) + (alist-cons 'feature 'network result))) + (option '(#\W "nesting") #f #f + (lambda (opt name arg result) + (alist-cons 'feature 'guix result))) + (option '(#\g "feature") #t #f + (lambda (opt name arg result) + (alist-cons 'feature (string->symbol arg) result))) + (option '("no-cwd") #f #f + (lambda (opt name arg result) + (alist-cons 'no-cwd? #t result))) + (option '("share") #t #f + (lambda (opt name arg result) + (alist-cons 'file-system-mapping + (specification->file-system-mapping arg #t) + result))) + (option '("expose") #t #f + (lambda (opt name arg result) + (alist-cons 'file-system-mapping + (specification->file-system-mapping arg #f) + result))) + + (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix run"))))) + +(define (show-help) + (display (G_ "Usage: guix run COMMAND... +Run COMMAND from PACKAGE in a container.\n")) + (display (G_ " + --bare create a bare environment without attempting + to guess the features needed by COMMAND")) + (display (G_ " + -N, --network provide access the network")) + (display (G_ " + -W, --nesting allow use of Guix within the container")) + (display (G_ " + -g, --feature=NAME provide access to feature NAME")) + (display (G_ " + --no-cwd do not share current working directory with an + isolated container")) + + (display (G_ " + --share=SPEC share writable host file system according to SPEC")) + (display (G_ " + --expose=SPEC expose read-only host file system according to SPEC")) + (newline) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + + +;;; +;;; Entry point. +;;; + +(define (guix-container-run . args) + (define (parse-options) + (args-fold* args %options + (lambda (opt name arg result) + (leave (G_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + '())) + + (define %not-colon + (char-set-complement (char-set #\:))) + + (with-error-handling + (let ((options (parse-options))) + (match (reverse (filter-map (match-lambda + (('argument . argument) argument) + (_ #f)) + options)) + ((command args ...) + (with-store store + (let* ((full (search-path (string-tokenize (getenv "PATH") + %not-colon) + command)) + (resolved (and=> full readlink*)) + (prefix (and=> resolved (lambda (file) + (and (store-path? file) + (direct-store-path file)))))) + (unless full + (leave (G_ "command '~a' not found~%") command)) + (unless prefix + (leave (G_ "command '~a' is not in '~a'~%") + command (%store-prefix))) + + (let* ((items (requisites store (list prefix))) + (features (append (filter-map (match-lambda + (('feature . feature) + feature) + (_ #f)) + options) + (if (assoc-ref options 'bare?) + '() + (store-item-features store items)))) + (safe (features->safe features)) + (cwd (getcwd)) + (environment + (filter-map (lambda (variable) + (match (getenv variable) + (#f #f) + (value (string-append variable "=" + value)))) + (safe-environment-variables safe))) + (mappings + (append (safe-mappings safe) + (if (find store-mapping? (safe-mappings safe)) + '() ;the whole store is mapped + (map bind-mount-spec/ro items)) + (filter-map (match-lambda + (('file-system-mapping . mapping) + (file-system-mapping->bind-mount + mapping)) + (_ #f)) + options) + (if (assoc-ref options 'no-cwd?) + '() + (list (bind-mount-spec/ro cwd)))))) + + (call-with-container mappings + (lambda () + ;; Inherit specific environment variables. + (environ environment) + + (when (getenv "HOME") + (mkdir-p (getenv "HOME"))) + + (unless (assoc-ref options 'no-cwd?) + (chdir cwd)) + + (newline) + (catch #t + (lambda () + (apply execl resolved command args)) + (lambda (key . args) + (print-exception (current-error-port) #f key args) + (exit 1)))) + + #:guest-uid 1000 + #:guest-gid 1000 + #:namespaces (safe-namespaces safe)))))))))) From patchwork Wed Jan 15 22:14:48 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: 37080 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 39BB027BBEA; Wed, 15 Jan 2025 22:16:21 +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=ham 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 ED7EE27BBE2 for ; Wed, 15 Jan 2025 22:16:20 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tYBgC-0003e2-SK; Wed, 15 Jan 2025 17:16:04 -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 1tYBgB-0003d7-2q for guix-patches@gnu.org; Wed, 15 Jan 2025 17:16:03 -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 1tYBgA-0004IU-Qi for guix-patches@gnu.org; Wed, 15 Jan 2025 17:16:02 -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=JMTiwgJyG2Yl+3Y/gtJm+iaI0vT9Pc+7ZIgV+MplzE4=; b=P6vYWCwlq0y891LEiy2LhdprSOwswASpHKY4gzdo2l26l154eMlJNDELDxEzZNBkQbfxZ4REmvgipE8ymi/vDsNU1ENKBr3kKQDv4qXcnVePC7YepVzzCGnsPeQWRzu9ozbrha68irfSKiuT65C2pT+Xjd5EisGBE6I2DuaQEg9Q+nJhgmo2T6Yy1DYA0zPOWen6DNzmo+LtIuqGEfaNElNRgBjEAlANsN+IlW87++Iovfxyfc5os08TnagKYhrM+j+QfnRS9hQvfFptMZNCnv/UX/mbUlHDWYa00QV/KvCq55bDjhAW07tFgZn5rLPeqAEPhbJQCG3A9iYCABx1sg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tYBgA-0002tm-Ke for guix-patches@gnu.org; Wed, 15 Jan 2025 17:16:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#75595] [PATCH 2/4] tests: Make =?utf-8?b?4oCYaW5mZXJpb3ItZXZh?= =?utf-8?b?bC13aXRoLXN0b3Jl4oCZ?= test more robust. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 15 Jan 2025 22:16:02 +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?= Received: via spool by 75595-submit@debbugs.gnu.org id=B75595.173697930810935 (code B ref 75595); Wed, 15 Jan 2025 22:16:02 +0000 Received: (at 75595) by debbugs.gnu.org; 15 Jan 2025 22:15:08 +0000 Received: from localhost ([127.0.0.1]:59075 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tYBfH-0002pj-Aj for submit@debbugs.gnu.org; Wed, 15 Jan 2025 17:15:07 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:60080) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tYBfE-0002lF-IP for 75595@debbugs.gnu.org; Wed, 15 Jan 2025 17:15:04 -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 1tYBf9-00042F-9m; Wed, 15 Jan 2025 17:14:59 -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=JMTiwgJyG2Yl+3Y/gtJm+iaI0vT9Pc+7ZIgV+MplzE4=; b=kfT6Z5dpgfs/zpFQGhmE llzTLyQksJ1RQj82n2sPXDaAyon4PsaDI447aB4EB4gM8p8GMNUHnpV7n1ms6iVuU9i6LRtxGs7O9 +XXrZQuGqn2olPBeb/8+ifQ8uqUk++7WR+d0/VjjkyyY+Awj28ocTMfCaHPOS1+G6XbTxlOHkU/oO +7n1943O6cSbuzDbJtR4XCbeOOLBhqb5FJowysReXiXkvaeen9SEqaeAE9SDHE7NVAHvayKc4b1HK Hio5kbgYymLrlAuaWkqRDy8kDLVTzclyzHjYfIXUWl8oPMKXaGlBVf6iXxnq5Aatfo+cJfv/mQVjD db9gvbIfu8/PrA==; From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Wed, 15 Jan 2025 23:14:48 +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 * tests/inferior.scm ("inferior-eval-with-store"): Use ‘random-text’ for the store item’s body. Change-Id: Ia39e276955e1836a0272713ff25c4490273c666f --- tests/inferior.scm | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/tests/inferior.scm b/tests/inferior.scm index 963d405e33..11a27c0006 100644 --- a/tests/inferior.scm +++ b/tests/inferior.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018-2022 Ludovic Courtès +;;; Copyright © 2018-2022, 2025 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,6 +27,8 @@ (define-module (test-inferior) #:use-module (gnu packages bootstrap) #:use-module (gnu packages guile) #:use-module (gnu packages sqlite) + #:autoload (gcrypt hash) (sha256) + #:autoload (rnrs bytevectors) (string->utf8) #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) #:use-module (srfi srfi-64) @@ -220,14 +222,15 @@ (define (manifest-entry->list entry) (close-inferior inferior) result)) -(test-equal "inferior-eval-with-store" - (add-text-to-store %store "foo" "Hello, world!") +(test-assert "inferior-eval-with-store" (let* ((inferior (open-inferior %top-builddir - #:command "scripts/guix"))) - (inferior-eval-with-store inferior %store - '(lambda (store) - (add-text-to-store store "foo" - "Hello, world!"))))) + #:command "scripts/guix")) + (text (random-text))) + (string=? (inferior-eval-with-store inferior %store + `(lambda (store) + (add-text-to-store store "foo" + ,text))) + (store-path "text" (sha256 (string->utf8 text)) "foo")))) (test-assert "inferior-eval-with-store, &store-protocol-error" (let* ((inferior (open-inferior %top-builddir From patchwork Wed Jan 15 22:14:49 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: 37081 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 01AFB27BBE9; Wed, 15 Jan 2025 22:16:24 +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 953FD27BBE2 for ; Wed, 15 Jan 2025 22:16:24 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tYBgF-0003g4-KJ; 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 1tYBgC-0003dV-Fq for guix-patches@gnu.org; Wed, 15 Jan 2025 17:16:04 -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 1tYBgC-0004Ic-5n; Wed, 15 Jan 2025 17:16:04 -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=EEmkrxEMwEH54raUCy3OqS3sH9z13xWJZZYF6ieEMmU=; b=o8QpU5R9JvuGWZeuoIJqsIdb1P2K5JxzJGv7zz43wUxz0ZrUSywGuL+aqbLOI+Kx8oIn4/dBu3OVZ6buBUECWPzPXQfDO6/wZu6n0N65xicuDEdo1sZEdnVPq4S9qr1uACOO3Fh2LzNt7SjjdaHYJG8MKBLcocsCLdL2rYjSaTPJv8S57ZdtqwLAQgOoaDB+QqZlJkTSg9ogdG52z4NAZsvEhW307rA54KwuUwujX2l4FbI0M7GGdEHQ/kHNNvLk/gh+c4t/Vkg3BoQw/g4I54r1XoA4GJ74QiKWIjvwhQPkgOpHCe9IN2kuvQm08Lkcwq2hWYYlM9Yga9+d2x0BxQ==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tYBgB-0002tt-5j; Wed, 15 Jan 2025 17:16:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#75595] [PATCH 3/4] inferior: Store the bridge directory name in . 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 , 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.173697931611067 (code B ref 75595); Wed, 15 Jan 2025 22:16:03 +0000 Received: (at 75595) by debbugs.gnu.org; 15 Jan 2025 22:15:16 +0000 Received: from localhost ([127.0.0.1]:59080 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tYBfQ-0002sP-27 for submit@debbugs.gnu.org; Wed, 15 Jan 2025 17:15:16 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:36434) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tYBfF-0002lH-ST for 75595@debbugs.gnu.org; Wed, 15 Jan 2025 17:15:06 -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 1tYBfA-00042T-Jl; Wed, 15 Jan 2025 17:15:00 -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=EEmkrxEMwEH54raUCy3OqS3sH9z13xWJZZYF6ieEMmU=; b=Kg50xm9u2KiF5Sh3Sb7N KM8LIgaz74pqQ0Mw6dWn4hooFObcQrQNul3M9zqFKoiYflXQb6pOfRIU43x8Ka9y0PuwbyIzDrGLj mm6emc87CCqrd1N2YiQZe0Z+lZHbQP4i4hv6aPe7q98Big4EKd2slPaNbepofQnHJWVbDSkhbgm9C e7FhGpY4Uq9py0Tfswccto05HxTT88/5IkPkIdsPOe4F2UeIVGiPUhGtGsyr2daP1QzZ7PD7Ykjr7 DZ4wzecC7p+rOdxzhUoWInsq0TdRNZWQAl6Ea8iaJIijCcq0zm9oZNvZtQHxRBBMinn57LrV1C1Wy DtT8Mvo9CwsrWQ==; From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Wed, 15 Jan 2025 23:14:49 +0100 Message-ID: <5175258f93e27140a2fcc0d1f23e396c682091da.1736977759.git.ludo@gnu.org> 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 ()[bridge-directory]: New field. (port->inferior): Add #:bridge-directory and honor it. (close-inferior): Delete the bridge directory. (allocate-temporary-directory, inferior-bridge-directory): New procedures. (open-store-bridge!): Use it instead of ‘call-with-temporary-directory’. Co-authored-by: Christopher Baines Change-Id: Ie469e3f272f29054cc50b1e1afb2784521c2e2e2 --- guix/inferior.scm | 68 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 46 insertions(+), 22 deletions(-) diff --git a/guix/inferior.scm b/guix/inferior.scm index 8066cce2fc..ead6148667 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018-2024 Ludovic Courtès +;;; Copyright © 2018-2025 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,6 +36,7 @@ (define-module (guix inferior) &store-protocol-error)) #:use-module ((guix derivations) #:select (read-derivation-from-file)) + #:autoload (guix build syscalls) (mkdtemp!) #:use-module (guix gexp) #:use-module (guix search-paths) #:use-module (guix profiles) @@ -113,13 +114,15 @@ (define-module (guix inferior) ;; Inferior Guix process. (define-record-type - (inferior pid socket close version packages table - bridge-socket) + (inferior pid socket close version bridge-directory + packages table bridge-socket) inferior? (pid inferior-pid) (socket inferior-socket) (close inferior-close-socket) ;procedure (version inferior-version) ;REPL protocol version + (bridge-directory %inferior-bridge-directory ;#f | file name + set-inferior-bridge-directory!) (packages inferior-package-promise) ;promise of inferior packages (table inferior-package-table) ;promise of vhash @@ -233,6 +236,7 @@ (define* (port->inferior pipe #:optional (close close-port)) (match (read pipe) (('repl-version 0 rest ...) (letrec ((result (inferior 'pipe pipe close (cons 0 rest) + #f ;bridge directory (delay (%inferior-packages result)) (delay (%inferior-package-table result)) #f))) @@ -318,7 +322,14 @@ (define (close-inferior inferior) ;; Close and delete the store bridge, if any. (when (inferior-bridge-socket inferior) - (close-port (inferior-bridge-socket inferior))))) + (close-port (inferior-bridge-socket inferior))) + + ;; Delete the store bridge socket directory. + (when (%inferior-bridge-directory inferior) + (false-if-exception + (delete-file (in-vicinity (%inferior-bridge-directory inferior) + "inferior"))) + (rmdir (%inferior-bridge-directory inferior))))) ;; Non-self-quoting object of the inferior. (define-record-type @@ -656,6 +667,20 @@ (define (proxy inferior store) ;adapted from (guix ssh) (memq response-port reads)) (loop)))))) +(define (allocate-temporary-directory) + "Return the name of a fresh temporary directory." + (let* ((directory (or (getenv "TMPDIR") "/tmp")) + (template (string-append directory "/guix-inferior.XXXXXX"))) + (mkdtemp! template))) + +(define (inferior-bridge-directory inferior) + "Return the name of the directory shared between INFERIOR and its host to +contain the \"store bridge\"." + (or (%inferior-bridge-directory inferior) + (let ((directory (allocate-temporary-directory))) + (set-inferior-bridge-directory! inferior directory) + directory))) + (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 @@ -664,25 +689,24 @@ (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). - (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) + (let ((directory (inferior-bridge-directory inferior))) + (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))))) + (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." 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."