From patchwork Sun Apr 21 09:42:19 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63244 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 0FB4B27BBEB; Sun, 21 Apr 2024 10:44:08 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS 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 7C06227BBE2 for ; Sun, 21 Apr 2024 10:44:07 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTjq-0005Ss-Ig; Sun, 21 Apr 2024 05:43:59 -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 1ryTjj-0005PE-EP for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:51 -0400 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 1ryTji-0002lV-G6; Sun, 21 Apr 2024 05:43:50 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTjv-0006TR-DT; Sun, 21 Apr 2024 05:44:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 01/23] store: database: Register derivation outputs. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369260124404 (code B ref 70494); Sun, 21 Apr 2024 09:44:03 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:21 +0000 Received: from localhost ([127.0.0.1]:41756 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjD-0006LA-0T for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:20 -0400 Received: from mira.cbaines.net ([2a01:7e00:e000:2f8:fd4d:b5c7:13fb:3d27]:51273) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTiw-0006HM-CR for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:04 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 1EA3427BBE2; Sun, 21 Apr 2024 10:42:46 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id e25e3982; Sun, 21 Apr 2024 09:42:45 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:19 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 From: Caleb Ristvedt * guix/store/database.scm (register-derivation-outputs, registered-derivation-outputs): New procedures (register-valid-path): Call register-derivation-outputs for derivations. Co-authored-by: Christopher Baines Change-Id: Id958709f36f24ee1c9c375807e8146a9d1cc4259 --- guix/store/database.scm | 49 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) base-commit: 92af4ea17f70207fbbf2513f677f3171d4eafd41 diff --git a/guix/store/database.scm b/guix/store/database.scm index a847f9d2f0..6a9acc2aef 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -22,6 +22,9 @@ (define-module (guix store database) #:use-module (sqlite3) #:use-module (guix config) + #:use-module (guix serialization) + #:use-module (guix store) + #:use-module (guix derivations) #:use-module (guix store deduplication) #:use-module (guix base16) #:use-module (guix progress) @@ -44,7 +47,9 @@ (define-module (guix store database) valid-path-id register-valid-path + register-derivation-outputs register-items + registered-derivation-outputs %epoch reset-timestamps vacuum-database)) @@ -206,6 +211,26 @@ (define-inlinable (assert-integer proc in-range? key number) "Integer ~A out of range: ~S" (list key number) (list number)))) +(define (register-derivation-outputs db drv) + "Register all output paths of DRV as being produced by it (note that +this doesn't mean 'already produced by it', but rather just 'associated with +it')." + (let ((stmt (sqlite-prepare + db + " +INSERT OR REPLACE INTO DerivationOutputs (drv, id, path) +SELECT id, :outid, :outpath FROM ValidPaths WHERE path = :drvpath;" + #:cache? #t))) + (for-each (match-lambda + ((outid . ($ path)) + (sqlite-bind-arguments stmt + #:drvpath (derivation-file-name + drv) + #:outid outid + #:outpath path) + (sqlite-step-and-reset stmt))) + (derivation-outputs drv)))) + (define (add-references db referrer references) "REFERRER is the id of the referring store item, REFERENCES is a list ids of items referred to." @@ -284,6 +309,11 @@ (define* (register-valid-path db #:key path (references '()) (sqlite-step-and-reset stmt) (last-insert-row-id db))))) + (when (derivation-path? path) + (register-derivation-outputs db + (read-derivation-from-file + path))) + ;; Call 'path-id' on each of REFERENCES. This ensures we get a ;; "non-NULL constraint" failure if one of REFERENCES is unregistered. (add-references db id @@ -331,6 +361,25 @@ (define %epoch ;; When it all began. (make-time time-utc 0 1)) +(define (registered-derivation-outputs db drv) + "Get the list of (id, output-path) pairs registered for DRV." + (let ((stmt (sqlite-prepare + db + " +SELECT id, path +FROM DerivationOutputs +WHERE drv in (SELECT id from ValidPaths where path = :drv)" + #:cache? #t))) + (sqlite-bind-arguments stmt #:drv drv) + (let ((result (sqlite-fold (lambda (current prev) + (match current + (#(id path) + (cons (cons id path) + prev)))) + '() stmt))) + (sqlite-reset stmt) + result))) + (define* (register-items db items #:key prefix (registration-time (timestamp)) From patchwork Sun Apr 21 09:42:20 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63247 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 7104527BBE9; Sun, 21 Apr 2024 10:44:14 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, 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 2C2FA27BBE2 for ; Sun, 21 Apr 2024 10:44:14 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTji-0005OO-J4; Sun, 21 Apr 2024 05:43:50 -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 1ryTjg-0005LL-5S for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:48 -0400 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 1ryTjf-0002jU-Pl for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:47 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTju-0006TK-Vo for guix-patches@gnu.org; Sun, 21 Apr 2024 05:44:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 02/23] gnu: linux-container: Make it more suitable for derivation-building. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369259124296 (code B ref 70494); Sun, 21 Apr 2024 09:44:02 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:11 +0000 Received: from localhost ([127.0.0.1]:41753 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTj1-0006Il-0n for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:10 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43360) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTiw-0006HP-6X for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:03 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 351AB27BBE9; Sun, 21 Apr 2024 10:42:46 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id c0512a2a; Sun, 21 Apr 2024 09:42:46 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:20 +0100 Message-ID: <01702a23fe5bb7ae3b5d800b69e8d6bc59c488f2.1713692561.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 From: Caleb Ristvedt * gnu/build/linux-container.scm (mount-file-systems): First remount all filesystems in the current mount namespace as private (by mounting / with MS_PRIVATE and MS_REC), so that the set of mounts cannot increase except from within the container. Also, the tmpfs mounted over the chroot directory now inherits the chroot directory's permissions (p11-kit, for example, has a test that assumes that the root directory is not writable for the current user, and tmpfs is by default 1777 when created). * guix/build/syscalls.scm (MS_PRIVATE, MS_REC): new variables. Signed-off-by: Christopher Baines Change-Id: Ie26e3ac4a12bbf9087180c56ab775a0f75c40100 --- gnu/build/linux-container.scm | 9 ++++++++- guix/build/syscalls.scm | 3 +++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm index dee6885400..2e4e0d3bf3 100644 --- a/gnu/build/linux-container.scm +++ b/gnu/build/linux-container.scm @@ -99,7 +99,14 @@ (define* (mount-file-systems root mounts #:key mount-/sys? mount-/proc?) ;; The container's file system is completely ephemeral, sans directories ;; bind-mounted from the host. - (mount "none" root "tmpfs") + ;; Make this private in the container namespace so everything mounted under + ;; it is local to this namespace. + (mount "none" "/" "none" (logior MS_REC MS_PRIVATE)) + (let ((current-perms (stat:perms (stat root)))) + (mount "none" root "tmpfs" 0 (string-append "mode=" + (number->string current-perms + 8)))) + ;; A proc mount requires a new pid namespace. (when mount-/proc? diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 39bcffd516..92f2bb21fc 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -54,6 +54,8 @@ (define-module (guix build syscalls) MS_REC MS_SHARED MS_LAZYTIME + MS_PRIVATE + MS_REC MNT_FORCE MNT_DETACH MNT_EXPIRE @@ -551,6 +553,7 @@ (define MS_MOVE 8192) (define MS_REC 16384) (define MS_SHARED 1048576) (define MS_RELATIME 2097152) +(define MS_PRIVATE 262144) (define MS_STRICTATIME 16777216) (define MS_LAZYTIME 33554432) From patchwork Sun Apr 21 09:42:21 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63243 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 BB44727BBEC; Sun, 21 Apr 2024 10:43:55 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, 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 AD94A27BBED for ; Sun, 21 Apr 2024 10:43:51 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTjh-0005Mx-66; Sun, 21 Apr 2024 05:43:49 -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 1ryTjf-0005Kh-Kn for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:47 -0400 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 1ryTjf-0002jP-Cs for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:47 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTju-0006TD-JZ for guix-patches@gnu.org; Sun, 21 Apr 2024 05:44:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 03/23] syscalls: Add missing pieces for derivation build environment. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369258724230 (code B ref 70494); Sun, 21 Apr 2024 09:44:02 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:07 +0000 Received: from localhost ([127.0.0.1]:41739 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTiy-0006I8-PE for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:06 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43358) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTiw-0006HN-5u for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:03 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 3EC2B27BBEA; Sun, 21 Apr 2024 10:42:46 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 208978ff; Sun, 21 Apr 2024 09:42:46 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:21 +0100 Message-ID: <538dc2b842f748ae1b5ece7885af99dbe00bff5f.1713692561.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 From: Caleb Ristvedt * guix/build/syscalls.scm (ADDR_NO_RANDOMIZE, UNAME26, PER_LINUX32): New variables. Flags needed for improving determinism / impersonating a 32-bit machine on a 64-bit machine. (initialize-loopback, setdomainname, personality): New procedures. (octal-escaped): New procedure. (mount-points): Use octal-escaped to properly handle unusual characters in mount point filenames. Signed-off-by: Christopher Baines Change-Id: I2f2aa38fe8f97f2565461d20331b95040a2d7539 --- guix/build/syscalls.scm | 45 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 44 insertions(+), 1 deletion(-) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 92f2bb21fc..487ee68b43 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -162,6 +162,7 @@ (define-module (guix build syscalls) configure-network-interface add-network-route/gateway delete-network-route + initialize-loopback interface? interface-name @@ -212,7 +213,12 @@ (define-module (guix build syscalls) utmpx-address login-type utmpx-entries - (read-utmpx-from-port . read-utmpx))) + (read-utmpx-from-port . read-utmpx) + personality + ADDR_NO_RANDOMIZE + setdomainname + UNAME26 + PER_LINUX32)) ;;; Commentary: ;;; @@ -1952,6 +1958,16 @@ (define* (set-network-interface-up name (lambda () (close-port sock))))) +(define (initialize-loopback) + (let ((sock (socket PF_INET SOCK_DGRAM IPPROTO_IP))) + (dynamic-wind + (const #t) + (lambda () + (set-network-interface-flags sock "lo" + (logior IFF_UP IFF_LOOPBACK IFF_RUNNING))) + (lambda () + (close sock))))) + ;;; ;;; Network routes. @@ -2523,4 +2539,31 @@ (define (read-utmpx-from-port port) ((? bytevector? bv) (read-utmpx bv)))) +;; TODO: verify these constants are correct on platforms other than x86-64 +(define ADDR_NO_RANDOMIZE #x0040000) +(define UNAME26 #x0020000) +(define PER_LINUX32 #x0008) + +(define personality + (let ((proc (syscall->procedure int "personality" `(,unsigned-long)))) + (lambda (persona) + (let-values (((ret err) (proc persona))) + (if (= -1 ret) + (throw 'system-error "personality" "~A" + (list (strerror err)) + (list err)) + ret))))) + +(define setdomainname + (let ((proc (syscall->procedure int "setdomainname" (list '* int)))) + (lambda (domain-name) + (let-values (((ret err) (proc (string->pointer/utf-8 domain-name) + (bytevector-length (string->utf8 + domain-name))))) + (if (= -1 ret) + (throw 'system-error "setdomainname" "~A" + (list (strerror err)) + (list err)) + ret))))) + ;;; syscalls.scm ends here From patchwork Sun Apr 21 09:42:22 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63249 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 A7A4427BBEA; Sun, 21 Apr 2024 10:44:31 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, 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 E3B2827BBE2 for ; Sun, 21 Apr 2024 10:44:28 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTjz-0005ZE-UO; Sun, 21 Apr 2024 05:44:08 -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 1ryTjo-0005Sm-9W for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:56 -0400 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 1ryTjo-0002pw-0Z; Sun, 21 Apr 2024 05:43:56 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTk0-0006Vm-UH; Sun, 21 Apr 2024 05:44:08 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 04/23] guix: store: environment: New module. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:08 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369263224739 (code B ref 70494); Sun, 21 Apr 2024 09:44:08 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:52 +0000 Received: from localhost ([127.0.0.1]:41785 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTje-0006QA-WD for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:51 -0400 Received: from mira.cbaines.net ([2a01:7e00:e000:2f8:fd4d:b5c7:13fb:3d27]:34005) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTix-0006Hi-0O for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:08 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 477B627BBEB; Sun, 21 Apr 2024 10:42:47 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 491aa502; Sun, 21 Apr 2024 09:42:46 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:22 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 From: Caleb Ristvedt * guix/store/environment.scm: New file. * guix/store.scm: Export compressed-hash. * guix/store/database.scm (output-path-id-sql, outputs-exist?, references-sql, file-closure, all-input-output-paths, all-transitive-inputs): New variables. (outputs-exist?, file-closure, all-transitive-inputs): Export procedures. * Makefile.am (STORE_MODULES): Add guix/store/environment.scm. Co-authored-by: Christopher Baines Change-Id: I71ac38fa8596a0c05b34880ca60e8a27ef3892d8 --- Makefile.am | 3 +- guix/store.scm | 1 + guix/store/database.scm | 88 ++++++- guix/store/environment.scm | 484 +++++++++++++++++++++++++++++++++++++ 4 files changed, 574 insertions(+), 2 deletions(-) create mode 100644 guix/store/environment.scm diff --git a/Makefile.am b/Makefile.am index 27d76173e5..667f85acc1 100644 --- a/Makefile.am +++ b/Makefile.am @@ -409,7 +409,8 @@ endif BUILD_DAEMON_OFFLOAD STORE_MODULES = \ guix/store/database.scm \ guix/store/deduplication.scm \ - guix/store/roots.scm + guix/store/roots.scm \ + guix/store/environment.scm MODULES += $(STORE_MODULES) diff --git a/guix/store.scm b/guix/store.scm index a238cb627a..c3b58090e5 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -192,6 +192,7 @@ (define-module (guix store) grafting? %store-prefix + compressed-hash store-path output-path fixed-output-path diff --git a/guix/store/database.scm b/guix/store/database.scm index 6a9acc2aef..07bd501644 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -38,6 +38,8 @@ (define-module (guix store database) #:use-module (srfi srfi-26) #:use-module (rnrs io ports) #:use-module (ice-9 match) + #:use-module (ice-9 vlist) + #:use-module (system foreign) #:export (sql-schema %default-database-file store-database-file @@ -52,7 +54,10 @@ (define-module (guix store database) registered-derivation-outputs %epoch reset-timestamps - vacuum-database)) + vacuum-database + outputs-exist? + file-closure + all-transitive-inputs)) ;;; Code for working with the store database directly. @@ -441,3 +446,84 @@ (define (vacuum-database) (let ((db (sqlite-open (store-database-file)))) (sqlite-exec db "VACUUM;") (sqlite-close db))) + +(define (outputs-exist? db drv-path outputs) + "Determine whether all output labels in OUTPUTS exist as built outputs of +DRV-PATH." + (let ((statement + (sqlite-prepare + db + " +SELECT id +FROM ValidPaths +WHERE path IN ( + SELECT path + FROM DerivationOutputs + WHERE DerivationOutputs.id = :id + AND drv IN ( + SELECT id FROM ValidPaths WHERE path = :drvpath + ) +)" + #:cache? #t))) + (sqlite-bind-arguments statement #:drvpath drv-path) + + (every (lambda (out-id) + (sqlite-bind-arguments statement #:id out-id) + (sqlite-step-and-reset statement)) + outputs))) + +(define* (file-closure db path #:key (list-so-far vlist-null)) + "Return a vlist containing the store paths referenced by PATH, the store +paths referenced by those paths, and so on." + (let ((get-references + (sqlite-prepare + db + " +SELECT path +FROM ValidPaths +WHERE id IN ( + SELECT reference FROM Refs WHERE referrer IN ( + SELECT id FROM ValidPaths WHERE path = :path + ) +)" + #:cache? #t))) + ;; to make it possible to go depth-first we need to get all the + ;; references of an item first or we'll have re-entrancy issues with + ;; the get-references statement. + (define (references-of path) + ;; There are no problems with resetting an already-reset + ;; statement. + (sqlite-bind-arguments get-references #:path path) + (let ((result + (sqlite-fold (lambda (row prev) + (cons (vector-ref row 0) prev)) + '() + get-references))) + (sqlite-reset get-references) + result)) + + (let %file-closure ((path path) + (references-vlist list-so-far)) + (if (vhash-assoc path references-vlist) + references-vlist + (fold %file-closure + (vhash-cons path #t references-vlist) + (references-of path)))))) + +(define (all-input-output-paths drv) + "Return a list containing the output paths this derivation's inputs need to +provide." + (apply append (map derivation-input-output-paths + (derivation-inputs drv)))) + +(define (all-transitive-inputs db drv) + "Produce a list of all inputs and all of their references." + (let ((input-paths (all-input-output-paths drv))) + (vhash-fold (lambda (key val prev) + (cons key prev)) + '() + (fold (lambda (input list-so-far) + (file-closure db input #:list-so-far list-so-far)) + vlist-null + `(,@(derivation-sources drv) + ,@input-paths))))) diff --git a/guix/store/environment.scm b/guix/store/environment.scm new file mode 100644 index 0000000000..b088408ef9 --- /dev/null +++ b/guix/store/environment.scm @@ -0,0 +1,484 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Caleb Ristvedt +;;; +;;; 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 . + +;;; Code for setting up environments, especially build environments. Builds +;;; on top of (gnu build linux-container). + +(define-module (guix store environment) + #:use-module (guix records) + #:use-module (guix config) + #:use-module (gnu build linux-container) + #:use-module (gnu system file-systems) + #:use-module ((guix build utils) #:select (delete-file-recursively + mkdir-p + copy-recursively)) + #:use-module (guix derivations) + #:use-module (guix store) + #:use-module (guix build syscalls) + #:use-module (guix store database) + #:use-module (gcrypt hash) + #:use-module (guix base32) + #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-98) + + #:export ( + environment + environment-namespaces + environment-variables + environment-temp-dirs + environment-filesystems + environment-new-session? + environment-new-pgroup? + environment-setup-i/o-proc + environment-preserved-fds + environment-chroot + environment-personality + environment-user + environment-group + environment-hostname + environment-domainname + build-environment-vars + delete-environment + run-in-environment + bind-mount + standard-i/o-setup + %standard-preserved-fds + nonchroot-build-environment + chroot-build-environment + builtin-builder-environment + run-standard + run-standard-build + wait-for-build)) + +(define %standard-preserved-fds '(0 1 2)) + +(define-record-type* environment + ;; The defaults are set to be as close to the "current environment" as + ;; possible. + make-environment + environment? + (namespaces environment-namespaces (default '())) ; list of symbols + ; list of (key . val) pairs + (variables environment-variables (default (get-environment-variables))) + ; list of (symbol . filename) pairs. + (temp-dirs environment-temp-dirs (default '())) + ;; list of objects. Only used when MNT is in NAMESPACES. + (filesystems environment-filesystems (default '())) + ; boolean (implies NEW-PGROUP?) + (new-session? environment-new-session? (default #f)) + (new-pgroup? environment-new-pgroup? (default #f)) ; boolean + (setup-i/o environment-setup-i/o-proc) ; a thunk or #f + ; #f or list of integers (in case of #f, all are preserved) + (preserved-fds environment-preserved-fds (default #f)) + ;; either the chroot directory or #f, must not be #f if MNT is in + ;; NAMESPACES! Will be recursively deleted when the environment is + ;; destroyed. Ignored if MNT is not in NAMESPACES. + (chroot environment-chroot (default #f)) + (initial-directory environment-initial-directory (default #f)) ; string or #f + (personality environment-personality (default #f)) ; integer or #f + ;; These are currently naively handled in the case of user namespaces. + (user environment-user (default #f)) ; integer or #f + (group environment-group (default #f)) ; integer or #f + (hostname environment-hostname (default #f)) ; string or #f + (domainname environment-domainname (default #f))) ; string or #f + +(define (delete-environment env) + "Delete all temporary directories used in ENV." + (for-each (match-lambda + ((id . filename) + (delete-file-recursively filename))) + (environment-temp-dirs env)) + (when (environment-chroot env) + (delete-file-recursively (environment-chroot env)))) + +(define (format-file file-name . args) + (call-with-output-file file-name + (lambda (port) + (apply simple-format port args)))) + +(define* (mkdir-p* dir #:optional permissions) + (mkdir-p dir) + (when permissions + (chmod dir permissions))) + +(define (add-core-files environment fixed-output?) + "Populate container with miscellaneous files and directories that shouldn't +be bind-mounted." + (let ((uid (environment-user environment)) + (gid (environment-group environment))) + (mkdir-p* "/tmp" #o1777) + (mkdir-p* "/etc") + + (unless (or (file-exists? "/etc/passwd") + (file-exists? "/etc/group")) + (format-file "/etc/passwd" + (string-append "nixbld:x:~a:~a:Nix build user:/:/noshell~%" + "nobody:x:65534:65534:Nobody:/:/noshell~%") + uid gid) + (format-file "/etc/group" "nixbld:!:~a:~%" gid)) + + (unless (or fixed-output? (file-exists? "/etc/hosts")) + (format-file "/etc/hosts" "127.0.0.1 localhost~%")) + (when (file-exists? "/dev/pts/ptmx") + (chmod "/dev/pts/ptmx" #o0666)))) + +(define (run-in-environment env thunk . i/o-args) + "Run THUNK in ENV with I/O-ARGS passed to the SETUP-I/O procedure of +ENV. Return the pid of the process THUNK is run in." + (match env + (($ namespaces variables temp-dirs + filesystems new-session? new-pgroup? setup-i/o + preserved-fds chroot current-directory new-personality + user group hostname domainname) + (when (and new-session? (not new-pgroup?)) + (throw 'invalid-environment "NEW-SESSION? implies NEW-PGROUP?.")) + (let ((fixed-output? (not (memq 'net namespaces)))) + (run-container chroot filesystems namespaces (and user (1+ user)) + (lambda () + (when hostname (sethostname hostname)) + (when domainname (setdomainname domainname)) + ;; setsid / setpgrp as necessary + (if new-session? + (setsid) + (when new-pgroup? + (setpgid 0 0))) + (when chroot + (add-core-files env fixed-output?)) + ;; set environment variables + (when variables + (environ (map (match-lambda + ((key . val) + (string-append key "=" val))) + variables))) + (when setup-i/o (apply setup-i/o i/o-args)) + ;; set UID and GID + (when current-directory (chdir current-directory)) + (when group (setgid group)) + (when user (setuid user)) + ;; Close unpreserved fds + (when preserved-fds + (let close-next ((n 0)) + (when (< n 20) ;; XXX: don't hardcode. + (unless (memq n preserved-fds) + (false-if-exception (close-fdes n))) + (close-next (1+ n))))) + + ;; enact personality + (when new-personality (personality new-personality)) + (thunk))))))) + +(define (bind-mount src dest) + "Return a denoting the bind-mounting of SRC to DEST. Note that +if this is part of a chroot , DEST will be the name *inside of* +the chroot, i.e. + +(bind-mount \"/foo/x\" \"/bar/x\") + +in an environment with chroot \"/chrootdir\" will bind-mount \"/foo/x\" to +\"/chrootdir/bar/x\"." + (file-system + (device src) + (mount-point dest) + (type "none") + (flags '(bind-mount)) + (check? #f))) + +(define input->mount + (match-lambda + ((source . dest) + (bind-mount source dest)) + (source + (bind-mount source source)))) + +(define (default-files drv) + "Return a list of the files to be bind-mounted that aren't store items or +already added by call-with-container." + `(,@(if (file-exists? "/dev/kvm") + '("/dev/kvm") + '()) + ,@(if (fixed-output-derivation? drv) + '("/etc/resolv.conf" + "/etc/nsswitch.conf" + "/etc/services" + "/etc/hosts") + '()))) + +(define (build-environment-vars drv build-dir) + "Return an alist of environment variable / value pairs for every environment +variable that should be set during the build execution." + (let ((leaked-vars (and + (fixed-output-derivation? drv) + (let ((leak-string + (assoc-ref (derivation-builder-environment-vars drv) + "impureEnvVars"))) + (and leak-string + (string-tokenize leak-string + (char-set-complement + (char-set #\space)))))))) + (append `(("PATH" . "/path-not-set") + ("HOME" . "/homeless-shelter") + ("NIX_STORE" . ,%store-directory) + ;; XXX: make this configurable + ("NIX_BUILD_CORES" . "0") + ("NIX_BUILD_TOP" . ,build-dir) + ("TMPDIR" . ,build-dir) + ("TEMPDIR" . ,build-dir) + ("TMP" . ,build-dir) + ("TEMP" . ,build-dir) + ("PWD" . ,build-dir)) + (if (fixed-output-derivation? drv) + (cons '("NIX_OUTPUT_CHECKED" . "1") + (if leaked-vars + ;; leaked vars might be #f + (filter cdr + (map (lambda (leaked-var) + (cons leaked-var (getenv leaked-var))) + leaked-vars)) + '())) + '()) + (derivation-builder-environment-vars drv)))) + +(define* (temp-directory tmpdir name #:optional permissions user group) + "Create a temporary directory under TMPDIR with permissions PERMISSIONS if +specified, otherwise default permissions as specified by umask, and belonging +to user USER and group GROUP (defaulting to current user if not specified or +#f). Return the full filename of the form /-." + (let try-again ((attempt-number 0)) + (catch 'system-error + (lambda () + (let ((attempt-name (string-append tmpdir "/" name "-" + (number->string + attempt-number 10)))) + (mkdir attempt-name permissions) + (when permissions + ;; the only guarantee we get from mkdir is that the actual + ;; permissions are no more permissive than what we specified. In + ;; the event we want to be more permissive than the umask, though, + ;; this is necessary. + (chmod attempt-name permissions)) + ;; -1 means "unchanged" + (chown attempt-name (or user -1) (or group -1)) + attempt-name)) + (lambda args + (if (= (system-error-errno args) EEXIST) + (try-again (+ attempt-number 1)) + (apply throw args)))))) + +(define (special-filesystems input-paths) + "Return whatever new filesystems need to be created in the container, which +depends on whether they're already set to be bind-mounted. INPUT-PATHS must +be a list of paths or pairs of paths." + ;; procfs and devpts are already taken care of by run-container + `(,@(if (file-exists? "/dev/shm") + (list (file-system + (device "none") + (mount-point "/dev/shm") + (type "tmpfs") + (check? #f))) + '()))) + +(define (standard-i/o-setup output-port) + "Redirect output and error streams to OUTPUT-FD, get input from /dev/null." + (define output-fd (port->fdes output-port)) + (define stdout (fdopen 1 "w")) + ;; Useful in case an error happens between here and an exec and it needs to + ;; get reported. + (set-current-output-port stdout) + (set-current-error-port stdout) + (dup2 output-fd 1) + (dup2 output-fd 2) + (call-with-input-file "/dev/null" + (lambda (null-port) + (dup2 (port->fdes null-port) 0))) + (sigaction SIGPIPE SIG_DFL)) + + + +(define (derivation-tempname drv) + (string-append "guix-build-" + (store-path-package-name (derivation-file-name drv)))) + +;; We might want to add to this sometime. +(define %default-chroot-dirs + '()) + +(define* (default-personality drv #:key impersonate-linux-2.6?) + (let ((current-personality (personality #xffffffff))) + (logior current-personality ADDR_NO_RANDOMIZE + (match (cons %system (derivation-system drv)) + ((or ("x86_64-linux" . "i686-linux") + ("aarch64-linux" . "armhf-linux")) + PER_LINUX32) + (_ 0)) + (match (cons (derivation-system drv) impersonate-linux-2.6?) + (((or "x86_64-linux" "i686-linux") . #t) + UNAME26) + (_ 0))))) + +(define* (make-build-directory drv #:optional uid gid) + (let ((build-directory (temp-directory (or (getenv "TMPDIR") + "/tmp") + (derivation-tempname drv) #o0700 + uid gid))) + ;; XXX: Honor exportReferencesGraph here... + build-directory)) + +(define* (nonchroot-build-environment drv #:key gid uid) + "Create and return an for building DRV outside of a chroot, as +well as the store inputs the build requires." + (let* ((fixed-output? (fixed-output-derivation? drv)) + (build-directory (make-build-directory drv))) + (environment + (temp-dirs `((build-directory . ,build-directory))) + (initial-directory build-directory) + (new-session? #t) + (new-pgroup? #t) + (variables (build-environment-vars drv build-directory)) + (preserved-fds %standard-preserved-fds) + (setup-i/o standard-i/o-setup) + (personality (default-personality drv)) + (user uid) + (group gid)))) + +(define* (builtin-builder-environment drv #:key gid uid) + "Create and return an for builtin builders, as well as the +store inputs the build requires." + ;; It's just the same as non-chroot-build-environment, but without any + ;; environment variables being changed. + (let ((env (nonchroot-build-environment drv + #:gid gid + #:uid uid))) + (environment (inherit env) + (variables (get-environment-variables))))) + +(define* (chroot-build-environment drv #:key gid uid + (extra-chroot-dirs '()) + build-chroot-dirs + (tmpdir (or (getenv "TMPDIR") + "/tmp"))) + "Create an for building DRV with standard in-chroot +settings (as used by nix daemon). Return said environment as well as the +store paths that are included in it (useful for reference scanning)." + (let* ((tempname (derivation-tempname drv)) + (store-directory (temp-directory tmpdir + (string-append tempname ".store") + #o1775 0 gid)) + (build-directory (make-build-directory drv uid gid)) + (inside-build-dir (string-append tmpdir "/" tempname "-0")) + (fixed-output? (fixed-output-derivation? drv)) + (input-paths (append (default-files drv) + (or build-chroot-dirs + %default-chroot-dirs) + extra-chroot-dirs))) + (environment + (namespaces `(mnt pid ipc uts ,@(if fixed-output? '() '(net)))) + (filesystems + (cons* (bind-mount build-directory inside-build-dir) + (bind-mount store-directory %store-directory) + (append (special-filesystems input-paths) + (map input->mount input-paths)))) + (temp-dirs `((store-directory . ,store-directory) + (build-directory . ,build-directory))) + (initial-directory inside-build-dir) + (new-session? #t) + (new-pgroup? #t) + (setup-i/o (lambda (output-fd) + (unless fixed-output? + (initialize-loopback)) + (standard-i/o-setup output-fd))) + (variables (build-environment-vars drv inside-build-dir)) + (preserved-fds %standard-preserved-fds) + (chroot (temp-directory tmpdir (string-append tempname ".chroot") + #o750 0 gid)) + (user uid) + (group gid) + (personality (default-personality drv)) + (hostname "localhost") + (domainname "(none)")))) + +(define (redirected-path drv output) + (let* ((original (derivation-output-path (assoc-ref (derivation-outputs drv) + output))) + (hash + (bytevector->nix-base32-string + (compressed-hash (sha256 (string-append "rewrite:" + (derivation-file-name drv) + ":" + original)) + 20)))) + (string-append (%store-prefix) "/" hash "-" + (store-path-package-name original)))) + +(define (redirect-outputs env drv output-names) + "Create a new based on ENV but modified so that for each +output-name in OUTPUT-NAMES, the environment variable corresponding to that +output is set to a newly-generated output path." + (environment (inherit env) + (variables (append (map (lambda (output) + (cons output (redirected-path drv output))) + output-names) + (remove (lambda (var) + (member (car var) output-names)) + (environment-variables env)))))) + +(define (run-standard environment thunk) + "Run THUNK in ENVIRONMENT. Return the PID it is being run in and the read +end of the pipe its i/o has been set up with." + (match (pipe) + ((read . write) + (let ((pid (run-in-environment environment + (lambda () + (catch #t + (lambda () + (thunk) + (primitive-exit 0)) + (lambda args + (format #t "Error: ~A~%" args) + (primitive-exit 1)))) + write))) + (close-fdes (port->fdes write)) + (values pid read))))) + +(define (run-standard-build drv environment) + "Run the builder of DRV in ENVIRONMENT. Return the PID it is being run in +and the read end of the pipe its i/o has been set up with." + (run-standard environment + (lambda () + (let ((prog (derivation-builder drv)) + (args (derivation-builder-arguments drv))) + (apply execl prog prog args))))) + +(define* (dump-port port #:optional (target-port (current-output-port))) + (if (port-eof? port) + (force-output target-port) + (begin + (put-bytevector target-port (get-bytevector-some port)) + (dump-port port target-port)))) + +(define (wait-for-build pid read-port) + "Dump all input from READ-PORT to (current-output-port), then wait for PID +to terminate." + (dump-port read-port) + (close-fdes (port->fdes read-port)) + ;; Should we wait specifically for PID to die, or just for any state change? + (cdr (waitpid pid))) From patchwork Sun Apr 21 09:42:23 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63256 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 B23D827BBE9; Sun, 21 Apr 2024 10:45:06 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, 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 73A0927BBE2 for ; Sun, 21 Apr 2024 10:45:05 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTk1-0005ev-6D; Sun, 21 Apr 2024 05:44:09 -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 1ryTjl-0005Qc-6O for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:55 -0400 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 1ryTjk-0002mc-Dt; Sun, 21 Apr 2024 05:43:52 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTjx-0006Tx-6v; Sun, 21 Apr 2024 05:44:05 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 05/23] store: build-derivations: New module. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369260524457 (code B ref 70494); Sun, 21 Apr 2024 09:44:05 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:25 +0000 Received: from localhost ([127.0.0.1]:41764 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjH-0006M5-9Z for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:24 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43362) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTix-0006Hj-2G for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:05 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 4F1A427BBEC; Sun, 21 Apr 2024 10:42:47 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id a2fd0174; Sun, 21 Apr 2024 09:42:46 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:23 +0100 Message-ID: <7fa2a7e78f0987f8794602ca3e8e2ed8dfd321e4.1713692561.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 From: Caleb Ristvedt * guix/store/build-derivations.scm (get-output-specs, builtin-download, add-to-trie, make-search-trie, remove-from-trie!, scanning-wrapper-port, scan-for-references, ensure-input-outputs-exist, build-derivation): New procedures. (builtins): New variable. (): New record types. * Makefile.am (STORE_MODULES): Add it. Co-authored-by: Christopher Baines Change-Id: I904b75e3c58c5fb996c0c9d1ca19b2cb2beb90b6 --- Makefile.am | 3 +- guix/store/build-derivations.scm | 412 +++++++++++++++++++++++++++++++ 2 files changed, 414 insertions(+), 1 deletion(-) create mode 100644 guix/store/build-derivations.scm diff --git a/Makefile.am b/Makefile.am index 667f85acc1..c926506b01 100644 --- a/Makefile.am +++ b/Makefile.am @@ -410,7 +410,8 @@ STORE_MODULES = \ guix/store/database.scm \ guix/store/deduplication.scm \ guix/store/roots.scm \ - guix/store/environment.scm + guix/store/environment.scm \ + guix/store/build-derivations.scm MODULES += $(STORE_MODULES) diff --git a/guix/store/build-derivations.scm b/guix/store/build-derivations.scm new file mode 100644 index 0000000000..d77769528f --- /dev/null +++ b/guix/store/build-derivations.scm @@ -0,0 +1,412 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017, 2019 Caleb Ristvedt +;;; +;;; 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 . + +;;; For building derivations. + +(define-module (guix store build-derivations) + #:use-module (guix derivations) + #:use-module (guix store database) + #:use-module (guix config) + #:use-module (guix build syscalls) + #:use-module (ice-9 vlist) + #:use-module (ice-9 popen) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-71) + #:use-module (gcrypt hash) + #:use-module (guix serialization) + #:use-module (guix base16) + #:use-module (guix sets) + #:use-module ((guix build utils) #:select (delete-file-recursively + mkdir-p + copy-recursively)) + #:use-module ((guix store) #:select (store-path-hash-part)) + #:use-module (guix build store-copy) + #:use-module (gnu system file-systems) + #:use-module (ice-9 textual-ports) + #:use-module (ice-9 match) + #:use-module (rnrs io ports) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 ftw) + #:use-module (ice-9 q) + #:use-module (srfi srfi-43) + #:use-module (rnrs bytevectors) + #:use-module (guix store environment) + #:export (builder+environment+inputs + build-derivation)) + +(define (output-paths drv) + "Return all store output paths produced by DRV." + (match (derivation-outputs drv) + (((outid . ($ output-path)) ...) + output-path))) + +(define (get-output-specs drv possible-references) + "Return a list of objects, one for each output of DRV." + (map (match-lambda + ((outid . ($ output-path)) + (let ((references + (scan-for-references output-path + ;; outputs can reference + ;; themselves or other outputs of + ;; the same derivation. + (append (output-paths drv) + possible-references)))) + (store-info output-path (derivation-file-name drv) references)))) + (derivation-outputs drv))) + +(define (builtin-download drv outputs) + "Download DRV outputs OUTPUTS into the store." + (setenv "NIX_STORE" %store-directory) + ;; XXX: Set _NIX_OPTIONS once client settings are known + (spawn "guix" + (list "guix perform-download" + "perform-download" + (derivation-file-name drv) + ;; We assume this has only a single output + (derivation-output-path (cdr (first outputs)))))) + +;; if a derivation builder name is in here, it is a builtin. For normal +;; behavior, make sure everything starts with "builtin:". Also, the procedures +;; stored in here should take two arguments, the derivation and the list of +;; (output-name . )s to be built. + +(define builtins + (let ((builtins-table (make-hash-table 10))) + (hash-set! builtins-table + "builtin:download" + builtin-download) + builtins-table)) + +(define %keep-build-dir? #t) + +;; XXX: make this configurable. +(define %build-group + (make-parameter (false-if-exception (getgrnam "guixbuild")))) + +(define (get-build-user) + ;; XXX: user namespace to make build-user work instead of having to be root? + (or (and=> (%build-group) + ;; XXX: Acquire a user via lock files once those are properly + ;; implemented. For now, avoid conflict with the existing daemon + ;; where possible by picking a build user from the end (last) + ;; instead of the front. + ;; So in the future, replace LAST with ACQUIRE-BUILD-USER + (compose passwd:uid getpwnam last group:mem)) + (getuid))) + +(define (get-build-group) + (or (and (zero? (getuid)) + (group:gid (%build-group))) + (getgid))) + +(define-record-type + (make-trie-node table string-exists?) + trie-node? + ;; TODO implement skip values. Probably not as big a speed gain as you think + ;; it is, since this is I/O-bound. + ;; (skip-value node-skip-value set-skip-value!) + (table node-table set-node-table!) + ;; Technically speaking, it's possible for both CAT and CATTLE to be in a + ;; trie at once. Of course, for our purposes, this is + (string-exists? node-string-exists? set-string-exists?!)) + +(define* (add-to-trie trie string #:optional (new-tables-size 2)) + "Adds STR to TRIE." + (let ((str (string->utf8 string))) + (let next-node ((position 0) + (current-node trie)) + (if (= position (bytevector-length str)) + ;; this is it. This is where we need to register that this string is + ;; present. + (set-string-exists?! current-node #t) + (let* ((current-table (node-table current-node)) + (node (hash-ref current-table + (bytevector-u8-ref str position)))) + (if node + (next-node (1+ position) + node) + (let ((new-node (make-trie-node (make-hash-table new-tables-size) + #f))) + (hash-set! current-table + (bytevector-u8-ref str position) + new-node) + (next-node (1+ position) + new-node)))))))) + +(define (make-search-trie strings) + ;; TODO: make the first few trie levels non-sparse tables to avoid hashing + ;; overhead. + (let ((root (make-trie-node (make-hash-table) #f))) + (for-each (cut add-to-trie root <>) + strings) + root)) + + +(define (remove-from-trie! trie sequence) + "Removes SEQUENCE from TRIE. This means that any nodes that are only in the +path of SEQUENCE are removed. It's an error to use this with a sequence not +already in TRIE." + ;; Hm. Looks like we'll have to recurse all the way down, find where it + ;; ends, then stop at the first thing on the way back up that has anything + ;; with the same prefix. Or I could do this the right way with an explicit + ;; stack. Hm... + + (define (node-stack) + (let next ((nodes '()) + (i 0) + (current-node trie)) + (if (= (bytevector-length sequence) i) + (begin + ;; it's possible that even though this is the last node of this + ;; sequence it can't be deleted. So mark it as not denoting a + ;; string. + (set-string-exists?! current-node #f) + (cons current-node nodes)) + (let ((next-node (hash-ref (node-table current-node) + (bytevector-u8-ref sequence i)))) + (next (cons current-node nodes) + (1+ i) + next-node))))) + + (let maybe-delete ((visited-nodes (node-stack)) + (i (1- (bytevector-length sequence)))) + (match visited-nodes + ((current parent others ...) + (when (zero? (hash-count (const #t) + (node-table current))) + + (hash-remove! (node-table parent) + (bytevector-u8-ref sequence i)) + (maybe-delete (cdr visited-nodes) + (1- i)))) + ((current) + #f)))) + +(define (scanning-wrapper-port output-port paths) + "Creates a wrapper port which passes through bytes to OUTPUT-PORT and +returns it as well as a procedure which, when called, returns a list of all +references out of the possibilities enumerated in PATHS that were +detected. PATHS must not be empty." + ;; Not sure if I should be using custom ports or soft ports... + (let* ((strings (map store-path-hash-part paths)) + (string->path (fold (lambda (current prev) + (vhash-cons (store-path-hash-part current) + current + prev)) + vlist-null + paths)) + (lookback-size (apply max (map (compose bytevector-length string->utf8) + strings))) + (smallest-length (apply min (map (compose bytevector-length + string->utf8) + strings))) + (lookback-buffer (make-bytevector lookback-size)) + (search-trie (make-search-trie strings)) + (buffer-pos 0) + (references '())) + + (values + (make-custom-binary-output-port + "scanning-wrapper" + ;; write + (lambda (bytes offset count) + (define (in-lookback? n) + (< n buffer-pos)) + ;; the "virtual" stuff provides a convenient interface that makes it + ;; look like we magically remember the end of the previous buffer. + (define (virtual-ref n) + (if (in-lookback? n) + (bytevector-u8-ref lookback-buffer n) + (bytevector-u8-ref bytes (+ (- n buffer-pos) + offset)))) + + + (let ((total-length (+ buffer-pos count))) + + (define (virtual-copy! start end target) + (let* ((copy-size (- end start))) + (let copy-next ((i 0)) + (unless (= i copy-size) + (bytevector-u8-set! target + i + (virtual-ref (+ start i))) + (copy-next (1+ i)))) + target)) + + ;; the gritty reality of that magic + (define (remember-end) + (let* ((copy-amount (min total-length + lookback-size)) + (start (- total-length copy-amount)) + (end total-length)) + (virtual-copy! start end lookback-buffer) + (set! buffer-pos copy-amount))) + + (define (attempt-match n trie) + (let test-position ((i n) + (current-node trie)) + (if (node-string-exists? current-node) + ;; MATCH + (virtual-copy! n i (make-bytevector (- i n))) + (if (>= i total-length) + #f + (let ((next-node (hash-ref (node-table current-node) + (virtual-ref i)))) + (if next-node + (test-position (1+ i) + next-node) + #f)))))) + + + + (define (scan) + (let next-char ((i 0)) + (when (< i (- total-length smallest-length)) + (let ((match-result (attempt-match i search-trie))) + (if match-result + (begin + (set! references + (let ((str-result + (cdr (vhash-assoc (utf8->string match-result) + string->path)))) + (format #t "Found reference to: ~a~%" str-result) + (cons str-result + references))) + ;; We're not interested in multiple references, it'd + ;; just slow us down. + (remove-from-trie! search-trie match-result) + (next-char (+ i (bytevector-length match-result)))) + (next-char (1+ i))))))) + (format #t "Scanning chunk of ~a bytes~%" count) + (scan) + (remember-end) + (put-bytevector output-port bytes offset count) + count)) + #f ;; get-position + #f ;; set-position + (lambda () + (close-port output-port))) + (lambda () + references)))) + + +;; There are two main approaches we can use here: we can look for the entire +;; store path of the form "/gnu/store/hashpart-name", which will yield no +;; false positives and likely be faster due to being more quickly able to rule +;; out sequences, and we can look for just hashpart, which will be faster to +;; lookup and may both increase false positives and decrease false negatives +;; as stuff that gets split up will likely still have the hash part all +;; together, but adds a chance that 32 random base-32 characters could cause a +;; false positive, but the chances of that are extremely slim, and an +;; adversary couldn't really use that. +(define (scan-for-references file possibilities) + "Scans for literal references in FILE as long as they happen to be in +POSSIBILITIES. Returns the list of references found, the sha256 hash of the +nar, and the length of the nar." + (let*-values (((scanning-port get-references) + (scanning-wrapper-port (%make-void-port "w") possibilities))) + (write-file file scanning-port) + (force-output scanning-port) + (get-references))) + +(define (copy-outputs drv environment) + "Copy output paths produced in ENVIRONMENT from building DRV to the store if +a fake store was used." + (let ((store-dir (assoc-ref (environment-temp-dirs environment) + 'store-directory))) + (when store-dir + (for-each + (match-lambda + ((outid . ($ output-path)) + (copy-recursively + (string-append store-dir "/" (basename output-path)) output-path))) + (derivation-outputs drv))))) + +(define (run-builder builder drv environment store-inputs) + "Run the builder BUILDER for DRV in ENVIRONMENT, wait for it to finish, and +return the list of s corresponding to its outputs." + (match (status:exit-val (call-with-values + (lambda () + (run-standard environment builder)) + wait-for-build)) + (0 + ;; XXX: check that the output paths were produced. + (copy-outputs drv environment) + (delete-environment environment) + (get-output-specs drv store-inputs)) + (exit-value + (format #t "Builder exited with status ~A~%" exit-value) + (if %keep-build-dir? + (format #t "Note: keeping build directories: ~A~%" + (match (environment-temp-dirs environment) + (((sym . dir) ...) + dir))) + (delete-environment environment)) + #f))) + +(define* (builder+environment+inputs drv store-inputs #:key (chroot? #t)) + "Return a thunk that performs the build action, the environment it should be +run in, and the store inputs of that environment." + (let* ((builtin + (hash-ref builtins (derivation-builder drv))) + (environment + ((if builtin + builtin-builder-environment + (if chroot? + (lambda args + (apply chroot-build-environment + `(,@args #:extra-chroot-dirs ,store-inputs))) + nonchroot-build-environment)) + drv #:gid (get-build-group) #:uid (get-build-user))) + (builder + (or + (and builtin (lambda () + (builtin drv (derivation-outputs + drv)))) + (lambda () + (let ((prog (derivation-builder drv)) + (args (derivation-builder-arguments drv))) + (apply execl prog prog args)))))) + (values builder environment))) + +(define (build-derivation drv store-inputs) + "Given a DRV, build the derivation unconditionally even if its +outputs already exist." + ;; Make sure store permissions and ownership are intact (test-env creates a + ;; store with wrong permissions, for example). + (when (and (zero? (getuid)) (get-build-group)) + (chown %store-directory 0 (get-build-group))) + (chmod %store-directory #o1775) + ;; Inputs need to exist regardless of how we're getting the outputs of this + ;; derivation. + (format #t "Starting build of derivation ~a~%~%" drv) + (let* ((builder + environment + (builder+environment+inputs drv + store-inputs + #:chroot? (zero? (getuid)))) + (output-specs + (run-builder builder drv environment store-inputs))) + + (unless output-specs + (throw 'derivation-build-failed drv)) + + output-specs)) From patchwork Sun Apr 21 09:42:24 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63258 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 0D0DC27BBEA; Sun, 21 Apr 2024 10:45:21 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS 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 76DC127BBE2 for ; Sun, 21 Apr 2024 10:45:20 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTk8-0005qY-3B; Sun, 21 Apr 2024 05:44: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 1ryTjj-0005PG-EH for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:51 -0400 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 1ryTji-0002kB-7A; Sun, 21 Apr 2024 05:43:50 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTjw-0006Tj-PV; Sun, 21 Apr 2024 05:44:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 06/23] store: Export protocol related constants. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369260324436 (code B ref 70494); Sun, 21 Apr 2024 09:44:04 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:23 +0000 Received: from localhost ([127.0.0.1]:41762 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjG-0006Ly-TR for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:23 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43364) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTix-0006Hz-KG for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:05 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 59ED627BBED for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:47 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 7d2b5572 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:46 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:24 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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/store.scm (%protocol-version, %worker-magic-1, %worker-magic-2): Export variables. (protocol-major, protocol-minor, protocol-version): Export procedures. (%stderr-next, %stderr-read, %stderr-write, %stderr-last, %stderr-error): Move from process-stderr and export variables. Change-Id: Id0b1b5e6feeac5260875558f33aa5d923d5e0903 --- guix/store.scm | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/guix/store.scm b/guix/store.scm index c3b58090e5..578e46507e 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -206,18 +206,25 @@ (define-module (guix store) derivation-log-file log-file)) -(define %protocol-version #x164) +(define-public %protocol-version #x164) -(define %worker-magic-1 #x6e697863) ; "nixc" -(define %worker-magic-2 #x6478696f) ; "dxio" +(define-public %worker-magic-1 #x6e697863) ; "nixc" +(define-public %worker-magic-2 #x6478696f) ; "dxio" -(define (protocol-major magic) +(define-public (protocol-major magic) (logand magic #xff00)) -(define (protocol-minor magic) +(define-public (protocol-minor magic) (logand magic #x00ff)) -(define (protocol-version major minor) +(define-public (protocol-version major minor) (logior major minor)) +;; magic cookies from worker-protocol.hh +(define-public %stderr-next #x6f6c6d67) ; "olmg", build log +(define-public %stderr-read #x64617461) ; "data", data needed from source +(define-public %stderr-write #x64617416) ; "dat\x16", data for sink +(define-public %stderr-last #x616c7473) ; "alts", we're done +(define-public %stderr-error #x63787470) ; "cxtp", error reporting + (define-syntax define-enumerate-type (syntax-rules () ((_ name->int (name id) ...) @@ -709,13 +716,6 @@ (define* (process-stderr server #:optional user-port) (define p (store-connection-socket server)) - ;; magic cookies from worker-protocol.hh - (define %stderr-next #x6f6c6d67) ; "olmg", build log - (define %stderr-read #x64617461) ; "data", data needed from source - (define %stderr-write #x64617416) ; "dat\x16", data for sink - (define %stderr-last #x616c7473) ; "alts", we're done - (define %stderr-error #x63787470) ; "cxtp", error reporting - (let ((k (read-int p))) (cond ((= k %stderr-write) ;; Write a byte stream to USER-PORT. From patchwork Sun Apr 21 09:42:25 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63253 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 B70C327BBEC; Sun, 21 Apr 2024 10:44:53 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, 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 7039327BBEA for ; Sun, 21 Apr 2024 10:44:52 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTjs-0005U1-Lv; Sun, 21 Apr 2024 05:44:01 -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 1ryTjj-0005PJ-GO for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:51 -0400 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 1ryTjj-0002li-2p; Sun, 21 Apr 2024 05:43:51 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTjv-0006TX-Pr; Sun, 21 Apr 2024 05:44:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 07/23] serialization: Export read-byte-string. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369260224422 (code B ref 70494); Sun, 21 Apr 2024 09:44:03 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:22 +0000 Received: from localhost ([127.0.0.1]:41758 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjE-0006LZ-TZ for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:22 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43366) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTix-0006Hy-K7 for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:04 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 69C8927BBEE for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:47 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 90c4dad5 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:46 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:25 +0100 Message-ID: <152e854080711a12e67ffb4b15f4d5ebbd96fbd5.1713692561.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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/serialization.scm (read-byte-string): Export procedure. Change-Id: Ifcbf06a7b99c938dba66e25ef5adbd5feea8c85c --- guix/serialization.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/guix/serialization.scm b/guix/serialization.scm index 9656e5ac2a..28eefbd398 100644 --- a/guix/serialization.scm +++ b/guix/serialization.scm @@ -31,7 +31,8 @@ (define-module (guix serialization) write-long-long read-long-long write-padding write-bytevector write-string - read-string read-latin1-string read-maybe-utf8-string + read-string read-byte-string + read-latin1-string read-maybe-utf8-string write-string-list read-string-list write-string-pairs read-string-pairs write-store-path read-store-path From patchwork Sun Apr 21 09:42:26 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63255 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 DCAE927BBEA; Sun, 21 Apr 2024 10:45: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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, 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 6057F27BBE2 for ; Sun, 21 Apr 2024 10:45:00 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTjy-0005XJ-RD; Sun, 21 Apr 2024 05:44:06 -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 1ryTjl-0005Qb-6O for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:55 -0400 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 1ryTjk-0002md-EO; Sun, 21 Apr 2024 05:43:52 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTjx-0006U7-J3; Sun, 21 Apr 2024 05:44:05 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 08/23] store: Add text-output-path and text-output-path-from-hash. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369260624475 (code B ref 70494); Sun, 21 Apr 2024 09:44:05 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:26 +0000 Received: from localhost ([127.0.0.1]:41766 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjJ-0006MQ-13 for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:26 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43368) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTix-0006I0-KR for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:05 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 70C0327BBF0 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:47 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id f194f578 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:46 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:26 +0100 Message-ID: <07a1cd0965422c6bdbcdf52834cd33cee7951114.1713692561.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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/store.scm (text-output-path, text-output-path-from-hash): New procedures. Change-Id: I38c3aaa0b304dd4f97a222a1065eb1b7f55bbfad --- guix/store.scm | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/guix/store.scm b/guix/store.scm index 578e46507e..b83f205096 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -196,6 +196,8 @@ (define-module (guix store) store-path output-path fixed-output-path + text-output-path + text-output-path-from-hash store-path? direct-store-path? derivation-path? @@ -2280,6 +2282,20 @@ (define* (fixed-output-path name hash (sha256 (string->utf8 tag)) name)))) +(define (text-output-path name text references) + (text-output-path-from-hash + name + (sha256 (string->utf8 text)) + references)) + +(define* (text-output-path-from-hash name text-hash references) + (store-path + (string-append "text" (string-join (sort references string X-Patchwork-Id: 63248 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 5993E27BBED; Sun, 21 Apr 2024 10:44:30 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS 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 DEDB327BBE9 for ; Sun, 21 Apr 2024 10:44:29 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTjz-0005Z1-HM; Sun, 21 Apr 2024 05:44:07 -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 1ryTjl-0005Qg-8P for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:54 -0400 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 1ryTjk-0002ms-WB; Sun, 21 Apr 2024 05:43:53 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTjw-0006Td-9w; Sun, 21 Apr 2024 05:44:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 09/23] store: Add validate-store-name. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369260324429 (code B ref 70494); Sun, 21 Apr 2024 09:44:04 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:23 +0000 Received: from localhost ([127.0.0.1]:41760 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjG-0006Lr-4H for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:22 -0400 Received: from mira.cbaines.net ([2a01:7e00:e000:2f8:fd4d:b5c7:13fb:3d27]:39677) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTix-0006Hx-Jm for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:04 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 76D2827BBF1 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:47 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 0bf7e054 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:47 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:27 +0100 Message-ID: <803b6bbff7d1cad61eff5b9f8c18007af53de436.1713692561.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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/store.scm (validate-store-name): New procedure. Change-Id: I507d070d1cfdbd433d93830ee2937b1a1dee315a --- guix/store.scm | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/guix/store.scm b/guix/store.scm index b83f205096..096efcd128 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -205,6 +205,7 @@ (define-module (guix store) store-path-package-name store-path-hash-part direct-store-path + validate-store-name derivation-log-file log-file)) @@ -2303,6 +2304,16 @@ (define (store-path? path) ;; `isStorePath' in Nix does something similar. (string-prefix? (%store-prefix) path)) +(define (validate-store-name name) + (string-for-each + (lambda (c) + (unless (or (char-alphabetic? c) + (char-numeric? c) + (member c '(#\+ #\- #\. #\_ #\? #\=))) + (error (simple-format #f "invalid character ~A" c)))) + name) + #t) + (define (direct-store-path? path) "Return #t if PATH is a store path, and not a sub-directory of a store path. This predicate is sometimes needed because files *under* a store path are not From patchwork Sun Apr 21 09:42:28 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63265 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 5328F27BBE2; Sun, 21 Apr 2024 10:45:55 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, 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 1786827BBEA for ; Sun, 21 Apr 2024 10:45:54 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTk0-0005eB-TO; Sun, 21 Apr 2024 05:44:08 -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 1ryTjm-0005Rz-MS for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:55 -0400 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 1ryTjm-0002pL-DD; Sun, 21 Apr 2024 05:43:54 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTk0-0006VM-1B; Sun, 21 Apr 2024 05:44:08 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 10/23] store: database: Add procedures for querying valid paths. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:07 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369262624672 (code B ref 70494); Sun, 21 Apr 2024 09:44:07 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:46 +0000 Received: from localhost ([127.0.0.1]:41780 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjb-0006Pa-T4 for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:45 -0400 Received: from mira.cbaines.net ([2a01:7e00:e000:2f8:fd4d:b5c7:13fb:3d27]:45147) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTiy-0006I6-EY for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:06 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 7CFE327BBF2 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:47 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 5123b2fe for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:47 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:28 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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/store/database.scm (valid-path, all-valid-paths, valid-path-from-hash-part, valid-path-references): New procedures. Change-Id: Ib08837ee20f5a5a24a8089e611b5d67b003b62cc --- guix/store/database.scm | 88 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 87 insertions(+), 1 deletion(-) diff --git a/guix/store/database.scm b/guix/store/database.scm index 07bd501644..8a3436368e 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -55,9 +55,13 @@ (define-module (guix store database) %epoch reset-timestamps vacuum-database + valid-path + all-valid-paths + valid-path-from-hash-part outputs-exist? file-closure - all-transitive-inputs)) + all-transitive-inputs + valid-path-references)) ;;; Code for working with the store database directly. @@ -447,6 +451,63 @@ (define (vacuum-database) (sqlite-exec db "VACUUM;") (sqlite-close db))) +(define (valid-path db store-filename) + (let ((statement + (sqlite-prepare + db + " +SELECT id, hash, registrationTime, deriver, narSize +FROM ValidPaths +WHERE path = :path" + #:cache? #t))) + + (sqlite-bind-arguments + statement + #:path store-filename) + + (let ((result (sqlite-step statement))) + (sqlite-reset statement) + + result))) + +(define (all-valid-paths db) + (let ((statement + (sqlite-prepare + db + " +SELECT path FROM ValidPaths" + #:cache? #t))) + + (let ((result + (sqlite-map + (match-lambda + (#(path) path)) + statement))) + (sqlite-reset statement) + + result))) + +(define (valid-path-from-hash-part db hash) + (let ((statement + (sqlite-prepare + db + " +SELECT path FROM ValidPaths WHERE path >= :path LIMIT 1" + #:cache? #t)) + (path-prefix + (string-append (%store-prefix) "/" hash))) + + (sqlite-bind-arguments + statement + #:path path-prefix) + + (let ((result + (sqlite-step statement))) + + (if (and result (string-prefix? path-prefix result)) + result + #f)))) + (define (outputs-exist? db drv-path outputs) "Determine whether all output labels in OUTPUTS exist as built outputs of DRV-PATH." @@ -527,3 +588,28 @@ (define (all-transitive-inputs db drv) vlist-null `(,@(derivation-sources drv) ,@input-paths))))) + +(define (valid-path-references db valid-path-id) + (let ((statement + (sqlite-prepare + db + " +SELECT ValidPaths.path +FROM Refs +INNER JOIN ValidPaths ON Refs.reference = ValidPaths.id +WHERE referrer = :id" + #:cache? #t))) + + (sqlite-bind-arguments + statement + #:id valid-path-id) + + (let ((result (sqlite-fold + (lambda (row result) + (cons (vector-ref row 0) + result)) + '() + statement))) + (sqlite-reset statement) + + result))) From patchwork Sun Apr 21 09:42:29 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63246 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 B894627BBE9; Sun, 21 Apr 2024 10:44:10 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, 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 4E5FE27BBE2 for ; Sun, 21 Apr 2024 10:44:09 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTjz-0005Z6-Lw; Sun, 21 Apr 2024 05:44:07 -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 1ryTjl-0005Rn-UC for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:55 -0400 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 1ryTjl-0002on-Ge; Sun, 21 Apr 2024 05:43:53 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTjy-0006US-BD; Sun, 21 Apr 2024 05:44:06 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 11/23] scripts: substitute: Untangle selecting fast vs small compressions. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:06 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369262124607 (code B ref 70494); Sun, 21 Apr 2024 09:44:06 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:41 +0000 Received: from localhost ([127.0.0.1]:41772 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjY-0006Oi-FT for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:41 -0400 Received: from mira.cbaines.net ([2a01:7e00:e000:2f8:fd4d:b5c7:13fb:3d27]:39467) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTiy-0006I7-ET for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:07 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 825B127BBF3 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:47 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 17857b79 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:47 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:29 +0100 Message-ID: <1fbbc6d1b99d423ed58bdb126f30a309a1e99117.1713692561.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 Pulling the logic up to the script makes this code more portable and not reliant on setting a global variable. * guix/scripts/substitute.scm (%prefer-fast-decompression?): Rename to… (%default-prefer-fast-decompression?): this. (call-with-cpu-usage-monitoring): Use multiple values to return the results from the thunk as well as the cpu usage. (display-narinfo-data): Update accordingly. (download-nar): Add prefer-fast-decompression? as a keyword argument, remove code to set! it and monitor the cpu-usage. (process-substitution, process-substitution/fallback): Accept and pass through prefer-fast-decompression? to download-nar. (guix-substitute): Move the cpu usage monitoring and prefer fast decompression switching logic here. Change-Id: I4e80b457b55bcda8c0ff4ee224dd94a55e1b24fb --- guix/scripts/substitute.scm | 126 +++++++++++++++++++++--------------- 1 file changed, 73 insertions(+), 53 deletions(-) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index a7ad56dbcd..0d0fd0e73b 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -261,22 +261,24 @@ (define (show-help) ;;; Daemon/substituter protocol. ;;; -(define %prefer-fast-decompression? - ;; Whether to prefer fast decompression over good compression ratios. This - ;; serves in particular to choose between lzip (high compression ratio but - ;; low decompression throughput) and zstd (lower compression ratio but high - ;; decompression throughput). - #f) - -(define (call-with-cpu-usage-monitoring proc) +;; Whether to initially prefer fast decompression or not +(define %default-prefer-fast-decompression? #f) + +(define (call-with-cpu-usage-monitoring thunk) (let ((before (times))) - (proc) - (let ((after (times))) - (if (= (tms:clock after) (tms:clock before)) - 0 - (/ (- (tms:utime after) (tms:utime before)) - (- (tms:clock after) (tms:clock before)) - 1.))))) + (call-with-values thunk + (lambda vals + (let ((after (times))) + (apply + values + (append + (or vals '()) + (list + (if (= (tms:clock after) (tms:clock before)) + 0 + (/ (- (tms:utime after) (tms:utime before)) + (- (tms:clock after) (tms:clock before)) + 1.)))))))))) (define-syntax-rule (with-cpu-usage-monitoring exp ...) "Evaluate EXP... Return its CPU usage as a fraction between 0 and 1." @@ -297,7 +299,7 @@ (define (display-narinfo-data port narinfo) (let ((uri compression file-size (narinfo-best-uri narinfo #:fast-decompression? - %prefer-fast-decompression?))) + %default-prefer-fast-decompression?))) (format port "~a\n~a\n" (or file-size 0) (or (narinfo-size narinfo) 0)))) @@ -453,7 +455,8 @@ (define-syntax-rule (catch-system-error exp) (define* (download-nar narinfo destination #:key status-port deduplicate? print-build-trace? - (fetch-timeout %fetch-timeout)) + (fetch-timeout %fetch-timeout) + prefer-fast-decompression?) "Download the nar prescribed in NARINFO, which is assumed to be authentic and authorized, and write it to DESTINATION. When DEDUPLICATE? is true, and if DESTINATION is in the store, deduplicate its files. Print a status line to @@ -527,7 +530,7 @@ (define* (download-nar narinfo destination (let ((choices (narinfo-preferred-uris narinfo #:fast-decompression? - %prefer-fast-decompression?))) + prefer-fast-decompression?))) ;; 'guix publish' without '--cache' doesn't specify a Content-Length, so ;; DOWNLOAD-SIZE is #f in this case. (let* ((raw uri compression download-size (try-fetch choices)) @@ -560,29 +563,13 @@ (define* (download-nar narinfo destination ;; Compute the actual nar hash as we read it. (algorithm expected (narinfo-hash-algorithm+value narinfo)) (hashed get-hash (open-hash-input-port algorithm input))) - ;; Unpack the Nar at INPUT into DESTINATION. - (define cpu-usage - (with-cpu-usage-monitoring - (restore-file hashed destination - #:dump-file (if (and destination-in-store? - deduplicate?) - dump-file/deduplicate* - dump-file)))) - - ;; Create a hysteresis: depending on CPU usage, favor compression - ;; methods with faster decompression (like ztsd) or methods with better - ;; compression ratios (like lzip). This stems from the observation that - ;; substitution can be CPU-bound when high-speed networks are used: - ;; . - ;; To simulate "slow" networking or changing conditions, run: - ;; sudo tc qdisc add dev eno1 root tbf rate 512kbit latency 50ms burst 1540 - ;; and then cancel with: - ;; sudo tc qdisc del dev eno1 root - (when (> cpu-usage .8) - (set! %prefer-fast-decompression? #t)) - (when (< cpu-usage .2) - (set! %prefer-fast-decompression? #f)) + ;; Unpack the Nar at INPUT into DESTINATION. + (restore-file hashed destination + #:dump-file (if (and destination-in-store? + deduplicate?) + dump-file/deduplicate* + dump-file)) (close-port hashed) (close-port input) @@ -630,7 +617,8 @@ (define network-error? (define* (process-substitution/fallback port narinfo destination #:key cache-urls acl - deduplicate? print-build-trace?) + deduplicate? print-build-trace? + prefer-fast-decompression?) "Attempt to substitute NARINFO, which is assumed to be authorized or equivalent, by trying to download its nar from each entry in CACHE-URLS. @@ -664,14 +652,17 @@ (define* (process-substitution/fallback port narinfo destination (download-nar alternate destination #:status-port port #:deduplicate? deduplicate? - #:print-build-trace? print-build-trace?)) + #:print-build-trace? print-build-trace? + #:prefer-fast-decompression? + prefer-fast-decompression?)) (loop rest))) (() (loop rest))))))) (define* (process-substitution port store-item destination #:key cache-urls acl - deduplicate? print-build-trace?) + deduplicate? print-build-trace? + prefer-fast-decompression?) "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to DESTINATION as a nar file. Verify the substitute against ACL, and verify its hash against what appears in the narinfo. When DEDUPLICATE? is true, and if @@ -703,11 +694,14 @@ (define* (process-substitution port store-item destination #:acl acl #:deduplicate? deduplicate? #:print-build-trace? - print-build-trace?))) + print-build-trace? + #:prefer-fast-decompression? + prefer-fast-decompression?))) (download-nar narinfo destination #:status-port port #:deduplicate? deduplicate? - #:print-build-trace? print-build-trace?))) + #:print-build-trace? print-build-trace? + #:prefer-fast-decompression? prefer-fast-decompression?))) ;;; @@ -897,18 +891,44 @@ (define-command (guix-substitute . args) ;; Specify the number of columns of the terminal so the progress ;; report displays nicely. (parameterize ((current-terminal-columns (client-terminal-columns))) - (let loop () + (let loop ((prefer-fast-decompression? + %default-prefer-fast-decompression?)) (match (read-line) ((? eof-object?) #t) ((= string-tokenize ("substitute" store-path destination)) - (process-substitution reply-port store-path destination - #:cache-urls (substitute-urls) - #:acl (current-acl) - #:deduplicate? deduplicate? - #:print-build-trace? - print-build-trace?) - (loop)))))) + (let ((cpu-usage + (with-cpu-usage-monitoring + (process-substitution + reply-port store-path destination + #:cache-urls (substitute-urls) + #:acl (current-acl) + #:deduplicate? deduplicate? + #:print-build-trace? + print-build-trace? + #:prefer-fast-decompression? + prefer-fast-decompression?)))) + + ;; Create a hysteresis: depending on CPU usage, favor + ;; compression methods with faster decompression (like ztsd) + ;; or methods with better compression ratios (like lzip). + ;; This stems from the observation that substitution can be + ;; CPU-bound when high-speed networks are used: + ;; . + ;; To simulate "slow" networking or changing conditions, run: + ;; sudo tc qdisc add dev eno1 root tbf rate 512kbit latency + ;; 50ms burst 1540 and then cancel with: sudo tc qdisc del + ;; dev eno1 root + (loop (cond + ;; Whether to prefer fast decompression over good + ;; compression ratios. This serves in particular to + ;; choose between lzip (high compression ratio but low + ;; decompression throughput) and zstd (lower + ;; compression ratio but high decompression + ;; throughput). + ((> cpu-usage .8) #t) + ((< cpu-usage .2) #f) + (else prefer-fast-decompression?))))))))) (opts (leave (G_ "~a: unrecognized options~%") opts)))))) From patchwork Sun Apr 21 09:42:30 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63257 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 5D49A27BBEA; Sun, 21 Apr 2024 10:45:14 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, 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 3967927BBE2 for ; Sun, 21 Apr 2024 10:45:12 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTk1-0005f6-8i; Sun, 21 Apr 2024 05:44:09 -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 1ryTjo-0005T9-LI for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:57 -0400 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 1ryTjo-0002q5-5o; Sun, 21 Apr 2024 05:43:56 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTk2-0006WA-4K; Sun, 21 Apr 2024 05:44:10 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 12/23] scripts: substitute: Extract script specific output from download-nar. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:10 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369263424757 (code B ref 70494); Sun, 21 Apr 2024 09:44:10 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:54 +0000 Received: from localhost ([127.0.0.1]:41789 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjl-0006RA-1q for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:53 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43366) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTiz-0006Hy-0F for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:09 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 87C7D27BBF4 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:47 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 9e11747a for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:47 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:30 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 As this moves download-nar in a direction where it could be used outside the substitute script. * guix/scripts/substitute.scm (download-nar): Return expected and actual hashes and move status-port output to guix-substitute. (process-substitution/fallback): Remove port argument, and move output to port to guix-substitute. (process-substitution): Return hashes from download-nar or process-substitution/fallback, plus the narinfo. (guix-substitute): Don't pass the reply-port in to process-substitution and implement the messages to the reply-port here. Change-Id: Icbddb9a47620b3520cdd2e8095f37a99824c1ce0 --- guix/scripts/substitute.scm | 162 ++++++++++++++++++++---------------- 1 file changed, 90 insertions(+), 72 deletions(-) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 0d0fd0e73b..c2bc16085d 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -453,14 +453,12 @@ (define-syntax-rule (catch-system-error exp) (const #f))) (define* (download-nar narinfo destination - #:key status-port - deduplicate? print-build-trace? + #:key deduplicate? print-build-trace? (fetch-timeout %fetch-timeout) prefer-fast-decompression?) "Download the nar prescribed in NARINFO, which is assumed to be authentic and authorized, and write it to DESTINATION. When DEDUPLICATE? is true, and -if DESTINATION is in the store, deduplicate its files. Print a status line to -STATUS-PORT." +if DESTINATION is in the store, deduplicate its files." (define destination-in-store? (string-prefix? (string-append (%store-prefix) "/") destination)) @@ -576,24 +574,8 @@ (define* (download-nar narinfo destination ;; Wait for the reporter to finish. (every (compose zero? cdr waitpid) pids) - ;; Skip a line after what 'progress-reporter/file' printed, and another - ;; one to visually separate substitutions. When PRINT-BUILD-TRACE? is - ;; true, leave it up to (guix status) to prettify things. - (newline (current-error-port)) - (unless print-build-trace? - (newline (current-error-port))) - - ;; Check whether we got the data announced in NARINFO. - (let ((actual (get-hash))) - (if (bytevector=? actual expected) - ;; Tell the daemon that we're done. - (format status-port "success ~a ~a~%" - (narinfo-hash narinfo) (narinfo-size narinfo)) - ;; The actual data has a different hash than that in NARINFO. - (format status-port "hash-mismatch ~a ~a ~a~%" - (hash-algorithm-name algorithm) - (bytevector->nix-base32-string expected) - (bytevector->nix-base32-string actual))))))) + (values expected + (get-hash))))) (define (system-error? exception) "Return true if EXCEPTION is a Guile 'system-error exception." @@ -615,7 +597,7 @@ (define network-error? '(gnutls-error getaddrinfo-error))) (http-get-error? exception))))) -(define* (process-substitution/fallback port narinfo destination +(define* (process-substitution/fallback narinfo destination #:key cache-urls acl deduplicate? print-build-trace? prefer-fast-decompression?) @@ -630,9 +612,8 @@ (define* (process-substitution/fallback port narinfo destination (let loop ((cache-urls cache-urls)) (match cache-urls (() - (report-error (G_ "failed to find alternative substitute for '~a'~%") - (narinfo-path narinfo)) - (display "not-found\n" port)) + ;; Failure, so return two values like download-nar + (values #f #f)) ((cache-url rest ...) (match (lookup-narinfos cache-url (list (narinfo-path narinfo)) @@ -650,7 +631,6 @@ (define* (process-substitution/fallback port narinfo destination (http-get-error-reason c))) (loop rest))) (download-nar alternate destination - #:status-port port #:deduplicate? deduplicate? #:print-build-trace? print-build-trace? #:prefer-fast-decompression? @@ -659,7 +639,7 @@ (define* (process-substitution/fallback port narinfo destination (() (loop rest))))))) -(define* (process-substitution port store-item destination +(define* (process-substitution store-item destination #:key cache-urls acl deduplicate? print-build-trace? prefer-fast-decompression?) @@ -680,28 +660,34 @@ (define* (process-substitution port store-item destination (G_ "no valid substitute for '~a'~%") store-item))) - (guard (c ((network-error? c) - (when (http-get-error? c) - (warning (G_ "download from '~a' failed: ~a, ~s~%") - (uri->string (http-get-error-uri c)) - (http-get-error-code c) - (http-get-error-reason c))) - (format (current-error-port) - (G_ "retrying download of '~a' with other substitute URLs...~%") - store-item) - (process-substitution/fallback port narinfo destination - #:cache-urls cache-urls - #:acl acl - #:deduplicate? deduplicate? - #:print-build-trace? - print-build-trace? - #:prefer-fast-decompression? - prefer-fast-decompression?))) - (download-nar narinfo destination - #:status-port port - #:deduplicate? deduplicate? - #:print-build-trace? print-build-trace? - #:prefer-fast-decompression? prefer-fast-decompression?))) + (let ((expected-hash + actual-hash + (guard + (c ((network-error? c) + (when (http-get-error? c) + (warning (G_ "download from '~a' failed: ~a, ~s~%") + (uri->string (http-get-error-uri c)) + (http-get-error-code c) + (http-get-error-reason c))) + (format + (current-error-port) + (G_ "retrying download of '~a' with other substitute URLs...~%") + store-item) + (process-substitution/fallback narinfo destination + #:cache-urls cache-urls + #:acl acl + #:deduplicate? deduplicate? + #:print-build-trace? + print-build-trace? + #:prefer-fast-decompression? + prefer-fast-decompression?))) + (download-nar narinfo destination + #:deduplicate? deduplicate? + #:print-build-trace? print-build-trace? + #:prefer-fast-decompression? prefer-fast-decompression?)))) + (values narinfo + expected-hash + actual-hash))) ;;; @@ -897,10 +883,13 @@ (define-command (guix-substitute . args) ((? eof-object?) #t) ((= string-tokenize ("substitute" store-path destination)) - (let ((cpu-usage + (let ((narinfo + expected-hash + actual-hash + cpu-usage (with-cpu-usage-monitoring (process-substitution - reply-port store-path destination + store-path destination #:cache-urls (substitute-urls) #:acl (current-acl) #:deduplicate? deduplicate? @@ -909,26 +898,55 @@ (define-command (guix-substitute . args) #:prefer-fast-decompression? prefer-fast-decompression?)))) - ;; Create a hysteresis: depending on CPU usage, favor - ;; compression methods with faster decompression (like ztsd) - ;; or methods with better compression ratios (like lzip). - ;; This stems from the observation that substitution can be - ;; CPU-bound when high-speed networks are used: - ;; . - ;; To simulate "slow" networking or changing conditions, run: - ;; sudo tc qdisc add dev eno1 root tbf rate 512kbit latency - ;; 50ms burst 1540 and then cancel with: sudo tc qdisc del - ;; dev eno1 root - (loop (cond - ;; Whether to prefer fast decompression over good - ;; compression ratios. This serves in particular to - ;; choose between lzip (high compression ratio but low - ;; decompression throughput) and zstd (lower - ;; compression ratio but high decompression - ;; throughput). - ((> cpu-usage .8) #t) - ((< cpu-usage .2) #f) - (else prefer-fast-decompression?))))))))) + (if expected-hash + (begin + ;; Skip a line after what 'progress-reporter/file' + ;; printed, and another one to visually separate + ;; substitutions. When PRINT-BUILD-TRACE? is true, + ;; leave it up to (guix status) to prettify things. + (newline (current-error-port)) + (unless print-build-trace? + (newline (current-error-port))) + + ;; Check whether we got the data announced in NARINFO. + (if (bytevector=? actual-hash expected-hash) + ;; Tell the daemon that we're done. + (format reply-port "success ~a ~a~%" + (narinfo-hash narinfo) (narinfo-size narinfo)) + ;; The actual data has a different hash than that in NARINFO. + (format reply-port "hash-mismatch ~a ~a ~a~%" + (hash-algorithm-name + (narinfo-hash-algorithm+value narinfo)) + (bytevector->nix-base32-string expected-hash) + (bytevector->nix-base32-string actual-hash))) + + ;; Create a hysteresis: depending on CPU usage, favor + ;; compression methods with faster decompression (like + ;; ztsd) or methods with better compression ratios + ;; (like lzip). This stems from the observation that + ;; substitution can be CPU-bound when high-speed + ;; networks are used: + ;; . + ;; To simulate "slow" networking or changing + ;; conditions, run: sudo tc qdisc add dev eno1 root tbf + ;; rate 512kbit latency 50ms burst 1540 and then cancel + ;; with: sudo tc qdisc del dev eno1 root + (loop (cond + ;; Whether to prefer fast decompression over + ;; good compression ratios. This serves in + ;; particular to choose between lzip (high + ;; compression ratio but low decompression + ;; throughput) and zstd (lower compression ratio + ;; but high decompression throughput). + ((> cpu-usage .8) #t) + ((< cpu-usage .2) #f) + (else prefer-fast-decompression?)))) + (begin + (report-error (G_ "failed to find alternative substitute for '~a'~%") + (narinfo-path narinfo)) + (display "not-found\n" reply-port) + + (loop prefer-fast-decompression?))))))))) (opts (leave (G_ "~a: unrecognized options~%") opts)))))) From patchwork Sun Apr 21 09:42:31 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63250 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 C444027BBE2; Sun, 21 Apr 2024 10:44:32 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS 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 2511827BBEB for ; Sun, 21 Apr 2024 10:44:30 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTk0-0005dv-Pr; Sun, 21 Apr 2024 05:44:08 -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 1ryTjk-0005QY-WE for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:53 -0400 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 1ryTjk-0002mP-1G for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:52 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTjz-0006Uw-7E for guix-patches@gnu.org; Sun, 21 Apr 2024 05:44:07 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 13/23] syscalls: Add unshare. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:07 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369262324634 (code B ref 70494); Sun, 21 Apr 2024 09:44:07 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:43 +0000 Received: from localhost ([127.0.0.1]:41776 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTja-0006Oy-0N for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:42 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43370) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTiz-0006IJ-Bv for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:07 -0400 Received: from localhost (unknown [IPv6:2a02:6b67:d93b:1:254c:b471:debc:14be]) by mira.cbaines.net (Postfix) with ESMTPSA id 3DBF327BBE9 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:48 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 5488e2bb for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:47 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:31 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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/build/syscalls.scm (unshare): New procedure. Change-Id: I7caad207117b17b349290e680277f650c51d2f3b --- guix/build/syscalls.scm | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 487ee68b43..492a229938 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -36,6 +36,7 @@ (define-module (guix build syscalls) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-71) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 match) @@ -121,6 +122,7 @@ (define-module (guix build syscalls) mkdtemp! fdatasync pivot-root + unshare scandir* getxattr setxattr @@ -1183,6 +1185,16 @@ (define pivot-root (list new-root put-old (strerror err)) (list err))))))) +(define unshare + (false-if-exception + (let ((proc (syscall->procedure int "unshare" (list int)))) + (lambda (flags) + (let ((ret err (proc flags))) + (unless (zero? ret) + (throw 'system-error "unshare" "~d ~d: ~A" + (list flags (strerror err)) + (list err)))))))) + ;;; ;;; Opendir & co. From patchwork Sun Apr 21 09:42:32 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63260 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 80DC127BBEA; Sun, 21 Apr 2024 10:45:45 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS 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 01A6227BBE2 for ; Sun, 21 Apr 2024 10:45:45 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTk7-0005pv-IW; Sun, 21 Apr 2024 05:44: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 1ryTjl-0005Qa-5v for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:53 -0400 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 1ryTjk-0002mb-6L; Sun, 21 Apr 2024 05:43:52 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTjx-0006UI-V2; Sun, 21 Apr 2024 05:44:05 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 14/23] scripts: perform-download: Support configuring the %store-prefix. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369262024599 (code B ref 70494); Sun, 21 Apr 2024 09:44:05 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:40 +0000 Received: from localhost ([127.0.0.1]:41770 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjW-0006OU-Lq for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:40 -0400 Received: from mira.cbaines.net ([2a01:7e00:e000:2f8:fd4d:b5c7:13fb:3d27]:39677) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTiz-0006Hx-0b for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:07 -0400 Received: from localhost (unknown [IPv6:2a02:6b67:d93b:1:254c:b471:debc:14be]) by mira.cbaines.net (Postfix) with ESMTPSA id 453AB27BBEA for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:48 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id f8b19d1f for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:47 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:32 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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/scripts/perform-download.scm (guix-perform-download): Use GUIX_STORE_DIRECTORY from the environment if it's set, as this allows using the perform-download script with a non-default store directory. Change-Id: Id96bb901a106e1b13be5b21b3ce436c680c616a2 --- guix/scripts/perform-download.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm index 5079d0ea71..f7f5231f27 100644 --- a/guix/scripts/perform-download.scm +++ b/guix/scripts/perform-download.scm @@ -20,7 +20,8 @@ (define-module (guix scripts perform-download) #:use-module (guix ui) #:use-module (guix scripts) #:use-module (guix derivations) - #:use-module ((guix store) #:select (derivation-path? store-path?)) + #:use-module ((guix store) #:select (%store-prefix derivation-path? + store-path?)) #:autoload (guix build download) (%download-methods url-fetch) #:autoload (guix build git) (git-fetch-with-fallback) #:autoload (guix config) (%git) @@ -153,6 +154,9 @@ (define-command (guix-perform-download . args) (#f #f) (str (string-contains str "print-extended-build-trace=1")))) + (and=> (getenv "GUIX_STORE_DIRECTORY") + %store-prefix) + ;; This program must be invoked by guix-daemon under an unprivileged UID to ;; prevent things downloading from 'file:///etc/shadow' or arbitrary code ;; execution via the content-addressed mirror procedures. (That means we From patchwork Sun Apr 21 09:42:33 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63252 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 8502C27BBEC; Sun, 21 Apr 2024 10:44:52 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS 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 2C08227BBE2 for ; Sun, 21 Apr 2024 10:44:52 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTk4-0005n0-Q8; Sun, 21 Apr 2024 05:44:12 -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 1ryTjl-0005RR-Lm for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:55 -0400 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 1ryTjl-0002oE-CP; Sun, 21 Apr 2024 05:43:53 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTjy-0006Ug-O3; Sun, 21 Apr 2024 05:44:06 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 15/23] store: Export operation-id. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:06 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369262224615 (code B ref 70494); Sun, 21 Apr 2024 09:44:06 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:42 +0000 Received: from localhost ([127.0.0.1]:41774 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjZ-0006Oq-Ki for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:41 -0400 Received: from mira.cbaines.net ([2a01:7e00:e000:2f8:fd4d:b5c7:13fb:3d27]:43899) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTiz-0006IK-Bc for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:07 -0400 Received: from localhost (unknown [IPv6:2a02:6b67:d93b:1:254c:b471:debc:14be]) by mira.cbaines.net (Postfix) with ESMTPSA id 4B28127BBF5 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:48 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id b3c8ba3a for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:47 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:33 +0100 Message-ID: <1a9521650cc02618a0df863c9a753c38907d5e46.1713692561.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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/store.scm (operation-id): Export. Change-Id: I03c83973c9056795fef935016df7321a69c1116d --- guix/store.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/guix/store.scm b/guix/store.scm index 096efcd128..cbf644ac30 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -101,6 +101,8 @@ (define-module (guix store) hash-algo build-mode + operation-id + connect-to-daemon open-connection port->connection From patchwork Sun Apr 21 09:42:34 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63259 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 76A7E27BBEA; Sun, 21 Apr 2024 10:45:25 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, 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 0481627BBE2 for ; Sun, 21 Apr 2024 10:45:25 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTjz-0005YK-8B; Sun, 21 Apr 2024 05:44:07 -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 1ryTjn-0005S1-1X for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:55 -0400 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 1ryTjm-0002pd-PA; Sun, 21 Apr 2024 05:43:54 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTk0-0006VY-Eo; Sun, 21 Apr 2024 05:44:08 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 16/23] store: database: Log when aborting transactions. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:08 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369262724689 (code B ref 70494); Sun, 21 Apr 2024 09:44:08 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:47 +0000 Received: from localhost ([127.0.0.1]:41783 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjd-0006Pt-Iz for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:46 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43364) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTiz-0006Hz-K3 for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:08 -0400 Received: from localhost (unknown [IPv6:2a02:6b67:d93b:1:254c:b471:debc:14be]) by mira.cbaines.net (Postfix) with ESMTPSA id 5B86A27BBF6 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:48 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 7e4e40b7 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:48 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:34 +0100 Message-ID: <21c24e8933feb110c2e6cd5782d39adab3b66546.1713692561.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 Otherwise this has the effect of masking the backtrace/exception. * guix/store/database.scm (call-with-transaction): Log when aborting. Change-Id: Iee31905c4688dc62ef37a85b0208fd324ee67d70 --- guix/store/database.scm | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/guix/store/database.scm b/guix/store/database.scm index 8a3436368e..b6f87d710f 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -154,9 +154,17 @@ (define* (call-with-transaction db proc #:key restartable?) (sqlite-exec db (if restartable? "begin;" "begin immediate;")) (catch #t (lambda () - (let-values ((result (proc))) - (sqlite-exec db "commit;") - (apply values result))) + (with-throw-handler #t + (lambda () + (call-with-values proc + (lambda vals + (sqlite-exec db "commit;") + (apply values vals)))) + (lambda (key args) + (simple-format + (current-error-port) + "transaction aborted: ~A: ~A\n" key args) + (backtrace)))) (lambda args ;; The roll back may or may not have occurred automatically when the ;; error was generated. If it has occurred, this does nothing but signal From patchwork Sun Apr 21 09:42:35 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63251 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 C31A327BBEA; Sun, 21 Apr 2024 10:44:34 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, 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 5880B27BBE2 for ; Sun, 21 Apr 2024 10:44:34 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTjz-0005YC-3E; Sun, 21 Apr 2024 05:44:07 -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 1ryTjm-0005S0-OE for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:55 -0400 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 1ryTjm-0002pK-Bs; Sun, 21 Apr 2024 05:43:54 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTjz-0006V8-KY; Sun, 21 Apr 2024 05:44:07 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 17/23] store: database: Export transaction helpers. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:07 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369262424653 (code B ref 70494); Sun, 21 Apr 2024 09:44:07 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:44 +0000 Received: from localhost ([127.0.0.1]:41778 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTja-0006PH-E5 for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:43 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43372) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTiz-0006IR-SW for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:08 -0400 Received: from localhost (unknown [IPv6:2a02:6b67:d93b:1:254c:b471:debc:14be]) by mira.cbaines.net (Postfix) with ESMTPSA id 6163227BBF7 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:48 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 9dd22500 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:48 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:35 +0100 Message-ID: <732f10191cbb57caae0cda7428382ddba6a4dba1.1713692561.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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/store/database.scm (call-with-transaction, call-with-retrying-transaction): Export procedures. Change-Id: I712f0056f263989769af7cb6f9e395a43f6e36b2 --- guix/store/database.scm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/guix/store/database.scm b/guix/store/database.scm index b6f87d710f..6c8c07e2de 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -46,6 +46,9 @@ (define-module (guix store database) call-with-database with-database + call-with-transaction + call-with-retrying-transaction + valid-path-id register-valid-path From patchwork Sun Apr 21 09:42:36 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63245 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 B56E427BBE2; Sun, 21 Apr 2024 10:44:08 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS 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 BA8E827BBE9 for ; Sun, 21 Apr 2024 10:44:07 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTjy-0005WN-ON; Sun, 21 Apr 2024 05:44:06 -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 1ryTjo-0005Sl-8e for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:56 -0400 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 1ryTjn-0002pv-Vz; Sun, 21 Apr 2024 05:43:56 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTk2-0006WM-JJ; Sun, 21 Apr 2024 05:44:10 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 18/23] guix: http-client: Add network-error?. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:10 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369263624785 (code B ref 70494); Sun, 21 Apr 2024 09:44:10 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:56 +0000 Received: from localhost ([127.0.0.1]:41791 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjl-0006RL-Vd for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:55 -0400 Received: from mira.cbaines.net ([2a01:7e00:e000:2f8:fd4d:b5c7:13fb:3d27]:46331) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTj0-0006IW-0M for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:09 -0400 Received: from localhost (unknown [IPv6:2a02:6b67:d93b:1:254c:b471:debc:14be]) by mira.cbaines.net (Postfix) with ESMTPSA id 675C627BBF8 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:48 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id d4947319 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:48 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:36 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 Plus remove http-get-error? from network-error? as a http-get-error? doesn't indicate a network error. * guix/scripts/substitute.scm (system-error?, network-error?): Move from here. (process-substitution/fallback, process-substitution): Use http-get-error? with network-error?. * guix/http-client.scm: To here, and also don't use http-get-error?. Change-Id: I61ee9e5fbf90ebb76a34aa8b9ec8f5d74f8a3c54 --- guix/http-client.scm | 23 +++++++++++++++++++++++ guix/scripts/substitute.scm | 26 ++++---------------------- 2 files changed, 27 insertions(+), 22 deletions(-) diff --git a/guix/http-client.scm b/guix/http-client.scm index 9138a627ac..024705e9ec 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -54,6 +54,8 @@ (define-module (guix http-client) http-get-error-reason http-get-error-headers + network-error? + http-fetch http-multiple-get @@ -75,6 +77,27 @@ (define-condition-type &http-get-error &error (reason http-get-error-reason) ;string (headers http-get-error-headers)) ;alist +(define kind-and-args-exception? + (exception-predicate &exception-with-kind-and-args)) + +(define (system-error? exception) + "Return true if EXCEPTION is a Guile 'system-error exception." + (and (kind-and-args-exception? exception) + (eq? 'system-error (exception-kind exception)))) + +(define network-error? + (let ((kind-and-args? (exception-predicate &exception-with-kind-and-args))) + (lambda (exception) + "Return true if EXCEPTION denotes a networking error." + (or (and (system-error? exception) + (let ((errno (system-error-errno + (cons 'system-error (exception-args exception))))) + (memv errno (list ECONNRESET ECONNABORTED ETIMEDOUT + ECONNREFUSED EHOSTUNREACH + ENOENT)))) ;for "file://" + (and (kind-and-args? exception) + (memq (exception-kind exception) + '(gnutls-error getaddrinfo-error))))))) (define* (http-fetch uri #:key port (text? #f) (buffered? #t) (open-connection guix:open-connection-for-uri) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index c2bc16085d..362d9fbe7a 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -577,26 +577,6 @@ (define* (download-nar narinfo destination (values expected (get-hash))))) -(define (system-error? exception) - "Return true if EXCEPTION is a Guile 'system-error exception." - (and (kind-and-args-exception? exception) - (eq? 'system-error (exception-kind exception)))) - -(define network-error? - (let ((kind-and-args? (exception-predicate &exception-with-kind-and-args))) - (lambda (exception) - "Return true if EXCEPTION denotes a networking error." - (or (and (system-error? exception) - (let ((errno (system-error-errno - (cons 'system-error (exception-args exception))))) - (memv errno (list ECONNRESET ECONNABORTED ETIMEDOUT - ECONNREFUSED EHOSTUNREACH - ENOENT)))) ;for "file://" - (and (kind-and-args? exception) - (memq (exception-kind exception) - '(gnutls-error getaddrinfo-error))) - (http-get-error? exception))))) - (define* (process-substitution/fallback narinfo destination #:key cache-urls acl deduplicate? print-build-trace? @@ -623,7 +603,8 @@ (define* (process-substitution/fallback narinfo destination (if (or (equivalent-narinfo? narinfo alternate) (valid-narinfo? alternate acl) (%allow-unauthenticated-substitutes?)) - (guard (c ((network-error? c) + (guard (c ((or (http-get-error? c) + (network-error? c)) (when (http-get-error? c) (warning (G_ "download from '~a' failed: ~a, ~s~%") (uri->string (http-get-error-uri c)) @@ -663,7 +644,8 @@ (define* (process-substitution store-item destination (let ((expected-hash actual-hash (guard - (c ((network-error? c) + (c ((or (http-get-error? c) + (network-error? c)) (when (http-get-error? c) (warning (G_ "download from '~a' failed: ~a, ~s~%") (uri->string (http-get-error-uri c)) From patchwork Sun Apr 21 09:42:37 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63264 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 61B9427BBEC; Sun, 21 Apr 2024 10:45:54 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS 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 06A5027BBE2 for ; Sun, 21 Apr 2024 10:45:54 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTk0-0005aC-3R; Sun, 21 Apr 2024 05:44:08 -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 1ryTjo-0005TB-QH for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:56 -0400 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 1ryTjo-0002qO-Hb; Sun, 21 Apr 2024 05:43:56 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTk1-0006Vw-D3; Sun, 21 Apr 2024 05:44:09 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 19/23] http-client: Include EPIPE in network-error?. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:09 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369263324751 (code B ref 70494); Sun, 21 Apr 2024 09:44:09 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:53 +0000 Received: from localhost ([127.0.0.1]:41787 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjj-0006Qu-Ne for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:53 -0400 Received: from mira.cbaines.net ([2a01:7e00:e000:2f8:fd4d:b5c7:13fb:3d27]:44903) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTj0-0006IX-0I for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:08 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 8E21627BBF9 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:48 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 94531731 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:48 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:37 +0100 Message-ID: <34e716047df34db458e206540fe4217e166dabcc.1713692561.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 The substitute script checks for EPIPE errors, so this allows using network-error?. * guix/http-client.scm (network-error?): Include EPIPE. Change-Id: I96d76d77997ed21a38bf9c41479fea67ab01e084 --- guix/http-client.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/guix/http-client.scm b/guix/http-client.scm index 024705e9ec..a8d7d25762 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -93,7 +93,7 @@ (define network-error? (let ((errno (system-error-errno (cons 'system-error (exception-args exception))))) (memv errno (list ECONNRESET ECONNABORTED ETIMEDOUT - ECONNREFUSED EHOSTUNREACH + ECONNREFUSED EHOSTUNREACH EPIPE ENOENT)))) ;for "file://" (and (kind-and-args? exception) (memq (exception-kind exception) From patchwork Sun Apr 21 09:42:38 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63254 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 9C81627BBEA; Sun, 21 Apr 2024 10:44:54 +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=-1.1 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, PERCENT_RANDOM,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 9E6B227BBE2 for ; Sun, 21 Apr 2024 10:44:52 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTk1-0005g6-Ge; Sun, 21 Apr 2024 05:44:09 -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 1ryTjp-0005TO-4K for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:58 -0400 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 1ryTjo-0002qa-SB; Sun, 21 Apr 2024 05:43:56 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTk3-0006WW-2V; Sun, 21 Apr 2024 05:44:11 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 20/23] scripts: substitute: Simplify with-timeout usage. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:11 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369263824809 (code B ref 70494); Sun, 21 Apr 2024 09:44:11 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:58 +0000 Received: from localhost ([127.0.0.1]:41793 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjn-0006Rb-Di for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:57 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43368) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTj0-0006I0-3T for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:09 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 96DD227BBE2 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:49 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 1be5e245 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:48 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:38 +0100 Message-ID: <603b957f193b30f454d27070d1536aa6a7adaca9.1713692561.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 To reduce the codepaths in download-nar. * guix/scripts/substitute.scm (with-timeout): Accept a #f duration and don't set a timeout. (download-nar): Remove the if for fetch-timeout. Change-Id: I4e944a425a8612e96659dd84dd0e315012f080ab --- guix/scripts/substitute.scm | 93 ++++++++++++++++++------------------- 1 file changed, 45 insertions(+), 48 deletions(-) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 362d9fbe7a..b4bb9d51ff 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -101,34 +101,37 @@ (define %random-state (define-syntax-rule (with-timeout duration handler body ...) "Run BODY; when DURATION seconds have expired, call HANDLER, and run BODY again." - (begin - (sigaction SIGALRM - (lambda (signum) - (sigaction SIGALRM SIG_DFL) - handler)) - (alarm duration) - (call-with-values - (lambda () - (let try () - (catch 'system-error - (lambda () - body ...) - (lambda args - ;; Before Guile v2.0.9-39-gfe51c7b, the SIGALRM triggers EINTR - ;; because of the bug at - ;; . - ;; When that happens, try again. Note: SA_RESTART cannot be - ;; used because of . - (if (= EINTR (system-error-errno args)) - (begin - ;; Wait a little to avoid bursts. - (usleep (random 3000000 %random-state)) - (try)) - (apply throw args)))))) - (lambda result - (alarm 0) - (sigaction SIGALRM SIG_DFL) - (apply values result))))) + (if duration + (begin + (sigaction SIGALRM + (lambda (signum) + (sigaction SIGALRM SIG_DFL) + handler)) + (alarm duration) + (call-with-values + (lambda () + (let try () + (catch 'system-error + (lambda () + body ...) + (lambda args + ;; Before Guile v2.0.9-39-gfe51c7b, the SIGALRM triggers EINTR + ;; because of the bug at + ;; . + ;; When that happens, try again. Note: SA_RESTART cannot be + ;; used because of . + (if (= EINTR (system-error-errno args)) + (begin + ;; Wait a little to avoid bursts. + (usleep (random 3000000 %random-state)) + (try)) + (apply throw args)))))) + (lambda result + (alarm 0) + (sigaction SIGALRM SIG_DFL) + (apply values result)))) + (begin + body ...))) (define (at-most max-length lst) "If LST is shorter than MAX-LENGTH, return it and the empty list; otherwise @@ -475,26 +478,20 @@ (define* (download-nar narinfo destination (let ((port (open-file (uri-path uri) "r0b"))) (values port (stat:size (stat port))))) ((http https) - (if fetch-timeout - ;; Test this with: - ;; sudo tc qdisc add dev eth0 root netem delay 1500ms - ;; and then cancel with: - ;; sudo tc qdisc del dev eth0 root - (with-timeout %fetch-timeout - (begin - (warning (G_ "while fetching ~a: server is somewhat slow~%") - (uri->string uri)) - (warning (G_ "try `--no-substitutes' if the problem persists~%"))) - (with-cached-connection uri port - (http-fetch uri #:text? #f - #:port port - #:keep-alive? #t - #:buffered? #f))) - (with-cached-connection uri port - (http-fetch uri #:text? #f - #:port port - #:keep-alive? #t - #:buffered? #f)))) + ;; Test this with: + ;; sudo tc qdisc add dev eth0 root netem delay 1500ms + ;; and then cancel with: + ;; sudo tc qdisc del dev eth0 root + (with-timeout fetch-timeout + (begin + (warning (G_ "while fetching ~a: server is somewhat slow~%") + (uri->string uri)) + (warning (G_ "try `--no-substitutes' if the problem persists~%"))) + (with-cached-connection uri port + (http-fetch uri #:text? #f + #:port port + #:keep-alive? #t + #:buffered? #f)))) (else (raise (formatted-message From patchwork Sun Apr 21 09:42:39 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63263 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 507F127BBE2; Sun, 21 Apr 2024 10:45:53 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, 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 149DF27BBE9 for ; Sun, 21 Apr 2024 10:45:52 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTk0-0005cq-HF; Sun, 21 Apr 2024 05:44:08 -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 1ryTjp-0005U2-Qv for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:59 -0400 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 1ryTjp-0002qw-Hp; Sun, 21 Apr 2024 05:43:57 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTk3-0006Wi-EY; Sun, 21 Apr 2024 05:44:11 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 21/23] scripts: substitute: Don't enforce cached connections in download-nar. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:11 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369263924828 (code B ref 70494); Sun, 21 Apr 2024 09:44:11 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:43:59 +0000 Received: from localhost ([127.0.0.1]:41795 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjp-0006S6-BM for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:59 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43374) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTj0-0006Id-BX for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:10 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id 9DAC427BBEE for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:49 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 53ec2ce3 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:48 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:39 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 This is in preparation for moving the download-nar procedure out of the script. As well as calling open-connection-for-uri/cached, with-cached-connection adds a single retry to the expression passed in, in the case of a exception that suggests there's a problem with the cached connection. This is important because download-nar/http-fetch doesn't check if a connection used for multiple requests should be closed (because the servers set the relevant response header). To make download-nar more generic, have it take open-connection-for-uri as a keyword argument, and replicate the with-cached-connection single retry by closing the port in the case of a network error, and recalling open-connection-for-uri. This will work fine in the case when connection caching is not in use, as well as when open-connection-for-uri/cached is used, since open-connection-for-uri/cached will open a new connection if the cached port is closed. * guix/scripts/substitute.scm (kind-and-args-exception?): Remove and inline where necessary. (call-with-cached-connection): Remove procedure. (with-cached-connection): Remove syntax rule. (http-response-error?): New procedure. (download-nar): Add new #:open-connection-for-uri keyword argument and use it, also replace with-cached-connection. (process-substitution/fallback,process-substitution): Pass #:open-connection-for-uri open-connection-for-uri/cached to download-nar. Change-Id: I277b1d8dfef79aa1711755b10b9944da7c19157c --- guix/scripts/substitute.scm | 84 +++++++++++++++---------------------- 1 file changed, 33 insertions(+), 51 deletions(-) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index b4bb9d51ff..38975ec366 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -410,55 +410,25 @@ (define open-connection-for-uri/cached (drain-input socket) socket)))))))) -(define kind-and-args-exception? - (exception-predicate &exception-with-kind-and-args)) - -(define (call-with-cached-connection uri proc) - (let ((port (open-connection-for-uri/cached uri - #:verify-certificate? #f))) - (guard (c ((kind-and-args-exception? c) - (let ((key (exception-kind c)) - (args (exception-args c))) - ;; If PORT was cached and the server closed the connection in the - ;; meantime, we get EPIPE. In that case, open a fresh connection - ;; and retry. We might also get 'bad-response or a similar - ;; exception from (web response) later on, once we've sent the - ;; request, or a ERROR/INVALID-SESSION from GnuTLS. - (if (or (and (eq? key 'system-error) - (= EPIPE (system-error-errno `(,key ,@args)))) - (and (eq? key 'gnutls-error) - (memq (first args) - (list error/invalid-session - - ;; XXX: These two are not properly handled in - ;; GnuTLS < 3.7.3, in - ;; 'write_to_session_record_port'; see - ;; . - error/again error/interrupted))) - (memq key '(bad-response bad-header bad-header-component))) - (proc (open-connection-for-uri/cached uri - #:verify-certificate? #f - #:fresh? #t)) - (raise c)))) - (#t - ;; An exception that's not handled here, such as - ;; '&http-get-error'. Re-raise it. - (raise c))) - (proc port)))) - -(define-syntax-rule (with-cached-connection uri port exp ...) - "Bind PORT with EXP... to a socket connected to URI." - (call-with-cached-connection uri (lambda (port) exp ...))) - (define-syntax-rule (catch-system-error exp) (catch 'system-error (lambda () exp) (const #f))) +(define http-response-error? + (let ((kind-and-args-exception? + (exception-predicate &exception-with-kind-and-args))) + (lambda (exception) + "Return true if EXCEPTION denotes an error with the http response" + (->bool + (memq (exception-kind exception) + '(bad-response bad-header bad-header-component)))))) + (define* (download-nar narinfo destination #:key deduplicate? print-build-trace? (fetch-timeout %fetch-timeout) - prefer-fast-decompression?) + prefer-fast-decompression? + (open-connection-for-uri guix:open-connection-for-uri)) "Download the nar prescribed in NARINFO, which is assumed to be authentic and authorized, and write it to DESTINATION. When DEDUPLICATE? is true, and if DESTINATION is in the store, deduplicate its files." @@ -487,11 +457,22 @@ (define* (download-nar narinfo destination (warning (G_ "while fetching ~a: server is somewhat slow~%") (uri->string uri)) (warning (G_ "try `--no-substitutes' if the problem persists~%"))) - (with-cached-connection uri port - (http-fetch uri #:text? #f - #:port port - #:keep-alive? #t - #:buffered? #f)))) + (let loop ((port (open-connection-for-uri uri)) + (attempt 0)) + (guard (c ((or (network-error? c) + (http-response-error? c)) + (close-port port) + + ;; Perform a single retry in the case of an error, + ;; mostly to mimic the behaviour of + ;; with-cached-connection + (if (= attempt 0) + (loop (open-connection-for-uri uri) 1) + (raise c)))) + (http-fetch uri #:text? #f + #:port port + #:keep-alive? #t + #:buffered? #f))))) (else (raise (formatted-message @@ -612,7 +593,9 @@ (define* (process-substitution/fallback narinfo destination #:deduplicate? deduplicate? #:print-build-trace? print-build-trace? #:prefer-fast-decompression? - prefer-fast-decompression?)) + prefer-fast-decompression? + #:open-connection-for-uri + open-connection-for-uri/cached)) (loop rest))) (() (loop rest))))))) @@ -663,7 +646,9 @@ (define* (process-substitution store-item destination (download-nar narinfo destination #:deduplicate? deduplicate? #:print-build-trace? print-build-trace? - #:prefer-fast-decompression? prefer-fast-decompression?)))) + #:prefer-fast-decompression? prefer-fast-decompression? + #:open-connection-for-uri + open-connection-for-uri/cached)))) (values narinfo expected-hash actual-hash))) @@ -930,10 +915,7 @@ (define-command (guix-substitute . args) (leave (G_ "~a: unrecognized options~%") opts)))))) ;;; Local Variables: -;;; eval: (put 'with-timeout 'scheme-indent-function 1) ;;; eval: (put 'with-redirected-error-port 'scheme-indent-function 0) -;;; eval: (put 'with-cached-connection 'scheme-indent-function 2) -;;; eval: (put 'call-with-cached-connection 'scheme-indent-function 1) ;;; End: ;;; substitute.scm ends here From patchwork Sun Apr 21 09:42:40 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63261 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 19D9327BBEC; Sun, 21 Apr 2024 10:45:48 +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=-1.1 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, PERCENT_RANDOM,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 1252027BBE9 for ; Sun, 21 Apr 2024 10:45:46 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTk7-0005pG-6e; Sun, 21 Apr 2024 05:44: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 1ryTjr-0005Ut-DI for guix-patches@gnu.org; Sun, 21 Apr 2024 05:44:01 -0400 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 1ryTjq-0002rG-Qy; Sun, 21 Apr 2024 05:43:59 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTk4-0006X6-9i; Sun, 21 Apr 2024 05:44:12 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 22/23] substitutes: Move download-nar from substitutes script to here. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:12 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369264224858 (code B ref 70494); Sun, 21 Apr 2024 09:44:12 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:44:02 +0000 Received: from localhost ([127.0.0.1]:41799 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjr-0006SW-S2 for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:44:01 -0400 Received: from mira.cbaines.net ([2a01:7e00:e000:2f8:fd4d:b5c7:13fb:3d27]:45147) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTj0-0006I6-Ns for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:11 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id A40DA27BBF1 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:49 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 71f6af89 for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:48 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:40 +0100 Message-ID: <9e753d3907a36f741fecd379c6918f5e692d542d.1713692561.git.mail@cbaines.net> X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 From the substitutes script. This makes it possible to use download-nar in the the Guile guix-daemon. * guix/scripts/substitute.scm (%fetch-timeout): Move down to where it's now used. (%random-state, with-timeout, catch-system-error, http-response-error?, download-nar): Move to… * guix/substitutes.scm: …here. Change-Id: I8c09bf4b33cb5c6d042057d4d9adeb36c24c11dc --- guix/scripts/substitute.scm | 195 +--------------------------------- guix/substitutes.scm | 206 +++++++++++++++++++++++++++++++++++- 2 files changed, 207 insertions(+), 194 deletions(-) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 38975ec366..c74da618b5 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -31,7 +31,6 @@ (define-module (guix scripts substitute) #:use-module (guix diagnostics) #:use-module (guix i18n) #:use-module ((guix serialization) #:select (restore-file dump-file)) - #:autoload (guix store deduplication) (dump-file/deduplicate) #:autoload (guix scripts discover) (read-substitute-urls) #:use-module (gcrypt hash) #:use-module (guix base32) @@ -40,10 +39,9 @@ (define-module (guix scripts substitute) #:use-module (guix pki) #:autoload (guix build utils) (mkdir-p delete-file-recursively) #:use-module ((guix build download) - #:select (uri-abbreviation nar-uri-abbreviation + #:select (uri-abbreviation (open-connection-for-uri . guix:open-connection-for-uri))) - #:autoload (gnutls) (error/invalid-session error/again error/interrupted) #:use-module (guix progress) #:use-module ((guix build syscalls) #:select (set-thread-name)) @@ -91,48 +89,6 @@ (define %allow-unauthenticated-substitutes? (and=> (getenv "GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES") (cut string-ci=? <> "yes")))) -(define %fetch-timeout - ;; Number of seconds after which networking is considered "slow". - 5) - -(define %random-state - (seed->random-state (+ (ash (cdr (gettimeofday)) 32) (getpid)))) - -(define-syntax-rule (with-timeout duration handler body ...) - "Run BODY; when DURATION seconds have expired, call HANDLER, and run BODY -again." - (if duration - (begin - (sigaction SIGALRM - (lambda (signum) - (sigaction SIGALRM SIG_DFL) - handler)) - (alarm duration) - (call-with-values - (lambda () - (let try () - (catch 'system-error - (lambda () - body ...) - (lambda args - ;; Before Guile v2.0.9-39-gfe51c7b, the SIGALRM triggers EINTR - ;; because of the bug at - ;; . - ;; When that happens, try again. Note: SA_RESTART cannot be - ;; used because of . - (if (= EINTR (system-error-errno args)) - (begin - ;; Wait a little to avoid bursts. - (usleep (random 3000000 %random-state)) - (try)) - (apply throw args)))))) - (lambda result - (alarm 0) - (sigaction SIGALRM SIG_DFL) - (apply values result)))) - (begin - body ...))) - (define (at-most max-length lst) "If LST is shorter than MAX-LENGTH, return it and the empty list; otherwise return its MAX-LENGTH first elements and its tail." @@ -365,6 +321,10 @@ (define %max-cached-connections ;; 'open-connection-for-uri/cached'. 16) +(define %fetch-timeout + ;; Number of seconds after which networking is considered "slow". + 5) + (define open-connection-for-uri/cached (let ((cache '())) (lambda* (uri #:key fresh? (timeout %fetch-timeout) verify-certificate?) @@ -410,151 +370,6 @@ (define open-connection-for-uri/cached (drain-input socket) socket)))))))) -(define-syntax-rule (catch-system-error exp) - (catch 'system-error - (lambda () exp) - (const #f))) - -(define http-response-error? - (let ((kind-and-args-exception? - (exception-predicate &exception-with-kind-and-args))) - (lambda (exception) - "Return true if EXCEPTION denotes an error with the http response" - (->bool - (memq (exception-kind exception) - '(bad-response bad-header bad-header-component)))))) - -(define* (download-nar narinfo destination - #:key deduplicate? print-build-trace? - (fetch-timeout %fetch-timeout) - prefer-fast-decompression? - (open-connection-for-uri guix:open-connection-for-uri)) - "Download the nar prescribed in NARINFO, which is assumed to be authentic -and authorized, and write it to DESTINATION. When DEDUPLICATE? is true, and -if DESTINATION is in the store, deduplicate its files." - (define destination-in-store? - (string-prefix? (string-append (%store-prefix) "/") - destination)) - - (define (dump-file/deduplicate* . args) - ;; Make sure deduplication looks at the right store (necessary in test - ;; environments). - (apply dump-file/deduplicate - (append args (list #:store (%store-prefix))))) - - (define (fetch uri) - (case (uri-scheme uri) - ((file) - (let ((port (open-file (uri-path uri) "r0b"))) - (values port (stat:size (stat port))))) - ((http https) - ;; Test this with: - ;; sudo tc qdisc add dev eth0 root netem delay 1500ms - ;; and then cancel with: - ;; sudo tc qdisc del dev eth0 root - (with-timeout fetch-timeout - (begin - (warning (G_ "while fetching ~a: server is somewhat slow~%") - (uri->string uri)) - (warning (G_ "try `--no-substitutes' if the problem persists~%"))) - (let loop ((port (open-connection-for-uri uri)) - (attempt 0)) - (guard (c ((or (network-error? c) - (http-response-error? c)) - (close-port port) - - ;; Perform a single retry in the case of an error, - ;; mostly to mimic the behaviour of - ;; with-cached-connection - (if (= attempt 0) - (loop (open-connection-for-uri uri) 1) - (raise c)))) - (http-fetch uri #:text? #f - #:port port - #:keep-alive? #t - #:buffered? #f))))) - (else - (raise - (formatted-message - (G_ "unsupported substitute URI scheme: ~a~%") - (uri->string uri)))))) - - (define (try-fetch choices) - (match choices - (((uri compression file-size) rest ...) - (guard (c ((and (pair? rest) - (or (http-get-error? c) - (network-error? c))) - (warning (G_ "download from '~a' failed, trying next URL~%") - (uri->string uri)) - (try-fetch rest))) - (let ((port download-size (fetch uri))) - (unless print-build-trace? - (format (current-error-port) - (G_ "Downloading ~a...~%") (uri->string uri))) - (values port uri compression download-size)))) - (() - (raise - (formatted-message - (G_ "no valid nar URLs for ~a at ~a~%") - (narinfo-path narinfo) - (narinfo-uri-base narinfo)))))) - - ;; Delete DESTINATION first--necessary when starting over after a failed - ;; download. - (catch-system-error (delete-file-recursively destination)) - - (let ((choices (narinfo-preferred-uris narinfo - #:fast-decompression? - prefer-fast-decompression?))) - ;; 'guix publish' without '--cache' doesn't specify a Content-Length, so - ;; DOWNLOAD-SIZE is #f in this case. - (let* ((raw uri compression download-size (try-fetch choices)) - (progress - (let* ((dl-size (or download-size - (and (equal? compression "none") - (narinfo-size narinfo)))) - (reporter (if print-build-trace? - (progress-reporter/trace - destination - (uri->string uri) dl-size - (current-error-port)) - (progress-reporter/file - (uri->string uri) dl-size - (current-error-port) - #:abbreviation nar-uri-abbreviation)))) - ;; Keep RAW open upon completion so we can later reuse - ;; the underlying connection. Pass the download size so - ;; that this procedure won't block reading from RAW. - (progress-report-port reporter raw - #:close? #f - #:download-size dl-size))) - (input pids - ;; NOTE: This 'progress' port of current process will be - ;; closed here, while the child process doing the - ;; reporting will close it upon exit. - (decompressed-port (string->symbol compression) - progress)) - - ;; Compute the actual nar hash as we read it. - (algorithm expected (narinfo-hash-algorithm+value narinfo)) - (hashed get-hash (open-hash-input-port algorithm input))) - - ;; Unpack the Nar at INPUT into DESTINATION. - (restore-file hashed destination - #:dump-file (if (and destination-in-store? - deduplicate?) - dump-file/deduplicate* - dump-file)) - (close-port hashed) - (close-port input) - - ;; Wait for the reporter to finish. - (every (compose zero? cdr waitpid) pids) - - (values expected - (get-hash))))) - (define* (process-substitution/fallback narinfo destination #:key cache-urls acl deduplicate? print-build-trace? diff --git a/guix/substitutes.scm b/guix/substitutes.scm index e732096933..5089f3a6da 100644 --- a/guix/substitutes.scm +++ b/guix/substitutes.scm @@ -30,12 +30,18 @@ (define-module (guix substitutes) #:use-module (gcrypt hash) #:use-module (guix base32) #:use-module (guix cache) - #:use-module ((guix build utils) #:select (mkdir-p dump-port)) + #:use-module ((guix build utils) + #:select (mkdir-p dump-port delete-file-recursively)) #:use-module ((guix build download) #:select ((open-connection-for-uri . guix:open-connection-for-uri) - resolve-uri-reference)) - #:autoload (gnutls) (error->string error/premature-termination) + resolve-uri-reference + nar-uri-abbreviation)) + #:use-module ((guix serialization) #:select (restore-file dump-file)) + #:autoload (gnutls) (error->string error/premature-termination + error/invalid-session error/again + error/interrupted) + #:autoload (guix store deduplication) (dump-file/deduplicate) #:use-module (guix progress) #:use-module (ice-9 match) #:use-module (ice-9 format) @@ -46,6 +52,8 @@ (define-module (guix substitutes) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-71) #:use-module (web uri) #:use-module (web request) #:use-module (web response) @@ -55,7 +63,10 @@ (define-module (guix substitutes) call-with-connection-error-handling lookup-narinfos - lookup-narinfos/diverse)) + lookup-narinfos/diverse + + http-response-error? + download-nar)) (define %narinfo-ttl ;; Number of seconds during which cached narinfo lookups are considered @@ -391,4 +402,191 @@ (define* (lookup-narinfos/diverse caches paths authorized? (() ;that's it (filter-map (select-hit result) hits))))))) +(define %random-state + (seed->random-state (+ (ash (cdr (gettimeofday)) 32) (getpid)))) + +(define-syntax-rule (with-timeout duration handler body ...) + "Run BODY; when DURATION seconds have expired, call HANDLER, and run BODY +again." + (if duration + (begin + (sigaction SIGALRM + (lambda (signum) + (sigaction SIGALRM SIG_DFL) + handler)) + (alarm duration) + (call-with-values + (lambda () + (let try () + (catch 'system-error + (lambda () + body ...) + (lambda args + ;; Before Guile v2.0.9-39-gfe51c7b, the SIGALRM triggers EINTR + ;; because of the bug at + ;; . + ;; When that happens, try again. Note: SA_RESTART cannot be + ;; used because of . + (if (= EINTR (system-error-errno args)) + (begin + ;; Wait a little to avoid bursts. + (usleep (random 3000000 %random-state)) + (try)) + (apply throw args)))))) + (lambda result + (alarm 0) + (sigaction SIGALRM SIG_DFL) + (apply values result)))) + (begin + body ...))) + +(define-syntax-rule (catch-system-error exp) + (catch 'system-error + (lambda () exp) + (const #f))) + +(define http-response-error? + (let ((kind-and-args-exception? + (exception-predicate &exception-with-kind-and-args))) + (lambda (exception) + "Return true if EXCEPTION denotes an error with the http response" + (->bool + (memq (exception-kind exception) + '(bad-response bad-header bad-header-component)))))) + +(define %fetch-timeout + ;; Number of seconds after which networking is considered "slow". + 5) + +(define* (download-nar narinfo destination + #:key deduplicate? print-build-trace? + (fetch-timeout %fetch-timeout) + prefer-fast-decompression? + (open-connection-for-uri guix:open-connection-for-uri)) + "Download the nar prescribed in NARINFO, which is assumed to be authentic +and authorized, and write it to DESTINATION. When DEDUPLICATE? is true, and +if DESTINATION is in the store, deduplicate its files." + (define destination-in-store? + (string-prefix? (string-append (%store-prefix) "/") + destination)) + + (define (dump-file/deduplicate* . args) + ;; Make sure deduplication looks at the right store (necessary in test + ;; environments). + (apply dump-file/deduplicate + (append args (list #:store (%store-prefix))))) + + (define (fetch uri) + (case (uri-scheme uri) + ((file) + (let ((port (open-file (uri-path uri) "r0b"))) + (values port (stat:size (stat port))))) + ((http https) + ;; Test this with: + ;; sudo tc qdisc add dev eth0 root netem delay 1500ms + ;; and then cancel with: + ;; sudo tc qdisc del dev eth0 root + (with-timeout fetch-timeout + (begin + (warning (G_ "while fetching ~a: server is somewhat slow~%") + (uri->string uri)) + (warning (G_ "try `--no-substitutes' if the problem persists~%"))) + (let loop ((port (open-connection-for-uri uri)) + (attempt 0)) + (guard (c ((or (network-error? c) + (http-response-error? c)) + (close-port port) + + ;; Perform a single retry in the case of an error, + ;; mostly to mimic the behaviour of + ;; with-cached-connection + (if (= attempt 0) + (loop (open-connection-for-uri uri) 1) + (raise c)))) + (http-fetch uri #:text? #f + #:port port + #:keep-alive? #t + #:buffered? #f))))) + (else + (raise + (formatted-message + (G_ "unsupported substitute URI scheme: ~a~%") + (uri->string uri)))))) + + (define (try-fetch choices) + (match choices + (((uri compression file-size) rest ...) + (guard (c ((and (pair? rest) + (or (http-get-error? c) + (network-error? c))) + (warning (G_ "download from '~a' failed, trying next URL~%") + (uri->string uri)) + (try-fetch rest))) + (let ((port download-size (fetch uri))) + (unless print-build-trace? + (format (current-error-port) + (G_ "Downloading ~a...~%") (uri->string uri))) + (values port uri compression download-size)))) + (() + (raise + (formatted-message + (G_ "no valid nar URLs for ~a at ~a~%") + (narinfo-path narinfo) + (narinfo-uri-base narinfo)))))) + + ;; Delete DESTINATION first--necessary when starting over after a failed + ;; download. + (catch-system-error (delete-file-recursively destination)) + + (let ((choices (narinfo-preferred-uris narinfo + #:fast-decompression? + prefer-fast-decompression?))) + ;; 'guix publish' without '--cache' doesn't specify a Content-Length, so + ;; DOWNLOAD-SIZE is #f in this case. + (let* ((raw uri compression download-size (try-fetch choices)) + (progress + (let* ((dl-size (or download-size + (and (equal? compression "none") + (narinfo-size narinfo)))) + (reporter (if print-build-trace? + (progress-reporter/trace + destination + (uri->string uri) dl-size + (current-error-port)) + (progress-reporter/file + (uri->string uri) dl-size + (current-error-port) + #:abbreviation nar-uri-abbreviation)))) + ;; Keep RAW open upon completion so we can later reuse + ;; the underlying connection. Pass the download size so + ;; that this procedure won't block reading from RAW. + (progress-report-port reporter raw + #:close? #f + #:download-size dl-size))) + (input pids + ;; NOTE: This 'progress' port of current process will be + ;; closed here, while the child process doing the + ;; reporting will close it upon exit. + (decompressed-port (string->symbol compression) + progress)) + + ;; Compute the actual nar hash as we read it. + (algorithm expected (narinfo-hash-algorithm+value narinfo)) + (hashed get-hash (open-hash-input-port algorithm input))) + + ;; Unpack the Nar at INPUT into DESTINATION. + (restore-file hashed destination + #:dump-file (if (and destination-in-store? + deduplicate?) + dump-file/deduplicate* + dump-file)) + (close-port hashed) + (close-port input) + + ;; Wait for the reporter to finish. + (every (compose zero? cdr waitpid) pids) + + (values expected + (get-hash))))) + ;;; substitutes.scm ends here From patchwork Sun Apr 21 09:42:41 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 63262 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 1698B27BBE2; Sun, 21 Apr 2024 10:45:49 +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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, SPF_HELO_PASS 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 C35F227BBEB for ; Sun, 21 Apr 2024 10:45:47 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ryTk0-0005ch-DA; Sun, 21 Apr 2024 05:44:08 -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 1ryTjp-0005U0-Kq for guix-patches@gnu.org; Sun, 21 Apr 2024 05:43:58 -0400 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 1ryTjp-0002qn-CG; Sun, 21 Apr 2024 05:43:57 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ryTk3-0006Wu-RC; Sun, 21 Apr 2024 05:44:11 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#70494] [PATCH 23/23] substitutes: Add #:keep-alive? keyword argument to download-nar. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sun, 21 Apr 2024 09:44:11 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70494 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 70494@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 70494-submit@debbugs.gnu.org id=B70494.171369264024835 (code B ref 70494); Sun, 21 Apr 2024 09:44:11 +0000 Received: (at 70494) by debbugs.gnu.org; 21 Apr 2024 09:44:00 +0000 Received: from localhost ([127.0.0.1]:41797 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTjr-0006SP-Ea for submit@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:59 -0400 Received: from mira.cbaines.net ([212.71.252.8]:43376) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ryTj1-0006Ij-0W for 70494@debbugs.gnu.org; Sun, 21 Apr 2024 05:43:11 -0400 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id AA62227BBFA for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 10:42:49 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id f81251cd for <70494@debbugs.gnu.org>; Sun, 21 Apr 2024 09:42:49 +0000 (UTC) From: Christopher Baines Date: Sun, 21 Apr 2024 10:42:41 +0100 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <87bk632h36.fsf@cbaines.net> References: <87bk632h36.fsf@cbaines.net> 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 To be consistent with other procedures that make network requests. * guix/substitutes.scm (download-nar): Add #:keep-alive? option. * guix/scripts/substitute.scm (process-substitution/fallback, process-substitution): Call download-nar with #:keep-alive? #t. Change-Id: I83b27d0c3a0916d058fbbbeb7aa77dbb8a742768 --- guix/scripts/substitute.scm | 6 ++++-- guix/substitutes.scm | 11 +++++++++-- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index c74da618b5..68c24820c6 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -410,7 +410,8 @@ (define* (process-substitution/fallback narinfo destination #:prefer-fast-decompression? prefer-fast-decompression? #:open-connection-for-uri - open-connection-for-uri/cached)) + open-connection-for-uri/cached + #:keep-alive? #t)) (loop rest))) (() (loop rest))))))) @@ -463,7 +464,8 @@ (define* (process-substitution store-item destination #:print-build-trace? print-build-trace? #:prefer-fast-decompression? prefer-fast-decompression? #:open-connection-for-uri - open-connection-for-uri/cached)))) + open-connection-for-uri/cached + #:keep-alive? #t)))) (values narinfo expected-hash actual-hash))) diff --git a/guix/substitutes.scm b/guix/substitutes.scm index 5089f3a6da..7c8f8cc973 100644 --- a/guix/substitutes.scm +++ b/guix/substitutes.scm @@ -462,7 +462,8 @@ (define* (download-nar narinfo destination #:key deduplicate? print-build-trace? (fetch-timeout %fetch-timeout) prefer-fast-decompression? - (open-connection-for-uri guix:open-connection-for-uri)) + (open-connection-for-uri guix:open-connection-for-uri) + (keep-alive? #f)) "Download the nar prescribed in NARINFO, which is assumed to be authentic and authorized, and write it to DESTINATION. When DEDUPLICATE? is true, and if DESTINATION is in the store, deduplicate its files." @@ -505,7 +506,7 @@ (define* (download-nar narinfo destination (raise c)))) (http-fetch uri #:text? #f #:port port - #:keep-alive? #t + #:keep-alive? keep-alive? #:buffered? #f))))) (else (raise @@ -586,6 +587,12 @@ (define* (download-nar narinfo destination ;; Wait for the reporter to finish. (every (compose zero? cdr waitpid) pids) + ;; TODO The port should also be closed if the relevant HTTP response + ;; header is set, but http-fetch doesn't currently share that + ;; information + (unless keep-alive? + (close-port raw)) + (values expected (get-hash)))))