From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id UZVdG92z3l45aAAA0tVLHw (envelope-from ) for ; Mon, 08 Jun 2020 21:55:41 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2 with LMTPS id QNAUF92z3l5pKAAAB5/wlQ (envelope-from ) for ; Mon, 08 Jun 2020 21:55:41 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 03A559403E9 for ; Mon, 8 Jun 2020 21:55:41 +0000 (UTC) Received: from localhost ([::1]:45430 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jiPk3-0004un-Ro for larch@yhetil.org; Mon, 08 Jun 2020 17:55:39 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:50352) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jiPjV-0004YN-04 for bug-guix@gnu.org; Mon, 08 Jun 2020 17:55:05 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:46567) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jiPjU-0008CT-L5 for bug-guix@gnu.org; Mon, 08 Jun 2020 17:55:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jiPjU-0006Wt-JX; Mon, 08 Jun 2020 17:55:04 -0400 X-Loop: help-debbugs@gnu.org Subject: bug#22883: [PATCH 5/9] channels: Make 'validate-pull' call right after clone/pull. Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: bug-guix@gnu.org Resent-Date: Mon, 08 Jun 2020 21:55:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 22883 X-GNU-PR-Package: guix X-GNU-PR-Keywords: security To: 22883@debbugs.gnu.org Received: via spool by 22883-submit@debbugs.gnu.org id=B22883.159165329524999 (code B ref 22883); Mon, 08 Jun 2020 21:55:04 +0000 Received: (at 22883) by debbugs.gnu.org; 8 Jun 2020 21:54:55 +0000 Received: from localhost ([127.0.0.1]:58096 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jiPjL-0006V3-7R for submit@debbugs.gnu.org; Mon, 08 Jun 2020 17:54:55 -0400 Received: from eggs.gnu.org ([209.51.188.92]:42186) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jiPjI-0006Tl-E9 for 22883@debbugs.gnu.org; Mon, 08 Jun 2020 17:54:52 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:57660) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jiPjD-00082x-4f; Mon, 08 Jun 2020 17:54:47 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=56818 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jiPjC-0007OP-4K; Mon, 08 Jun 2020 17:54:46 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Mon, 8 Jun 2020 23:54:11 +0200 Message-Id: <20200608215415.2871-5-ludo@gnu.org> X-Mailer: git-send-email 2.26.2 In-Reply-To: <20200608215415.2871-1-ludo@gnu.org> References: <20200608215415.2871-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -3.3 (---) X-BeenThere: bug-guix@gnu.org List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+larch=yhetil.org@gnu.org Sender: "bug-Guix" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of bug-guix-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=bug-guix-bounces@gnu.org X-Spam-Score: 3.99 X-TUID: jWqreQJzFhBJ This should come before patching, authentication, etc. * guix/channels.scm (latest-channel-instance): Add #:validate-pull parameter and honor it. Return a single value: the instance. (ensure-forward-channel-update): Change 'instance' parameter to 'commit' and adjust accordingly. (latest-channel-instances): Adjust to 'latest-channel-instance' changes. * guix/scripts/pull.scm (warn-about-backward-updates): Change 'instance' parameter to 'commit' and adjust accordingly. * tests/channels.scm ("latest-channel-instances #:validate-pull"): Likewise. --- guix/channels.scm | 37 ++++++++++++++++++++----------------- guix/scripts/pull.scm | 10 ++++------ tests/channels.scm | 4 ++-- 3 files changed, 26 insertions(+), 25 deletions(-) diff --git a/guix/channels.scm b/guix/channels.scm index c2ea0e26ff..6047b51010 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -376,9 +376,12 @@ commits ~a to ~a (~h new commits)...~%") (define* (latest-channel-instance store channel #:key (patches %patches) - starting-commit) - "Return two values: the latest channel instance for CHANNEL, and its -relation to STARTING-COMMIT when provided." + starting-commit + (validate-pull + ensure-forward-channel-update)) + "Return the latest channel instance for CHANNEL. When STARTING-COMMIT is +true, call VALIDATE-PULL with CHANNEL, STARTING-COMMIT, the target commit, and +their relation." (define (dot-git? file stat) (and (string=? (basename file) ".git") (eq? 'directory (stat:type stat)))) @@ -387,6 +390,9 @@ relation to STARTING-COMMIT when provided." (update-cached-checkout (channel-url channel) #:ref (channel-reference channel) #:starting-commit starting-commit))) + (when relation + (validate-pull channel starting-commit commit relation)) + (if (channel-introduction channel) (authenticate-channel channel checkout commit) ;; TODO: Warn for all the channels once the authentication interface @@ -403,12 +409,11 @@ relation to STARTING-COMMIT when provided." (let* ((name (url+commit->name (channel-url channel) commit)) (checkout (add-to-store store name #t "sha256" checkout #:select? (negate dot-git?)))) - (values (channel-instance channel commit checkout) - relation)))) + (channel-instance channel commit checkout)))) -(define (ensure-forward-channel-update channel start instance relation) +(define (ensure-forward-channel-update channel start commit relation) "Raise an error if RELATION is not 'ancestor, meaning that START is not an -ancestor of the commit in INSTANCE, unless CHANNEL specifies a commit. +ancestor of COMMIT, unless CHANNEL specifies a commit. This procedure implements a channel update policy meant to be used as a #:validate-pull argument." @@ -422,8 +427,7 @@ This procedure implements a channel update policy meant to be used as a (format #f (G_ "\ aborting update of channel '~a' to commit ~a, which is not a descendant of ~a") (channel-name channel) - (channel-instance-commit instance) - start)))) + commit start)))) ;; If the user asked for a specific commit, they might want ;; that to happen nevertheless, so tell them about the @@ -482,14 +486,13 @@ depending on the policy it implements." (G_ "Updating channel '~a' from Git repository at '~a'...~%") (channel-name channel) (channel-url channel)) - (let*-values (((current) - (current-commit (channel-name channel))) - ((instance relation) - (latest-channel-instance store channel - #:starting-commit - current))) - (when relation - (validate-pull channel current instance relation)) + (let* ((current (current-commit (channel-name channel))) + (instance + (latest-channel-instance store channel + #:validate-pull + validate-pull + #:starting-commit + current))) (let-values (((new-instances new-channels) (loop (channel-instance-dependencies instance) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index c386d81b8e..d3d0d2bd64 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -195,20 +195,18 @@ Download and deploy the latest version of Guix.\n")) %standard-build-options)) -(define (warn-about-backward-updates channel start instance relation) - "Warn about non-forward updates of CHANNEL from START to INSTANCE, without +(define (warn-about-backward-updates channel start commit relation) + "Warn about non-forward updates of CHANNEL from START to COMMIT, without aborting." (match relation ((or 'ancestor 'self) #t) ('descendant (warning (G_ "rolling back channel '~a' from ~a to ~a~%") - (channel-name channel) start - (channel-instance-commit instance))) + (channel-name channel) start commit)) ('unrelated (warning (G_ "moving channel '~a' from ~a to unrelated commit ~a~%") - (channel-name channel) start - (channel-instance-commit instance))))) + (channel-name channel) start commit)))) (define* (display-profile-news profile #:key concise? current-is-newer?) diff --git a/tests/channels.scm b/tests/channels.scm index 2c857083e9..5f13a48ec1 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -212,12 +212,12 @@ (commit (oid->string (commit-id commit2))))) (old (channel (inherit spec) (commit (oid->string (commit-id commit1)))))) - (define (validate-pull channel current instance relation) + (define (validate-pull channel current commit relation) (return (and (eq? channel old) (string=? (oid->string (commit-id commit2)) current) (string=? (oid->string (commit-id commit1)) - (channel-instance-commit instance)) + commit) relation))) (with-store store -- 2.26.2