From patchwork Thu Oct 27 03:50:56 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 44149 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 C994E27BBEB; Thu, 27 Oct 2022 04:55:05 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.6 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_INVALID,DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,URIBL_BLOCKED,URI_HEX 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 A844427BBE9 for ; Thu, 27 Oct 2022 04:55:04 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ontwG-0002zn-OY; Wed, 26 Oct 2022 23:52:16 -0400 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 1ontw5-0002ik-Rm for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:07 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ontw1-0001QZ-Pd for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ontw1-00029S-LG for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#58812] [PATCH 1/5] Makefile.am: Sort EXTRA_DIST entries. References: <20221027034154.28435-1-maxim.cournoyer@gmail.com> In-Reply-To: <20221027034154.28435-1-maxim.cournoyer@gmail.com> Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 27 Oct 2022 03:52:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 58812 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 58812@debbugs.gnu.org Cc: Maxim Cournoyer Received: via spool by 58812-submit@debbugs.gnu.org id=B58812.16668426828170 (code B ref 58812); Thu, 27 Oct 2022 03:52:01 +0000 Received: (at 58812) by debbugs.gnu.org; 27 Oct 2022 03:51:22 +0000 Received: from localhost ([127.0.0.1]:55699 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ontvN-00027i-Re for submit@debbugs.gnu.org; Wed, 26 Oct 2022 23:51:22 -0400 Received: from mail-qv1-f48.google.com ([209.85.219.48]:45958) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ontvK-00027R-PY for 58812@debbugs.gnu.org; Wed, 26 Oct 2022 23:51:20 -0400 Received: by mail-qv1-f48.google.com with SMTP id j6so209737qvn.12 for <58812@debbugs.gnu.org>; Wed, 26 Oct 2022 20:51:18 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=r+QVyN6/PbHAP2xhF5z++AxkdcMVbiOuQBSnoBPpV30=; b=kOfFcHMKZat15qJaoBnxQnTFS59AccPZUrcZenyNXPOkuQ7quLLMnA+TCANem/kSSk VN3YjS/eqHBOq01lK7ykckVaSJSy93X6IUXIEwnwvICQoYnxCOdhb8vnBzOgZssfRZ70 pOrJqCFQxilLuqOf3C2Rq4GsEhv46QPn4LyXwkHjiNH3c66wI7AQSq2ZBsmU9TgC/uF7 UjaB/M9zXYz3IC8TNNCgwg46Mocl+/yNtj9DgSx6FKKUg06E056KI77Zq5cEmo3V73NO +qvxhompFmGtXTJXAT+kww1Xc7gYZ2InooysVCYLCTvcVo6zrudcH8iHp1jHle4H+yE3 qqug== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=r+QVyN6/PbHAP2xhF5z++AxkdcMVbiOuQBSnoBPpV30=; b=W7uxaym3wMuly7YsPMRnZ1D2iPf59rysGSyYrgyJ6Cr0MM5TusmwVXy9kDimxN782x tLrA0JSmELMSOGpoSdswzsR32Pcu2QtSC23v+b6I9wJ1HAtzy6OH8Txj+m6lo2BcGMqP 91uMVcVpvb0X5SsWSrqbuQIRD7TEQgwPqlvbnFM4L8gJ/PWSySv6SCimTGLHOe7boiU/ HFXfVQ+YwDu+YyUlh6p6UGhmHgc0Tigd/QC2xCtJo6ziOyQ3APL0ts5J1MF401Baws3P N9+VrzGvl4rJDmudKZnSrMmmsmAckIDkj8oDjGwnby/NVsLnT0g1FjYK/xFWo5y3VCCJ ey7g== X-Gm-Message-State: ACrzQf0DA1kdD9iRn1k/0EoRqBTdJweemt1taqXrQlyJtSeF8hKG1Qty g3nl0QjYwQk21Mf7Bg+pHxnknWz59c8= X-Google-Smtp-Source: AMsMyM5wu36xwuJ1Lb2fViZe9Np7qKeedUaZZJ3YktxTL+5vTs5TLWdW1fsMN6pXhIHWVIeWn5NM7w== X-Received: by 2002:ad4:5ca7:0:b0:4bb:97ea:27b5 with SMTP id q7-20020ad45ca7000000b004bb97ea27b5mr4584939qvh.104.1666842672944; Wed, 26 Oct 2022 20:51:12 -0700 (PDT) Received: from localhost.localdomain (dsl-152-21.b2b2c.ca. [66.158.152.21]) by smtp.gmail.com with ESMTPSA id x1-20020a05620a448100b006ec771d8f89sm255488qkp.112.2022.10.26.20.51.12 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 26 Oct 2022 20:51:12 -0700 (PDT) From: Maxim Cournoyer Date: Wed, 26 Oct 2022 23:50:56 -0400 Message-Id: <20221027035100.28852-1-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.37.3 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: , Sender: "Guix-patches" Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * Makefile.am (EXTRA_DIST): Sort. --- Makefile.am | 52 ++++++++++++++++++++++++++-------------------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/Makefile.am b/Makefile.am index 22dcc43f99..6cc7c0c4a0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -658,49 +658,49 @@ dist_fishcompletion_DATA = etc/completion/fish/guix.fish nodist_selinux_policy_DATA = etc/guix-daemon.cil EXTRA_DIST += \ - HACKING \ - ROADMAP \ - TODO \ - CODE-OF-CONDUCT \ .dir-locals.el \ .guix-authorizations \ .guix-channel \ - scripts/guix.in \ - etc/disarchive-manifest.scm \ - etc/guix-install.sh \ - etc/news.scm \ - etc/release-manifest.scm \ - etc/source-manifest.scm \ - etc/system-tests.scm \ - etc/time-travel-manifest.scm \ - etc/historical-authorizations \ + CODE-OF-CONDUCT \ + HACKING \ + ROADMAP \ + TODO \ + bootstrap \ build-aux/build-self.scm \ - build-aux/compile-all.scm \ - build-aux/cuirass/hurd-manifest.scm \ - build-aux/check-final-inputs-self-contained.scm \ build-aux/check-channel-news.scm \ + build-aux/check-final-inputs-self-contained.scm \ + build-aux/compile-all.scm \ build-aux/compile-as-derivation.scm \ + build-aux/config.rpath \ build-aux/convert-xref.scm \ + build-aux/cuirass/hurd-manifest.scm \ build-aux/generate-authors.scm \ build-aux/test-driver.scm \ - build-aux/update-guix-package.scm \ build-aux/update-NEWS.scm \ - tests/test.drv \ + build-aux/update-guix-package.scm \ + doc/build.scm \ + etc/disarchive-manifest.scm \ + etc/guix-install.sh \ + etc/historical-authorizations \ + etc/news.scm \ + etc/release-manifest.scm \ + etc/source-manifest.scm \ + etc/system-tests.scm \ + etc/time-travel-manifest.scm \ + scripts/guix.in \ tests/cve-sample.json \ - tests/keys/signing-key.pub \ - tests/keys/signing-key.sec \ tests/keys/civodul.pub \ - tests/keys/rsa.pub \ tests/keys/dsa.pub \ - tests/keys/ed25519.pub \ - tests/keys/ed25519.sec \ tests/keys/ed25519-2.pub \ tests/keys/ed25519-2.sec \ tests/keys/ed25519-3.pub \ tests/keys/ed25519-3.sec \ - build-aux/config.rpath \ - bootstrap \ - doc/build.scm \ + tests/keys/ed25519.pub \ + tests/keys/ed25519.sec \ + tests/keys/rsa.pub \ + tests/keys/signing-key.pub \ + tests/keys/signing-key.sec \ + tests/test.drv \ $(TESTS) if !BUILD_DAEMON_OFFLOAD From patchwork Thu Oct 27 03:50:57 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 44150 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 7EE9D27BBEB; Thu, 27 Oct 2022 04:55:44 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_INVALID,DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,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 1DBEE27BBE9 for ; Thu, 27 Oct 2022 04:55:43 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ontwE-0002q3-Me; Wed, 26 Oct 2022 23:52:15 -0400 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 1ontw4-0002iX-Q8 for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ontw2-0001Qa-CO for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ontw2-00029a-4r for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#58812] [PATCH 2/5] tests: Add a tests/utils.sh support file. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 27 Oct 2022 03:52:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 58812 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 58812@debbugs.gnu.org Cc: Maxim Cournoyer Received: via spool by 58812-submit@debbugs.gnu.org id=B58812.16668426878187 (code B ref 58812); Thu, 27 Oct 2022 03:52:02 +0000 Received: (at 58812) by debbugs.gnu.org; 27 Oct 2022 03:51:27 +0000 Received: from localhost ([127.0.0.1]:55702 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ontvS-00027z-Cz for submit@debbugs.gnu.org; Wed, 26 Oct 2022 23:51:26 -0400 Received: from mail-qt1-f174.google.com ([209.85.160.174]:41863) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ontvP-00027W-7N for 58812@debbugs.gnu.org; Wed, 26 Oct 2022 23:51:24 -0400 Received: by mail-qt1-f174.google.com with SMTP id c23so314049qtw.8 for <58812@debbugs.gnu.org>; Wed, 26 Oct 2022 20:51:23 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=mL2gSaxFm+dcFDnNEZn/yihf6iSJmqDld5LPoFpl9Yg=; b=WL9Mx2rmp9NXC9q+Ax1iJ1Y1hu6mr0KAB/qLt6JXeuFkA1FSxWIHbxbnsBk0lAdWb5 94CAvvTmRhbpcn0hBTO39bZQvtzTSmdRGtXlDsxFzRnK/XjXOTAOCufRjpfKzR70ZkXa 8s70gnRcY4VKbENfdXWrm1lAppanAtWpHcHU1IgdgrSoi7IpxWLfHAzS1Q1E7yhCoTvT RP1+UErVk7ckb2sAhhbA4qaxfhigQjjAuKFSM5q3t7+eRz44b1bZdZfPXX5V3M8otnwe RlgU18z3onmZ1cHDN3XgJ6nMeAdnNxsMRWLOj8dwCi1DVnTdtdt0+JR3R5ueoJ5Ytu/s 0wbA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=mL2gSaxFm+dcFDnNEZn/yihf6iSJmqDld5LPoFpl9Yg=; b=QPODv6ivEqK0+3ejayvgNi6RX/MUjDSqCfJXmdI3iz/nR4m2BkVZwgyrFV+wqX8cuO xPOBkvnSwFAsc/XdpFGZ9c15b9bP7hU8EwTPemGBK2tjq6vmyuIZdVPdlD9q9DJ0z423 Dq5UcTvPVgthgJt0SZIe0qQ/5W+YpslZEvhidt7I8nB7AQcHKrh8Yh4pp+0BKZSIzbi6 kTcuYgIwXV5LbdazWlh/PS2Z+4TNk7h5mR74hPGVtBRyjhYF4plG8q9iZphPWSurRjoX CEetTyKRRuYBVCcXRXnzdyx8jO+LDBTnb+f/F/Sst4Np2CRm9Fwi393HY8RWvglP1fEi J90Q== X-Gm-Message-State: ACrzQf0vpuyDWSZEiYMwSCJlmwiNXWs+Qlhrqo7lgQIR8TdnNlHhlz2p hFbF3nk5JRdyyON+8a5vuLE+vii2G/Q= X-Google-Smtp-Source: AMsMyM7S/XyodqgNQYfPLhlOt/12Fo/cubSgycghtzPz5mC4FH+7etMStHXilblomOzT8VAo79yWlw== X-Received: by 2002:ac8:7e84:0:b0:39d:fd1:5a1d with SMTP id w4-20020ac87e84000000b0039d0fd15a1dmr30753751qtj.169.1666842676561; Wed, 26 Oct 2022 20:51:16 -0700 (PDT) Received: from localhost.localdomain (dsl-152-21.b2b2c.ca. [66.158.152.21]) by smtp.gmail.com with ESMTPSA id x1-20020a05620a448100b006ec771d8f89sm255488qkp.112.2022.10.26.20.51.16 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 26 Oct 2022 20:51:16 -0700 (PDT) From: Maxim Cournoyer Date: Wed, 26 Oct 2022 23:50:57 -0400 Message-Id: <20221027035100.28852-2-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.37.3 In-Reply-To: <20221027035100.28852-1-maxim.cournoyer@gmail.com> References: <20221027035100.28852-1-maxim.cournoyer@gmail.com> 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: , Sender: "Guix-patches" Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches The purpose of this file will be to accumulate support shell functions for the shell-authored tests. * tests/shell-utils.scm: New file. * tests/utils.sh: Likewise. * Makefile.am (EXTRA_DIST): Register them. --- Makefile.am | 3 +++ tests/shell-utils.scm | 29 +++++++++++++++++++++++++++++ tests/utils.sh | 33 +++++++++++++++++++++++++++++++++ 3 files changed, 65 insertions(+) create mode 100644 tests/shell-utils.scm create mode 100644 tests/utils.sh diff --git a/Makefile.am b/Makefile.am index 6cc7c0c4a0..14cbdcb011 100644 --- a/Makefile.am +++ b/Makefile.am @@ -16,6 +16,7 @@ # Copyright © 2019 Efraim Flashner # Copyright © 2021 Chris Marusich # Copyright © 2021 Andrew Tropin +# Copyright © 2021, 2022 Maxim Cournoyer # # This file is part of GNU Guix. # @@ -700,7 +701,9 @@ EXTRA_DIST += \ tests/keys/rsa.pub \ tests/keys/signing-key.pub \ tests/keys/signing-key.sec \ + tests/shell-utils.scm \ tests/test.drv \ + tests/utils.sh \ $(TESTS) if !BUILD_DAEMON_OFFLOAD diff --git a/tests/shell-utils.scm b/tests/shell-utils.scm new file mode 100644 index 0000000000..3ae9a414cd --- /dev/null +++ b/tests/shell-utils.scm @@ -0,0 +1,29 @@ +;; GNU Guix --- Functional package management for GNU +;; Copyright © 2022 Maxim Cournoyer +;; +;; 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 . +;; +;; Commentary: +;; +;; This file contains procedures that support the shell functions defined in +;; tests/utils.sh. +(use-modules (gnu build linux-container)) + +(define (container-support?) + (unless (and (user-namespace-supported?) + (unprivileged-user-namespace-supported?) + (setgroups-supported?)) + (exit 1))) diff --git a/tests/utils.sh b/tests/utils.sh new file mode 100644 index 0000000000..ba17f0de15 --- /dev/null +++ b/tests/utils.sh @@ -0,0 +1,33 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2022 Maxim Cournoyer +# +# 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 . +# +# Commentary: +# +# This file provides utility shell functions that can be used in the shell +# test scripts. The file is intended to be sourced as a shell library. + +BASEDIR=$(dirname "$0") + +HAS_CONTAINER_SUPPORT= +has_container_support() { + if [ -z "$HAS_CONTAINER_SUPPORT" ]; then + guile -l "$BASEDIR/shell-utils.scm" -c '(container-support?)' + HAS_CONTAINER_SUPPORT=$? + fi + return "$HAS_CONTAINER_SUPPORT" +} From patchwork Thu Oct 27 03:50:58 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 44148 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 9E82527BBEB; Thu, 27 Oct 2022 04:54:03 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_INVALID,DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,SPF_HELO_PASS 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 6F94727BBEA for ; Thu, 27 Oct 2022 04:54:02 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ontwJ-0003IT-M1; Wed, 26 Oct 2022 23:52:20 -0400 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 1ontw5-0002ir-S9 for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:08 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ontw2-0001Qb-OB for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ontw2-00029h-Jh for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#58812] [PATCH 3/5] install: Validate symlink target in evaluate-populate-directive. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 27 Oct 2022 03:52:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 58812 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 58812@debbugs.gnu.org Cc: Maxim Cournoyer Received: via spool by 58812-submit@debbugs.gnu.org id=B58812.16668426938208 (code B ref 58812); Thu, 27 Oct 2022 03:52:02 +0000 Received: (at 58812) by debbugs.gnu.org; 27 Oct 2022 03:51:33 +0000 Received: from localhost ([127.0.0.1]:55705 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ontvY-00028K-UQ for submit@debbugs.gnu.org; Wed, 26 Oct 2022 23:51:33 -0400 Received: from mail-qt1-f169.google.com ([209.85.160.169]:45775) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ontvX-00027y-Et for 58812@debbugs.gnu.org; Wed, 26 Oct 2022 23:51:32 -0400 Received: by mail-qt1-f169.google.com with SMTP id x3so301684qtj.12 for <58812@debbugs.gnu.org>; Wed, 26 Oct 2022 20:51:31 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=lBkcrXstesL/RYcBdJo1quwLH1W3JOZ/ebtnOaJ5hnA=; b=HbVKAMNnEv1jYGZg/E3/OmgRuheAVsklxR0zKZw5pvwV/WTRHugqNghRWBxafc4Gdt 8f0weOchKjwLUu8hyTi2BTbE2j+nRqZHG/1NLdwFkpnoQF7w6lDnOE55E5E6diQA8xuR KRyzvIIXjqNoPBnzyJKbLNB5nsrzgqzmHof5jDbhRl0y+IuDyEXW27pwLKtw+armSiL5 dH5RbxZaJ2utBGPzsiXPgTCGfW3C2mLT7cL4adMNa51ZLwxfJEwV9aYrLnyAudRmrTgn KdvHBZX2vAUn1hoH3FBwsi240cqWrWmuFf2GgaltftNM6gT42FIwk29MPr8chVsu9j/w Xkmw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=lBkcrXstesL/RYcBdJo1quwLH1W3JOZ/ebtnOaJ5hnA=; b=pl+2yK4eARYNOwLUg1V/N1/rNr2qIKtUUs3KnfBTas3kEFpg5UGjahmGMXY8MAFvC6 F0r+GIVn9Ijbc4MYkNiMU6gcn1PBN0RV6PXDtp1Pqg8t0toBEBJoWi1+DWJRjWVnwfIE McXkPAKX0vWYNYs/seCifU8xRlxPH1RMzDxugx/7SIbSUClnSA+eOvpTVPDCoqTN9SBv yuHSkhX7uRZHCMaafvdsBJ3rFWM5+BkB+BwILqU2NBc6tJISi0x+9YQW5zkaHCOPzD6/ teVnonxGNGq5xfLagw3cSGW2sJvJAzctURBL7ftdyI4nJiSoHPKGPCTKFpP+UU3U/KLu i3bA== X-Gm-Message-State: ACrzQf3Iqj78y1NhUTv+6vD9LJ+7lW4C6E/uSB5pmPAmNiGcTknoOcsY zW4hIztaxdCAZgRBc+hbababW3Lf128= X-Google-Smtp-Source: AMsMyM5kviHnp/nHdY7YhkXb4eQqfKvE6v2znuY6182uuRdSEfMdy8spS1iEjqrZz1VpSCzS/Jw1yQ== X-Received: by 2002:a05:622a:512:b0:39a:d23a:431a with SMTP id l18-20020a05622a051200b0039ad23a431amr39392656qtx.370.1666842685640; Wed, 26 Oct 2022 20:51:25 -0700 (PDT) Received: from localhost.localdomain (dsl-152-21.b2b2c.ca. [66.158.152.21]) by smtp.gmail.com with ESMTPSA id x1-20020a05620a448100b006ec771d8f89sm255488qkp.112.2022.10.26.20.51.25 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 26 Oct 2022 20:51:25 -0700 (PDT) From: Maxim Cournoyer Date: Wed, 26 Oct 2022 23:50:58 -0400 Message-Id: <20221027035100.28852-3-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.37.3 In-Reply-To: <20221027035100.28852-1-maxim.cournoyer@gmail.com> References: <20221027035100.28852-1-maxim.cournoyer@gmail.com> 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: , Sender: "Guix-patches" Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * gnu/build/install.scm (evaluate-populate-directive): By default, error when the target of a symlink doesn't exist. Always ensure TARGET ends with "/". (populate-root-file-system): Call evaluate-populate-directive with #:error-on-dangling-symlink #t and add comment. --- gnu/build/install.scm | 60 ++++++++++++++++++++++++++++--------------- 1 file changed, 40 insertions(+), 20 deletions(-) diff --git a/gnu/build/install.scm b/gnu/build/install.scm index f5c8407b89..15cc29b2c8 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2016 Chris Marusich +;;; Copyright © 2022 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -56,19 +57,24 @@ (define (install-boot-config bootcfg bootcfg-location mount-point) (define* (evaluate-populate-directive directive target #:key (default-gid 0) - (default-uid 0)) + (default-uid 0) + (error-on-dangling-symlink? #t)) "Evaluate DIRECTIVE, an sexp describing a file or directory to create under directory TARGET. DEFAULT-UID and DEFAULT-GID are the default UID and GID in the context of the caller. If the directive matches those defaults then, -'chown' won't be run." +'chown' won't be run. When ERROR-ON-DANGLING-SYMLINK? is true, abort with an +error when a dangling symlink would be created." + (define target* (if (string-suffix? "/" target) + target + (string-append target "/"))) (let loop ((directive directive)) (catch 'system-error (lambda () (match directive (('directory name) - (mkdir-p (string-append target name))) + (mkdir-p (string-append target* name))) (('directory name uid gid) - (let ((dir (string-append target name))) + (let ((dir (string-append target* name))) (mkdir-p dir) ;; If called from a context without "root" permissions, "chown" ;; to root will fail. In that case, do not try to run "chown" @@ -78,27 +84,38 @@ (define* (evaluate-populate-directive directive target (chown dir uid gid)))) (('directory name uid gid mode) (loop `(directory ,name ,uid ,gid)) - (chmod (string-append target name) mode)) + (chmod (string-append target* name) mode)) (('file name) - (call-with-output-file (string-append target name) + (call-with-output-file (string-append target* name) (const #t))) (('file name (? string? content)) - (call-with-output-file (string-append target name) + (call-with-output-file (string-append target* name) (lambda (port) (display content port)))) ((new '-> old) - (let try () - (catch 'system-error - (lambda () - (symlink old (string-append target new))) - (lambda args - ;; When doing 'guix system init' on the current '/', some - ;; symlinks may already exists. Override them. - (if (= EEXIST (system-error-errno args)) - (begin - (delete-file (string-append target new)) - (try)) - (apply throw args)))))))) + (let ((new* (string-append target* new))) + (let try () + (catch 'system-error + (lambda () + (when error-on-dangling-symlink? + ;; When the symbolic link points to a relative path, + ;; checking if its target exists must be done relative to + ;; the link location. + (with-directory-excursion (if (string-prefix? "/" old) + (getcwd) + (dirname new*)) ;relative + (unless (file-exists? old) + (error (format #f "symlink `~a' points to nonexistent \ +file `~a'" new* old))))) + (symlink old new*)) + (lambda args + ;; When doing 'guix system init' on the current '/', some + ;; symlinks may already exists. Override them. + (if (= EEXIST (system-error-errno args)) + (begin + (delete-file new*) + (try)) + (apply throw args))))))))) (lambda args ;; Usually we can only get here when installing to an existing root, ;; as with 'guix system init foo.scm /'. @@ -142,7 +159,10 @@ (define* (populate-root-file-system system target includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM. EXTRAS is a list of directives appended to the built-in directives to populate TARGET." - (for-each (cut evaluate-populate-directive <> target) + ;; It's expected that some symbolic link targets do not exist yet, so do not + ;; error on dangling links. + (for-each (cut evaluate-populate-directive <> target + #:error-on-dangling-symlink? #f) (append (directives (%store-directory)) extras)) ;; Add system generation 1. From patchwork Thu Oct 27 03:50:59 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 44146 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 C2C1027BBE9; Thu, 27 Oct 2022 04:52:39 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_INVALID,DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,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 DEAD127BBEA for ; Thu, 27 Oct 2022 04:52:34 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ontwH-00032m-4D; Wed, 26 Oct 2022 23:52:17 -0400 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 1ontw6-0002it-0Y for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:08 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ontw3-0001Qc-5q for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ontw3-00029p-1m for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#58812] [PATCH 4/5] guix: shell: Add '--symlink' option. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 27 Oct 2022 03:52:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 58812 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 58812@debbugs.gnu.org Cc: Maxim Cournoyer Received: via spool by 58812-submit@debbugs.gnu.org id=B58812.16668426988232 (code B ref 58812); Thu, 27 Oct 2022 03:52:03 +0000 Received: (at 58812) by debbugs.gnu.org; 27 Oct 2022 03:51:38 +0000 Received: from localhost ([127.0.0.1]:55709 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ontvd-00028h-Cz for submit@debbugs.gnu.org; Wed, 26 Oct 2022 23:51:38 -0400 Received: from mail-qk1-f180.google.com ([209.85.222.180]:35464) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ontva-000289-0q for 58812@debbugs.gnu.org; Wed, 26 Oct 2022 23:51:34 -0400 Received: by mail-qk1-f180.google.com with SMTP id t25so59069qkm.2 for <58812@debbugs.gnu.org>; Wed, 26 Oct 2022 20:51:33 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=29aVTpeUdjJsL8lVL89s8hfCGp0QFSMpucAGwZp64Yg=; b=VtKk0+vPD9AXP47OBxX8BXnoCANd2enXxUKyMGpvvcX2itpLVbKiOciiQjb2PtK6+C WHwWmqQMeXspfvrdpwrXI6hGQYNUTK1cllEmr4JipHbUW1uiMjUAFiJTcBmXhVNd5rho /VTb2T+v8K/dwQmx07zHOw7SGhwSsZ9ckcnbiR6gKWfbvZ/DuSfPKXYVuKzX+DM7kEPH GEZYnehQphjR8H2rQxG2jNl3SJNv0LBiPoJiGUJ3KD1uD3i6gk9A/+s748mdYIdv/Go0 Bm6CAnufo8fubUFpYH1LxtMQ80F3zDA+057lQyUlS3/Fh73e8BXqRMBKRebIXf2S9LDV ggsA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=29aVTpeUdjJsL8lVL89s8hfCGp0QFSMpucAGwZp64Yg=; b=SkExV2tOeTfzprKKd6di4mFZY3pB/44jgae0yuyqXE3iKHnnLQ2ojDMEfrqXG27ch4 Ei1CDIWlx1ejxgzZyAPTnT8zBgJs6T5Uq09sM7TM37kTsTFwWt4cF9siIgZAaaLeKFl/ twFHiS456oqRUsTp7Dtvf7Vf8f7nECZdfptV19GhlKb5ky9Dd2IO4HhxwrMy7Ur4FJMX NpxmNWOdp20QLeeVbzV3QxKADnxKONCX8N5LbXxU+UGHO1NEj+K81ctGHIqYi1wneVkc PjjHOHW9O4wjLPnTZioLbW9gFQ/sDG9U4lkC7qHNToe3JIUxKHDDCHU+h68wCLnLjaEH 8Pwg== X-Gm-Message-State: ACrzQf3zugw4Y29VNq6LGO40zf/JFJebqkrb4AAfEaNPk1HemaE2qvom vc15t2r7yDmYJcXfqPlXFPtFN98pnUA= X-Google-Smtp-Source: AMsMyM6epFMwJjqBJnoA3oBCvzoSEYCSodz4hhWzRflMmhD40N8I5nICZpMlgs9R6r9hOlyRDVP5xg== X-Received: by 2002:a05:620a:6c5:b0:6f1:99b:a2b6 with SMTP id 5-20020a05620a06c500b006f1099ba2b6mr19626036qky.299.1666842688127; Wed, 26 Oct 2022 20:51:28 -0700 (PDT) Received: from localhost.localdomain (dsl-152-21.b2b2c.ca. [66.158.152.21]) by smtp.gmail.com with ESMTPSA id x1-20020a05620a448100b006ec771d8f89sm255488qkp.112.2022.10.26.20.51.27 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 26 Oct 2022 20:51:27 -0700 (PDT) From: Maxim Cournoyer Date: Wed, 26 Oct 2022 23:50:59 -0400 Message-Id: <20221027035100.28852-4-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.37.3 In-Reply-To: <20221027035100.28852-1-maxim.cournoyer@gmail.com> References: <20221027035100.28852-1-maxim.cournoyer@gmail.com> 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: , Sender: "Guix-patches" Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * guix/scripts/pack.scm (%options): Extract symlink parsing logic to... (symlink-spec-option-parser): ... here. (self-contained-tarball/builder): Extract symlink->directives logic to... * gnu/build/install.scm (make-symlink->directives): ... here. Add a comment mentioning why a relative file name is used for the link target. * guix/scripts/environment.scm (show-environment-options-help): Document new --symlink option. (%default-options): Add default value for symlinks. (%options): Register new symlink option. (launch-environment/container): Add #:symlinks argument and extend doc. Create symlinks using evaluate-populate-directive and make-symlink->directives. (guix-environment*): Pass symlinks arguments to launch-environment/container. * doc/guix.texi (Invoking guix shell): Document it. * tests/guix-shell.sh: Test it. --- doc/guix.texi | 9 +++++- gnu/build/install.scm | 18 ++++++++++++ guix/scripts/environment.scm | 38 +++++++++++++++++------- guix/scripts/pack.scm | 57 +++++++++++++++--------------------- tests/guix-shell.sh | 17 +++++++++++ 5 files changed, 94 insertions(+), 45 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 2f7ab61aec..4bd3c18223 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -49,7 +49,7 @@ Copyright @copyright{} 2017 humanitiesNerd@* Copyright @copyright{} 2017, 2021 Christine Lemmer-Webber@* Copyright @copyright{} 2017, 2018, 2019, 2020, 2021, 2022 Marius Bakke@* Copyright @copyright{} 2017, 2019, 2020, 2022 Hartmut Goebel@* -Copyright @copyright{} 2017, 2019, 2020, 2021 Maxim Cournoyer@* +Copyright @copyright{} 2017, 2019, 2020, 2021, 2022 Maxim Cournoyer@* Copyright @copyright{} 2017–2022 Tobias Geerinckx-Rice@* Copyright @copyright{} 2017 George Clemmer@* Copyright @copyright{} 2017 Andy Wingo@* @@ -6230,6 +6230,12 @@ directory: guix shell --container --expose=$HOME=/exchange guile -- guile @end example +@cindex symbolic links, guix shell +@item --symlink=@var{spec} +@itemx -S @var{spec} +For containers, create the symbolic links specified by @var{spec}, as +documented in @ref{pack-symlink-option}. + @cindex file system hierarchy standard (FHS) @cindex FHS (file system hierarchy standard) @item --emulate-fhs @@ -7022,6 +7028,7 @@ Compress the resulting tarball using @var{tool}---one of @code{gzip}, @code{zstd}, @code{bzip2}, @code{xz}, @code{lzip}, or @code{none} for no compression. +@anchor{pack-symlink-option} @item --symlink=@var{spec} @itemx -S @var{spec} Add the symlinks specified by @var{spec} to the pack. This option can diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 15cc29b2c8..8cf772f3ea 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -19,6 +19,7 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu build install) + #:use-module ((guix build union) #:select (relative-file-name)) #:use-module (guix build syscalls) #:use-module (guix build utils) #:use-module (guix build store-copy) @@ -26,6 +27,7 @@ (define-module (gnu build install) #:use-module (ice-9 match) #:export (install-boot-config evaluate-populate-directive + make-symlink->directives populate-root-file-system install-database-and-gc-roots populate-single-profile-directory @@ -124,6 +126,22 @@ (define target* (if (string-suffix? "/" target) directive) (apply throw args))))) +(define (make-symlink->directives directory) + "Return a procedure that turn symlinks specs into directives that target +DIRECTORY." + (match-lambda + ((source '-> target) + (let ((target (string-append directory "/" target)) + (parent (dirname source))) + ;; Never add a 'directory' directive for "/" so as to preserve its + ;; ownership and avoid adding the same entries multiple times. + `(,@(if (string=? parent "/") + '() + `((directory ,parent))) + ;; Note: a relative file name is used for compatibility with + ;; relocatable packs. + (,source -> ,(relative-file-name parent target))))))) + (define (directives store) "Return a list of directives to populate the root file system that will host STORE." diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index de9bc8f98d..bd95329c5c 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -33,8 +33,10 @@ (define-module (guix scripts environment) #:use-module ((guix gexp) #:select (lower-object)) #:use-module (guix scripts) #:use-module (guix scripts build) + #:use-module ((guix scripts pack) #:select (symlink-spec-option-parser)) #:use-module (guix transformations) #:autoload (ice-9 ftw) (scandir) + #:use-module (gnu build install) #:autoload (gnu build linux-container) (call-with-container %namespaces user-namespace-supported? unprivileged-user-namespace-supported? @@ -120,6 +122,9 @@ (define (show-environment-options-help) --expose=SPEC for containers, expose read-only host file system according to SPEC")) (display (G_ " + -S, --symlink=SPEC for containers, add symlinks to the profile according + to SPEC, e.g. \"/usr/bin/env=bin/env\".")) + (display (G_ " -v, --verbosity=LEVEL use the given verbosity LEVEL")) (display (G_ " --bootstrap use bootstrap binaries to build the environment"))) @@ -157,6 +162,7 @@ (define (show-help) (define %default-options `((system . ,(%current-system)) (substitutes? . #t) + (symlinks . ()) (offload? . #t) (graft? . #t) (print-build-trace? . #t) @@ -256,6 +262,7 @@ (define %options (alist-cons 'file-system-mapping (specification->file-system-mapping arg #f) result))) + (option '(#\S "symlink") #t #f symlink-spec-option-parser) (option '(#\r "root") #t #f (lambda (opt name arg result) (alist-cons 'gc-root arg result))) @@ -672,7 +679,7 @@ (define* (launch-environment/fork command profile manifest (define* (launch-environment/container #:key command bash user user-mappings profile manifest link-profile? network? map-cwd? emulate-fhs? (setup-hook #f) - (white-list '())) + (symlinks '()) (white-list '())) "Run COMMAND within a container that features the software in PROFILE. Environment variables are set according to the search paths of MANIFEST. The global shell is BASH, a file name for a GNU Bash binary in the store. When @@ -690,6 +697,9 @@ (define* (launch-environment/container #:key command bash user user-mappings LINK-PROFILE? creates a symbolic link from ~/.guix-profile to the environment profile. +SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be +added to the container. + Preserve environment variables whose name matches the one of the regexps in WHILE-LIST." (define (optional-mapping->fs mapping) @@ -797,6 +807,10 @@ (define fhs-mappings (mkdir-p home-dir) (setenv "HOME" home-dir) + ;; Create symlinks. + (for-each (cut evaluate-populate-directive <> ".") + (append-map (make-symlink->directives profile) symlinks)) + ;; Call an additional setup procedure, if provided. (when setup-hook (setup-hook profile)) @@ -970,6 +984,7 @@ (define (guix-environment* opts) (let* ((pure? (assoc-ref opts 'pure)) (container? (assoc-ref opts 'container?)) (link-prof? (assoc-ref opts 'link-profile?)) + (symlinks (assoc-ref opts 'symlinks)) (network? (assoc-ref opts 'network?)) (no-cwd? (assoc-ref opts 'no-cwd?)) (emulate-fhs? (assoc-ref opts 'emulate-fhs?)) @@ -1010,15 +1025,17 @@ (define-syntax-rule (with-store/maybe store exp ...) (when container? (assert-container-features)) - (when (and (not container?) link-prof?) - (leave (G_ "'--link-profile' cannot be used without '--container'~%"))) - (when (and (not container?) user) - (leave (G_ "'--user' cannot be used without '--container'~%"))) - (when (and (not container?) no-cwd?) - (leave (G_ "--no-cwd cannot be used without '--container'~%"))) - (when (and (not container?) emulate-fhs?) - (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'"))) - + (when (not container?) + (when link-prof? + (leave (G_ "'--link-profile' cannot be used without '--container'~%"))) + (when user + (leave (G_ "'--user' cannot be used without '--container'~%"))) + (when no-cwd? + (leave (G_ "--no-cwd cannot be used without '--container'~%"))) + (when emulate-fhs? + (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'"))) + (when (pair? symlinks) + (leave (G_ "'--symlink' cannot be used without '--container~%'")))) (with-store/maybe store (with-status-verbosity (assoc-ref opts 'verbosity) @@ -1099,6 +1116,7 @@ (define manifest #:network? network? #:map-cwd? (not no-cwd?) #:emulate-fhs? emulate-fhs? + #:symlinks symlinks #:setup-hook (and emulate-fhs? setup-fhs)))) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 06849e4761..e3bddc4274 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -61,7 +61,9 @@ (define-module (guix scripts pack) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:use-module (ice-9 match) - #:export (self-contained-tarball + #:export (symlink-spec-option-parser + + self-contained-tarball debian-archive docker-image squashfs-image @@ -160,6 +162,21 @@ (define str (string-join names "-")) ((_) str) ((names ... _) (loop names)))))) +(define (symlink-spec-option-parser opt name arg result) + "A SRFI-37 option parser for the --symlink option." + ;; Note: Using 'string-split' allows us to handle empty + ;; TARGET (as in "/opt/guile=", meaning that /opt/guile is + ;; a symlink to the profile) correctly. + (match (string-split arg (char-set #\=)) + ((source target) + (let ((symlinks (assoc-ref result 'symlinks))) + (alist-cons 'symlinks + `((,source -> ,target) ,@symlinks) + (alist-delete 'symlinks result eq?)))) + (x + (leave (G_ "~a: invalid symlink specification~%") + arg)))) + ;;; ;;; Tarball format. @@ -204,30 +221,15 @@ (define (import-module? module) (use-modules (guix build pack) (guix build store-copy) (guix build utils) - ((guix build union) #:select (relative-file-name)) (gnu build install) (srfi srfi-1) - (srfi srfi-26) - (ice-9 match)) + (srfi srfi-26)) (define %root "root") - (define symlink->directives - ;; Return "populate directives" to make the given symlink and its - ;; parent directories. - (match-lambda - ((source '-> target) - (let ((target (string-append #$profile "/" target)) - (parent (dirname source))) - ;; Never add a 'directory' directive for "/" so as to - ;; preserve its ownership when extracting the archive (see - ;; below), and also because this would lead to adding the - ;; same entries twice in the tarball. - `(,@(if (string=? parent "/") - '() - `((directory ,parent))) - (,source - -> ,(relative-file-name parent target))))))) + ;; Return "populate directives" to make the given symlink and its + ;; parent directories. + (define symlink->directives (make-symlink->directives #$profile)) (define directives ;; Fully-qualified symlinks. @@ -1208,20 +1210,7 @@ (define %options (lambda (opt name arg result) (alist-cons 'compressor (lookup-compressor arg) result))) - (option '(#\S "symlink") #t #f - (lambda (opt name arg result) - ;; Note: Using 'string-split' allows us to handle empty - ;; TARGET (as in "/opt/guile=", meaning that /opt/guile is - ;; a symlink to the profile) correctly. - (match (string-split arg (char-set #\=)) - ((source target) - (let ((symlinks (assoc-ref result 'symlinks))) - (alist-cons 'symlinks - `((,source -> ,target) ,@symlinks) - (alist-delete 'symlinks result eq?)))) - (x - (leave (G_ "~a: invalid symlink specification~%") - arg))))) + (option '(#\S "symlink") #t #f symlink-spec-option-parser) (option '("save-provenance") #f #f (lambda (opt name arg result) (alist-cons 'save-provenance? #t result))) diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh index 9a6b055264..32dd997fe7 100644 --- a/tests/guix-shell.sh +++ b/tests/guix-shell.sh @@ -20,6 +20,8 @@ # Test the 'guix shell' alias. # +. tests/utils.sh + guix shell --version configdir="t-guix-shell-config-$$" @@ -32,6 +34,21 @@ export XDG_CONFIG_HOME guix shell --bootstrap --pure guile-bootstrap -- guile --version +# '--symlink' can only be used with --container. +! guix shell --bootstrap guile-bootstrap -S /dummy=bin/guile + +if has_container_support; then + # '--symlink' works. + echo "TESTING SYMLINK IN CONTAINER" + guix shell --bootstrap guile-bootstrap --container \ + --symlink=/usr/bin/guile=bin/guile -- \ + /usr/bin/guile --version + + # A bad symlink spec causes the command to fail. + ! guix shell --bootstrap -CS bin/guile=/usr/bin/guile guile-bootstrap \ + -- exit +fi + # '--ad-hoc' is a thing of the past. ! guix shell --ad-hoc guile-bootstrap From patchwork Thu Oct 27 03:51:00 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Maxim Cournoyer X-Patchwork-Id: 44147 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 6BBE027BBEB; Thu, 27 Oct 2022 04:54:00 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_INVALID,DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,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 AE45327BBE9 for ; Thu, 27 Oct 2022 04:53:56 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ontwI-0003Fc-MW; Wed, 26 Oct 2022 23:52:18 -0400 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 1ontw5-0002io-Rm for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:07 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ontw3-0001Qd-ML for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ontw3-00029w-ID for guix-patches@gnu.org; Wed, 26 Oct 2022 23:52:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#58812] [PATCH 5/5] shell: Detect --symlink spec problems early. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 27 Oct 2022 03:52:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 58812 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 58812@debbugs.gnu.org Cc: Maxim Cournoyer Received: via spool by 58812-submit@debbugs.gnu.org id=B58812.16668427028243 (code B ref 58812); Thu, 27 Oct 2022 03:52:03 +0000 Received: (at 58812) by debbugs.gnu.org; 27 Oct 2022 03:51:42 +0000 Received: from localhost ([127.0.0.1]:55711 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ontvh-00028s-Ab for submit@debbugs.gnu.org; Wed, 26 Oct 2022 23:51:42 -0400 Received: from mail-qk1-f176.google.com ([209.85.222.176]:46838) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ontvb-00028C-T6 for 58812@debbugs.gnu.org; Wed, 26 Oct 2022 23:51:37 -0400 Received: by mail-qk1-f176.google.com with SMTP id z30so34610qkz.13 for <58812@debbugs.gnu.org>; Wed, 26 Oct 2022 20:51:35 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=A1ut3YEaGjGeXf1OIwfqmBwfVEkyF0UR5QNsemaZYaI=; b=iTMlHyLulotGLwQsRLsp+O4hz4TiQ35aiksbxfPlTe+0nXNuk6gYJIo8rVmKJKmr8z xad3tfCN2d8pq77yWzkDD5mwLsHvB1vxrlnFoFSpEb4pCEVhnO6FOsomVpF2Nk7sif2I vyRM+0lyssFsuHq12zpHif2uXg2YZngSUJ7TgBwoX1FKjvJEqelq+bbrfi+L3ok6xSbu Ck8xDDadyFDMLBtsARIrctjcXhxCGi8JYw+XaZBNlmm0GgFKxeKxnfpEg7KQa1q+AA7y eajJ/6lGyT7POKZ0XQ8XHwZaemwdVrDUpk8qSo8OVGcyd18Ghv/2C6N5CrKv5FBVqmeA xfhQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=A1ut3YEaGjGeXf1OIwfqmBwfVEkyF0UR5QNsemaZYaI=; b=48aaysVevFgvwOPqncoPfPRs5DRQZm1nTp+0gvO6HfrWHoRQKX+EOEOr2/26/CVJKy KDCSEGBNLyD1qgijioz88cJ9QhXYE5zrIaIxyH2N0AmH10Sr+KOmE9rGZlUq38tV77nK +f6+V2ze4jm+fhDE8YRirjRl24soSadGULUeTyI6dO6VGocAz5zrwrwFedL1eTg7UPfM 4oFz6cGBw+UfEZHvT1yVPFoGybTs8UhfcsgU0GgMSigS30djhDiwFQA0i3ztZHxDGWCU Iv/V+R7CY4PvlfV0oSmxnzttdJ2tSMoRt4ju88jyHCVa0z9tbFN2ukoN2asSuwTHJwya 8d9w== X-Gm-Message-State: ACrzQf2ZeqUHvEr/uTYB+G+lnN/8NmjZyqwgIOWAWUIbxIG2eHBkU7EG rYnsNl8R7+OaAp6w5HUqnrVvXV6YkMg= X-Google-Smtp-Source: AMsMyM6i62fbJWS0PSUcJLi7VJxfNjPBRx31HQ+4VEVVF5dZ16CvMUq8A8S/GJMI72x4nXzaVhYvZQ== X-Received: by 2002:a05:620a:4454:b0:6ee:764b:b7fc with SMTP id w20-20020a05620a445400b006ee764bb7fcmr32752980qkp.619.1666842689928; Wed, 26 Oct 2022 20:51:29 -0700 (PDT) Received: from localhost.localdomain (dsl-152-21.b2b2c.ca. [66.158.152.21]) by smtp.gmail.com with ESMTPSA id x1-20020a05620a448100b006ec771d8f89sm255488qkp.112.2022.10.26.20.51.29 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 26 Oct 2022 20:51:29 -0700 (PDT) From: Maxim Cournoyer Date: Wed, 26 Oct 2022 23:51:00 -0400 Message-Id: <20221027035100.28852-5-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.37.3 In-Reply-To: <20221027035100.28852-1-maxim.cournoyer@gmail.com> References: <20221027035100.28852-1-maxim.cournoyer@gmail.com> 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: , Sender: "Guix-patches" Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * guix/scripts/pack.scm (symlink-spec-option-parser): Remove extraneous char-set. Raise an exception when the target is an absolute file name. (guix-pack): Move with-error-handler earlier. * guix/scripts/shell.scm (guix-shell): Likewise. * guix/scripts/environment.scm (guix-environment): Wrap the whole guix-environment* call with the with-error-handling handler. * tests/guix-shell.sh: Add test. * tests/guix-pack.sh: Adjust symlink spec. --- guix/scripts/environment.scm | 294 +++++++++++++++++------------------ guix/scripts/pack.scm | 155 ++++++++++-------- guix/scripts/shell.scm | 77 ++++----- tests/guix-pack.sh | 2 +- tests/guix-shell.sh | 6 +- 5 files changed, 278 insertions(+), 256 deletions(-) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index bd95329c5c..0906b48508 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -975,158 +975,158 @@ (define-command (guix-environment . args) (category development) (synopsis "spawn one-off software environments (deprecated)") - (guix-environment* (parse-args args))) + (with-error-handling + (guix-environment* (parse-args args)))) (define (guix-environment* opts) "Run the 'guix environment' command on OPTS, an alist resulting for command-line option processing with 'parse-command-line'." - (with-error-handling - (let* ((pure? (assoc-ref opts 'pure)) - (container? (assoc-ref opts 'container?)) - (link-prof? (assoc-ref opts 'link-profile?)) - (symlinks (assoc-ref opts 'symlinks)) - (network? (assoc-ref opts 'network?)) - (no-cwd? (assoc-ref opts 'no-cwd?)) - (emulate-fhs? (assoc-ref opts 'emulate-fhs?)) - (user (assoc-ref opts 'user)) - (bootstrap? (assoc-ref opts 'bootstrap?)) - (system (assoc-ref opts 'system)) - (profile (assoc-ref opts 'profile)) - (command (or (assoc-ref opts 'exec) - ;; Spawn a shell if the user didn't specify - ;; anything in particular. - (if container? - ;; The user's shell is likely not available - ;; within the container. - '("/bin/sh") - (list %default-shell)))) - (mappings (pick-all opts 'file-system-mapping)) - (white-list (pick-all opts 'inherit-regexp))) - - (define store-needed? - ;; Whether connecting to the daemon is needed. - (or container? (not profile))) - - (define-syntax-rule (with-store/maybe store exp ...) - ;; Evaluate EXP... with STORE bound to a connection, unless - ;; STORE-NEEDED? is false, in which case STORE is bound to #f. - (let ((proc (lambda (store) exp ...))) - (if store-needed? - (with-store s - (set-build-options-from-command-line s opts) - (with-build-handler (build-notifier #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:verbosity - (assoc-ref opts 'verbosity) - #:dry-run? - (assoc-ref opts 'dry-run?)) - (proc s))) - (proc #f)))) - - (when container? (assert-container-features)) - - (when (not container?) - (when link-prof? - (leave (G_ "'--link-profile' cannot be used without '--container'~%"))) - (when user - (leave (G_ "'--user' cannot be used without '--container'~%"))) - (when no-cwd? - (leave (G_ "--no-cwd cannot be used without '--container'~%"))) - (when emulate-fhs? - (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'"))) - (when (pair? symlinks) - (leave (G_ "'--symlink' cannot be used without '--container~%'")))) - - (with-store/maybe store - (with-status-verbosity (assoc-ref opts 'verbosity) - (define manifest-from-opts - (options/resolve-packages store opts)) - - (define manifest - (if profile - (profile-manifest profile) - manifest-from-opts)) - - (when (and profile - (> (length (manifest-entries manifest-from-opts)) 0)) - (leave (G_ "'--profile' cannot be used with package options~%"))) - - (when (null? (manifest-entries manifest)) - (warning (G_ "no packages specified; creating an empty environment~%"))) - - ;; Use the bootstrap Guile when requested. - (parameterize ((%graft? (assoc-ref opts 'graft?)) - (%guile-for-build - (and store-needed? - (package-derivation - store - (if bootstrap? - %bootstrap-guile - (default-guile)))))) - (run-with-store store - ;; Containers need a Bourne shell at /bin/sh. - (mlet* %store-monad ((bash (environment-bash container? - bootstrap? - system)) - (prof-drv (if profile - (return #f) - (manifest->derivation - manifest system bootstrap?))) - (profile -> (if profile - (readlink* profile) - (derivation->output-path prof-drv))) - (gc-root -> (assoc-ref opts 'gc-root))) - - ;; First build the inputs. This is necessary even for - ;; --search-paths. Additionally, we might need to build bash for - ;; a container. - (mbegin %store-monad - (mwhen store-needed? - (built-derivations (append - (if prof-drv (list prof-drv) '()) - (if (derivation? bash) (list bash) '())))) - (mwhen gc-root - (register-gc-root profile gc-root)) - - (mwhen (assoc-ref opts 'check?) - (return - (if container? - (warning (G_ "'--check' is unnecessary \ + (let* ((pure? (assoc-ref opts 'pure)) + (container? (assoc-ref opts 'container?)) + (link-prof? (assoc-ref opts 'link-profile?)) + (symlinks (assoc-ref opts 'symlinks)) + (network? (assoc-ref opts 'network?)) + (no-cwd? (assoc-ref opts 'no-cwd?)) + (emulate-fhs? (assoc-ref opts 'emulate-fhs?)) + (user (assoc-ref opts 'user)) + (bootstrap? (assoc-ref opts 'bootstrap?)) + (system (assoc-ref opts 'system)) + (profile (assoc-ref opts 'profile)) + (command (or (assoc-ref opts 'exec) + ;; Spawn a shell if the user didn't specify + ;; anything in particular. + (if container? + ;; The user's shell is likely not available + ;; within the container. + '("/bin/sh") + (list %default-shell)))) + (mappings (pick-all opts 'file-system-mapping)) + (white-list (pick-all opts 'inherit-regexp))) + + (define store-needed? + ;; Whether connecting to the daemon is needed. + (or container? (not profile))) + + (define-syntax-rule (with-store/maybe store exp ...) + ;; Evaluate EXP... with STORE bound to a connection, unless + ;; STORE-NEEDED? is false, in which case STORE is bound to #f. + (let ((proc (lambda (store) exp ...))) + (if store-needed? + (with-store s + (set-build-options-from-command-line s opts) + (with-build-handler (build-notifier #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:verbosity + (assoc-ref opts 'verbosity) + #:dry-run? + (assoc-ref opts 'dry-run?)) + (proc s))) + (proc #f)))) + + (when container? (assert-container-features)) + + (when (not container?) + (when link-prof? + (leave (G_ "'--link-profile' cannot be used without '--container'~%"))) + (when user + (leave (G_ "'--user' cannot be used without '--container'~%"))) + (when no-cwd? + (leave (G_ "--no-cwd cannot be used without '--container'~%"))) + (when emulate-fhs? + (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'"))) + (when (pair? symlinks) + (leave (G_ "'--symlink' cannot be used without '--container~%'")))) + + (with-store/maybe store + (with-status-verbosity (assoc-ref opts 'verbosity) + (define manifest-from-opts + (options/resolve-packages store opts)) + + (define manifest + (if profile + (profile-manifest profile) + manifest-from-opts)) + + (when (and profile + (> (length (manifest-entries manifest-from-opts)) 0)) + (leave (G_ "'--profile' cannot be used with package options~%"))) + + (when (null? (manifest-entries manifest)) + (warning (G_ "no packages specified; creating an empty environment~%"))) + + ;; Use the bootstrap Guile when requested. + (parameterize ((%graft? (assoc-ref opts 'graft?)) + (%guile-for-build + (and store-needed? + (package-derivation + store + (if bootstrap? + %bootstrap-guile + (default-guile)))))) + (run-with-store store + ;; Containers need a Bourne shell at /bin/sh. + (mlet* %store-monad ((bash (environment-bash container? + bootstrap? + system)) + (prof-drv (if profile + (return #f) + (manifest->derivation + manifest system bootstrap?))) + (profile -> (if profile + (readlink* profile) + (derivation->output-path prof-drv))) + (gc-root -> (assoc-ref opts 'gc-root))) + + ;; First build the inputs. This is necessary even for + ;; --search-paths. Additionally, we might need to build bash for + ;; a container. + (mbegin %store-monad + (mwhen store-needed? + (built-derivations (append + (if prof-drv (list prof-drv) '()) + (if (derivation? bash) (list bash) '())))) + (mwhen gc-root + (register-gc-root profile gc-root)) + + (mwhen (assoc-ref opts 'check?) + (return + (if container? + (warning (G_ "'--check' is unnecessary \ when using '--container'; doing nothing~%")) - (validate-child-shell-environment profile manifest)))) - - (cond - ((assoc-ref opts 'search-paths) - (show-search-paths profile manifest #:pure? pure?) - (return #t)) - (container? - (let ((bash-binary - (if bootstrap? - (derivation->output-path bash) - (string-append (derivation->output-path bash) - "/bin/sh")))) - (launch-environment/container #:command command - #:bash bash-binary - #:user user - #:user-mappings mappings - #:profile profile - #:manifest manifest - #:white-list white-list - #:link-profile? link-prof? - #:network? network? - #:map-cwd? (not no-cwd?) - #:emulate-fhs? emulate-fhs? - #:symlinks symlinks - #:setup-hook - (and emulate-fhs? - setup-fhs)))) - - (else - (return - (exit/status - (launch-environment/fork command profile manifest - #:white-list white-list - #:pure? pure?)))))))))))))) + (validate-child-shell-environment profile manifest)))) + + (cond + ((assoc-ref opts 'search-paths) + (show-search-paths profile manifest #:pure? pure?) + (return #t)) + (container? + (let ((bash-binary + (if bootstrap? + (derivation->output-path bash) + (string-append (derivation->output-path bash) + "/bin/sh")))) + (launch-environment/container #:command command + #:bash bash-binary + #:user user + #:user-mappings mappings + #:profile profile + #:manifest manifest + #:white-list white-list + #:link-profile? link-prof? + #:network? network? + #:map-cwd? (not no-cwd?) + #:emulate-fhs? emulate-fhs? + #:symlinks symlinks + #:setup-hook + (and emulate-fhs? + setup-fhs)))) + + (else + (return + (exit/status + (launch-environment/fork command profile manifest + #:white-list white-list + #:pure? pure?))))))))))))) ;;; Local Variables: ;;; eval: (put 'with-store/maybe 'scheme-indent-function 1) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index e3bddc4274..a101900736 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -42,6 +42,7 @@ (define-module (guix scripts pack) #:use-module (guix profiles) #:use-module (guix describe) #:use-module (guix derivations) + #:use-module (guix diagnostics) #:use-module (guix search-paths) #:use-module (guix build-system gnu) #:use-module (guix scripts build) @@ -59,6 +60,7 @@ (define-module (guix scripts pack) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) #:use-module (ice-9 match) #:export (symlink-spec-option-parser @@ -163,12 +165,27 @@ (define str (string-join names "-")) ((names ... _) (loop names)))))) (define (symlink-spec-option-parser opt name arg result) - "A SRFI-37 option parser for the --symlink option." + "A SRFI-37 option parser for the --symlink option. The symlink spec accepts +the link file name as its left-hand side value and its target as its +right-hand side value. The target must be a relative link." ;; Note: Using 'string-split' allows us to handle empty ;; TARGET (as in "/opt/guile=", meaning that /opt/guile is ;; a symlink to the profile) correctly. - (match (string-split arg (char-set #\=)) + (match (string-split arg #\=) ((source target) + (when (string-prefix? "/" target) + (raise-exception + (make-compound-condition + (formatted-message (G_ "symlink target is absolute: '~a'~%") target) + (condition + (&fix-hint (hint (format #f (G_ "The target of the symlink must be +relative rather than absolute, as it is relative to the profile created. +Perhaps the source and target components of the symlink spec were inverted? +Below is a valid example, where the @file{/usr/bin/env} symbolic link is to +target the profile's @file{bin/env} file: +@example +--symlink=/usr/bin/env=bin/env +@end example")))))))) (let ((symlinks (assoc-ref result 'symlinks))) (alist-cons 'symlinks `((,source -> ,target) ,@symlinks) @@ -1310,74 +1327,74 @@ (define-command (guix-pack . args) (category development) (synopsis "create application bundles") - (define opts - (parse-command-line args %options (list %default-options))) - - (define maybe-package-argument - ;; Given an option pair, return a package, a package/output tuple, or #f. - (match-lambda - (('argument . spec) - (call-with-values - (lambda () - (specification->package+output spec)) - list)) - (('expression . exp) - (read/eval-package-expression exp)) - (x #f))) - - (define (manifest-from-args store opts) - (let* ((transform (options->transformation opts)) - (packages (map (match-lambda - (((? package? package) output) - (list (transform package) output)) - ((? package? package) - (list (transform package) "out"))) - (reverse - (filter-map maybe-package-argument opts)))) - (manifests (filter-map (match-lambda - (('manifest . file) file) - (_ #f)) - opts))) - (define with-provenance - (if (assoc-ref opts 'save-provenance?) - (lambda (manifest) - (map-manifest-entries - (lambda (entry) - (let ((entry (manifest-entry-with-provenance entry))) - (unless (assq 'provenance (manifest-entry-properties entry)) - (warning (G_ "could not determine provenance of package ~a~%") - (manifest-entry-name entry))) - entry)) - manifest)) - identity)) - - (with-provenance - (cond - ((and (not (null? manifests)) (not (null? packages))) - (leave (G_ "both a manifest and a package list were given~%"))) - ((not (null? manifests)) - (concatenate-manifests - (map (lambda (file) - (let ((user-module (make-user-module - '((guix profiles) (gnu))))) - (load* file user-module))) - manifests))) - (else - (packages->manifest packages)))))) - - (define (process-file-arg opts name) - ;; Validate that the file exists and return it as a object, - ;; else #f. - (let ((value (assoc-ref opts name))) - (match value - ((and (? string?) (not (? file-exists?))) - (leave (G_ "file provided with option ~a does not exist: ~a~%") - (string-append "--" (symbol->string name)) value)) - ((? string?) - (local-file value)) - (#f #f)))) - (with-error-handling + (define opts + (parse-command-line args %options (list %default-options))) + + (define maybe-package-argument + ;; Given an option pair, return a package, a package/output tuple, or #f. + (match-lambda + (('argument . spec) + (call-with-values + (lambda () + (specification->package+output spec)) + list)) + (('expression . exp) + (read/eval-package-expression exp)) + (x #f))) + + (define (manifest-from-args store opts) + (let* ((transform (options->transformation opts)) + (packages (map (match-lambda + (((? package? package) output) + (list (transform package) output)) + ((? package? package) + (list (transform package) "out"))) + (reverse + (filter-map maybe-package-argument opts)))) + (manifests (filter-map (match-lambda + (('manifest . file) file) + (_ #f)) + opts))) + (define with-provenance + (if (assoc-ref opts 'save-provenance?) + (lambda (manifest) + (map-manifest-entries + (lambda (entry) + (let ((entry (manifest-entry-with-provenance entry))) + (unless (assq 'provenance (manifest-entry-properties entry)) + (warning (G_ "could not determine provenance of package ~a~%") + (manifest-entry-name entry))) + entry)) + manifest)) + identity)) + + (with-provenance + (cond + ((and (not (null? manifests)) (not (null? packages))) + (leave (G_ "both a manifest and a package list were given~%"))) + ((not (null? manifests)) + (concatenate-manifests + (map (lambda (file) + (let ((user-module (make-user-module + '((guix profiles) (gnu))))) + (load* file user-module))) + manifests))) + (else + (packages->manifest packages)))))) + + (define (process-file-arg opts name) + ;; Validate that the file exists and return it as a object, + ;; else #f. + (let ((value (assoc-ref opts name))) + (match value + ((and (? string?) (not (? file-exists?))) + (leave (G_ "file provided with option ~a does not exist: ~a~%") + (string-append "--" (symbol->string name)) value)) + ((? string?) + (local-file value)) + (#f #f)))) + (with-store store (with-status-verbosity (assoc-ref opts 'verbosity) ;; Set the build options before we do anything else. diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm index a2836629ad..7708ce62a9 100644 --- a/guix/scripts/shell.scm +++ b/guix/scripts/shell.scm @@ -533,43 +533,44 @@ (define-command (guix-shell . args) (category development) (synopsis "spawn one-off software environments") - (define (cache-entries directory) - (filter-map (match-lambda - ((or "." "..") #f) - (file (string-append directory "/" file))) - (or (scandir directory) '()))) - - (define* (entry-expiration file) - ;; Return the time at which FILE, a cached profile, is considered expired. - (match (false-if-exception (lstat file)) - (#f 0) ;FILE may have been deleted in the meantime - (st (+ (stat:atime st) (* 60 60 24 7))))) - - (define opts - (parse-args args)) - - (define interactive? - (not (assoc-ref opts 'exec))) - - (if (assoc-ref opts 'check?) - (record-hint 'shell-check) - (when (and interactive? - (not (hint-given? 'shell-check)) - (not (assoc-ref opts 'container?)) - (not (assoc-ref opts 'search-paths))) - (display-hint (G_ "Consider passing the @option{--check} option once + (with-error-handling + (define (cache-entries directory) + (filter-map (match-lambda + ((or "." "..") #f) + (file (string-append directory "/" file))) + (or (scandir directory) '()))) + + (define* (entry-expiration file) + ;; Return the time at which FILE, a cached profile, is considered expired. + (match (false-if-exception (lstat file)) + (#f 0) ;FILE may have been deleted in the meantime + (st (+ (stat:atime st) (* 60 60 24 7))))) + + (define opts + (parse-args args)) + + (define interactive? + (not (assoc-ref opts 'exec))) + + (if (assoc-ref opts 'check?) + (record-hint 'shell-check) + (when (and interactive? + (not (hint-given? 'shell-check)) + (not (assoc-ref opts 'container?)) + (not (assoc-ref opts 'search-paths))) + (display-hint (G_ "Consider passing the @option{--check} option once to make sure your shell does not clobber environment variables."))) ) - ;; Clean the cache in EXIT-HOOK so that (1) it happens after potential use - ;; of cached profiles, and (2) cleanup actually happens, even when - ;; 'guix-environment*' calls 'exit'. - (add-hook! exit-hook - (lambda _ - (maybe-remove-expired-cache-entries - (%profile-cache-directory) - cache-entries - #:entry-expiration entry-expiration))) - - (if (assoc-ref opts 'export-manifest?) - (export-manifest opts (current-output-port)) - (guix-environment* opts))) + ;; Clean the cache in EXIT-HOOK so that (1) it happens after potential use + ;; of cached profiles, and (2) cleanup actually happens, even when + ;; 'guix-environment*' calls 'exit'. + (add-hook! exit-hook + (lambda _ + (maybe-remove-expired-cache-entries + (%profile-cache-directory) + cache-entries + #:entry-expiration entry-expiration))) + + (if (assoc-ref opts 'export-manifest?) + (export-manifest opts (current-output-port)) + (guix-environment* opts)))) diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh index f19a0f754e..6fc9e3723b 100644 --- a/tests/guix-pack.sh +++ b/tests/guix-pack.sh @@ -103,7 +103,7 @@ fi guix pack --dry-run --bootstrap -f docker guile-bootstrap # Build a Docker image with a symlink. -guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap +guix pack --dry-run --bootstrap -f docker -S /opt/gnu= guile-bootstrap # Build a tarball pack of cross-compiled software. Use coreutils because # guile-bootstrap is not intended to be cross-compiled. diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh index 32dd997fe7..70dd852009 100644 --- a/tests/guix-shell.sh +++ b/tests/guix-shell.sh @@ -44,9 +44,13 @@ if has_container_support; then --symlink=/usr/bin/guile=bin/guile -- \ /usr/bin/guile --version - # A bad symlink spec causes the command to fail. + # An invalid symlink spec causes the command to fail. ! guix shell --bootstrap -CS bin/guile=/usr/bin/guile guile-bootstrap \ -- exit + + # A dangling symlink causes the command to fail. + ! guix shell --bootstrap -CS /usr/bin/python=bin/python guile-bootstrap \ + -- exit fi # '--ad-hoc' is a thing of the past.