From patchwork Sat Feb 1 11:43:24 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: 45mg <45mg.writes@gmail.com> X-Patchwork-Id: 38141 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 36B3B27BBE9; Sat, 1 Feb 2025 11:46:39 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.6 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_SIGNED,DKIM_VALID,FREEMAIL_FROM,MAILING_LIST_MULTI, RCVD_IN_DNSWL_BLOCKED,RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL, RCVD_IN_VALIDITY_SAFE,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id CD00F27BBE2 for ; Sat, 1 Feb 2025 11:46:36 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1teBwv-0007M1-S6; Sat, 01 Feb 2025 06:46:09 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1teBwt-0007Lc-Pp for guix-patches@gnu.org; Sat, 01 Feb 2025 06:46:07 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1teBwt-0005eH-G6; Sat, 01 Feb 2025 06:46:07 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=rASlCkCXzp5SO8O1bmNfoaP77uE1mhNlivO/wDiYLuQ=; b=BEIM1ecWOPFT+8MWeXeR1SSLumWRH7WewjPSsby+VOmu4j9qBSCx/k8KjXi2nH9WWTImcDYClkLK9CFQq53hCooPMLUT7N6UaokiVAFKY/1QD6udDZdbjem7BU6XaVqGpNXK2zpwezmzk4uy+gsAaUaiyw2dyDx+R5egO3brKM1lty4BKHvYn/7SBerE+pk6lP06aF6TX751VFZeRPTiX8rgZJ63HI4KClLi0iZG7wUGHPzjtrt1LO5Tt92/ZLOO+0KrSBGG17kXiV6I8ys3U2x/wlnWc+praj/7nGZz5MXH0KZcLhuze3D/ZUOj8WtLK4i4qdxukJv0oXYRyq2jVQ==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1teBwp-00056u-0A; Sat, 01 Feb 2025 06:46:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#75981] [PATCH (WIP) v1.5 2/4] Add 'guix fork authenticate'. Resent-From: 45mg <45mg.writes@gmail.com> Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sat, 01 Feb 2025 11:46:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 75981 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 75981@debbugs.gnu.org Cc: Nicolas Graves , Tomas Volf <~@wolfsden.cz>, 45mg <45mg.writes@gmail.com>, Liliana Marie Prikler , Ricardo Wurmus , Attila Lendvai , Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 75981-submit@debbugs.gnu.org id=B75981.173841032119556 (code B ref 75981); Sat, 01 Feb 2025 11:46:02 +0000 Received: (at 75981) by debbugs.gnu.org; 1 Feb 2025 11:45:21 +0000 Received: from localhost ([127.0.0.1]:56715 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1teBw8-00055J-R4 for submit@debbugs.gnu.org; Sat, 01 Feb 2025 06:45:21 -0500 Received: from mail-pl1-x643.google.com ([2607:f8b0:4864:20::643]:44152) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.84_2) (envelope-from <45mg.writes@gmail.com>) id 1teBw5-0004zT-Lk for 75981@debbugs.gnu.org; Sat, 01 Feb 2025 06:45:18 -0500 Received: by mail-pl1-x643.google.com with SMTP id d9443c01a7336-2163dc5155fso51735555ad.0 for <75981@debbugs.gnu.org>; Sat, 01 Feb 2025 03:45:17 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1738410311; x=1739015111; darn=debbugs.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=rASlCkCXzp5SO8O1bmNfoaP77uE1mhNlivO/wDiYLuQ=; b=OpXS9t5uqGAXcd6qM4ibbJPp+WQEumoRnshZJFV6ueOI6UIC+OVId9LhhheSd4ZNwm yLhVXLZEWA77lQutke0LcGHdWmVppbR2CE2F65kGXlYA+2fVhvknAKJsaH6cOXZN+5d/ KICk7JX3+u4J4bPnVBJ5eZBSwE2e+hj7eywtFA1TCSTrYIQGYpaUJg0FrchL/OO2Ew3k wONBRRjI2AsSLqGAn1Lce3//F7uIzpDpdl8ZP5mzZHbV6GBBeyjxsb35ePqP7ld9b9yO bJCiYhJg/BSMOfUqgYZ5zsM+gD4n9IhJhH1GPswg4HEmjULXOGYsCITqcwfeYzcBQX1V a+FQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1738410311; x=1739015111; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=rASlCkCXzp5SO8O1bmNfoaP77uE1mhNlivO/wDiYLuQ=; b=gYqUr8oQAosa4tgYOVcU8TK2NM/JRMGdmDIV5/VdCAr1756pBilSeE0qEui+JBSRuL U6tKw3qnfgWMcygLqklKWmf3+fGHF5wZG6UbI0zd5JmxbTI/beZxdZ3UHHKi39kmkGRU hRia9sS1kMoK1fgnC6nqvkznK0pQor1BbepXSIXhzGnpciOGdAPrd1ygYcKGGZQqWjM7 gkMthX5eFIU60BK6zQKPC17spKi/pYSFnz/7NYxGoD18oemKCHgf78ZyAaNHFZECptek Ihc+ukUEA2n1hLluebeRFr0wxbq7j8UG2aDi4pYA6k51cHTxaVoQP5Pgd3qHaMCva/YO i87A== X-Gm-Message-State: AOJu0YyQHEYm/6imDF7nL81D47z/JXDr75ZZzPzfinS9Hx4FfR2cgD5D axqGc/OLpIW9terq2xFto5ameEhj5f786MgJinKlo6k4Qwf8jozDGRGxf8C0 X-Gm-Gg: ASbGnctXNolmGTd7BiUvBdvXWDrjn9jQVExAWiB6Gkp3Y6dGRNIRs0Jzw4QuoVFHCwP ZixIHpxksmJN/jhyQtUvJbxeHrnihByyVmOiXu0WAPNzdDz1WNsZqbFM9hKe7Kszr1mvGCzGvGj pq1Ho7tYgCPk9w+Pr3Xdx/ps/7OZ67GpbDVNBsOH8DrdvnGH150yJPEmJn8reCMVTJLiGU3ZM6q otYoQTmexJ+17ra6BCZ7/rZ2oUXYthkWXhEYD2j2xuStG0M0f7W90cRSI+rvm4E0GRadddRKJiZ zaIEbE02gqCSD5Oa7dCDcsQUeugLz5TZugLVJw== X-Google-Smtp-Source: AGHT+IFcnPO2E7PW+B4+upoT1IISmq3tOZpDVa1M8GbwVvH5e2u8cOriHdnRF/I+IKYfDIiFfadHgA== X-Received: by 2002:a17:902:c40a:b0:212:63c0:d9e7 with SMTP id d9443c01a7336-21dd7b61a82mr236607115ad.0.1738410311115; Sat, 01 Feb 2025 03:45:11 -0800 (PST) Received: from localhost.localdomain (utm3.nitt.edu. [14.139.162.2]) by smtp.gmail.com with ESMTPSA id d9443c01a7336-21de331f8d4sm43844805ad.224.2025.02.01.03.45.08 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sat, 01 Feb 2025 03:45:10 -0800 (PST) From: 45mg <45mg.writes@gmail.com> Date: Sat, 1 Feb 2025 17:13:24 +0530 Message-ID: <10c11dfc090e48aa6a3f4b1fd67543ec2bab7b40.1738408683.git.45mg.writes@gmail.com> X-Mailer: git-send-email 2.48.1 In-Reply-To: References: MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * guix/scripts/fork/authenticate.scm: New file. * Makefile.am (MODULES): Add the new file. * guix/scripts/fork.scm (show-help): Mention new command. (%sub-commands): Add new command. Change-Id: Ic34a1b3d1642cedce8d1ff5bae825df30e47755c --- Makefile.am | 1 + guix/scripts/fork.scm | 6 +- guix/scripts/fork/authenticate.scm | 331 +++++++++++++++++++++++++++++ 3 files changed, 336 insertions(+), 2 deletions(-) create mode 100644 guix/scripts/fork/authenticate.scm diff --git a/Makefile.am b/Makefile.am index c628450a5a..1c1f5d84fd 100644 --- a/Makefile.am +++ b/Makefile.am @@ -379,6 +379,7 @@ MODULES = \ guix/scripts/git/authenticate.scm \ guix/scripts/fork.scm \ guix/scripts/fork/create.scm \ + guix/scripts/fork/authenticate.scm \ guix/scripts/graph.scm \ guix/scripts/weather.scm \ guix/scripts/container.scm \ diff --git a/guix/scripts/fork.scm b/guix/scripts/fork.scm index 2d97bcb93f..c5c7a59ba7 100644 --- a/guix/scripts/fork.scm +++ b/guix/scripts/fork.scm @@ -29,7 +29,9 @@ (define (show-help) (display (G_ "The valid values for ACTION are:\n")) (newline) (display (G_ "\ - create set up a fork of Guix\n")) + create set up a fork of Guix\n")) + (display (G_ "\ + authenticate authenticate a fork of Guix\n")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -38,7 +40,7 @@ (define (show-help) (newline) (show-bug-report-information)) -(define %sub-commands '("create")) +(define %sub-commands '("create" "authenticate")) (define (resolve-sub-command name) (let ((module (resolve-interface diff --git a/guix/scripts/fork/authenticate.scm b/guix/scripts/fork/authenticate.scm new file mode 100644 index 0000000000..83d9d87d44 --- /dev/null +++ b/guix/scripts/fork/authenticate.scm @@ -0,0 +1,331 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2025 45mg <45mg.writes@gmail.com> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix scripts fork authenticate) + #:use-module (git) + #:use-module (guix git) + #:use-module (guix git-authenticate) + #:use-module (guix base16) + #:use-module (guix ui) + #:use-module (guix progress) + #:use-module (guix scripts) + #:use-module (guix build utils) + #:use-module (guix channels) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 match) + #:use-module (ice-9 receive) + #:use-module (ice-9 popen) + #:use-module (ice-9 format) + #:use-module (ice-9 pretty-print) + #:use-module (ice-9 string-fun) + #:use-module (ice-9 textual-ports) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-13) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:use-module (srfi srfi-71) + #:export (guix-fork-authenticate + + fork-config-value + fork-configured? + fork-configured-keyring-reference + fork-configured-introduction)) + +;;; Commentary: +;;; +;;; Authenticate a fork of Guix, in the same manner as `guix git +;;; authenticate`. +;;; +;;; Code: + +(define %options + ;; Specifications of the command-line options. + (list (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix fork authenticate"))) + + (option '(#\r "repository") #t #f + (lambda (opt name arg result) + (alist-cons 'directory arg result))) + (option '("upstream-commit") #f #f + (lambda (opt name arg result) + (alist-cons 'upstream-commit (string->oid arg) result))) + (option '("upstream-signer") #f #f + (lambda (opt name arg result) + (alist-cons 'upstream-signer (openpgp-fingerprint* arg) result))) + + (option '(#\e "end") #t #f + (lambda (opt name arg result) + (alist-cons 'end-commit (string->oid arg) result))) + (option '("upstream-end") #t #f + (lambda (opt name arg result) + (alist-cons 'upstream-end-commit (string->oid arg) result))) + (option '(#\k "keyring") #t #f + (lambda (opt name arg result) + (alist-cons 'keyring-reference arg result))) + (option '("upstream-keyring") #t #f + (lambda (opt name arg result) + (alist-cons 'upstream-keyring arg result))) + (option '("cache-key") #t #f + (lambda (opt name arg result) + (alist-cons 'cache-key arg result))) + (option '("historical-authorizations") #t #f + (lambda (opt name arg result) + (alist-cons 'historical-authorizations arg + result))) + (option '("stats") #f #f + (lambda (opt name arg result) + (alist-cons 'show-stats? #t result))))) + +(define %default-options + (let ((introduction (channel-introduction %default-guix-channel))) + `((upstream-commit + . ,(string->oid (channel-introduction-first-signed-commit introduction))) + (upstream-signer + . ,(openpgp-fingerprint + (string-upcase + (bytevector->base16-string + (channel-introduction-first-commit-signer introduction))))) + (upstream-keyring + . "keyring")))) + +(define %usage + (format #f (G_ "Usage: guix fork authenticate UPSTREAM COMMIT SIGNER [OPTIONS...] +Authenticate a fork of Guix, using COMMIT/SIGNER as the fork introduction. + +First, authenticate new commits from UPSTREAM, using Guix's default +introduction. Then authenticate the remaining commits using the fork +introduction. + + -r, --repository=DIRECTORY + Authenticate the Git repository in DIRECTORY + + --upstream-commit=COMMIT + --upstream-signer=SIGNER + Use COMMIT/SIGNER as the introduction for upstream + Guix, overriding the default values + ~a + /~a + (Guix's default introduction). + + -k, --keyring=REFERENCE + load keyring for fork commits from REFERENCE, a Git + branch (default \"keyring\") + --upstream-keyring=REFERENCE + load keyring for upstream commits from REFERENCE, a + Git branch (default \"keyring\") + --end=COMMIT authenticate fork commits up to COMMIT + --cache-key=KEY cache authenticated commits under KEY + --historical-authorizations=FILE + read historical authorizations from FILE + --stats Display commit signing statistics upon completion + + -h, --help display this help and exit + -V, --version display version information and exit +") + (assoc-ref %default-options 'upstream-commit) + (assoc-ref %default-options 'upstream-signer))) + +(define (show-help) + (display %usage) + (newline) + (show-bug-report-information)) + +(define (missing-arguments) + (leave (G_ "wrong number of arguments; \ +required UPSTREAM, COMMIT and SIGNER~%"))) + + +;;; +;;; Helper prodecures. +;;; + +(define (fork-config-value repository key) + "Return the config value associated with KEY in the +'guix.fork-authentication' namespace in REPOSITORY, or #f if no such config +was found." + (let* ((config (repository-config repository)) + (branch (repository-current-branch repository))) + (catch 'git-error + (lambda () + (config-entry-value + (config-get-entry config + (string-append "guix.fork-authentication." + key)))) + (const #f)))) + +(define (fork-configured-introduction repository) + "Return three values: the upstream branch name, introductory commit, and +signer fingerprint (strings) for this fork, as configured in REPOSITORY. +Error out if any were missing." + (let* ((upstream-branch (fork-config-value repository "upstream-branch")) + (commit (fork-config-value repository "introduction-commit")) + (signer (fork-config-value repository "introduction-signer"))) + (unless (and upstream-branch commit signer) + (leave (G_ "fork information in .git/config is incomplete; +missing at least one of +introduction-commit, introduction-signer, upstream-branch +under [guix \"fork-authentication\"]"))) + (values upstream-branch commit signer))) + +(define (fork-configured-keyring-reference repository) + "Return the keyring reference configured in REPOSITORY or #f if missing." + (fork-config-value repository "keyring")) + +(define (fork-configured? repository) + "Return true if REPOSITORY already contains fork introduction info in its +'config' file." + (and (fork-config-value repository "upstream-branch") + (fork-config-value repository "introduction-commit") + (fork-config-value repository "introduction-signer"))) + +(define* (record-fork-configuration + repository + #:key commit signer upstream-branch keyring-reference) + "Record COMMIT, SIGNER, UPSTREAM-BRANCH and KEYRING-REFERENCE in the +'config' file of REPOSITORY." + (define config + (repository-config repository)) + + ;; Guile-Git < 0.7.0 lacks 'set-config-string'. + (if (module-defined? (resolve-interface '(git)) 'set-config-string) + (begin + (set-config-string config "guix.fork-authentication.introduction-commit" + commit) + (set-config-string config "guix.fork-authentication.introduction-signer" + signer) + (set-config-string config "guix.fork-authentication.upstream-branch" + upstream-branch) + (set-config-string config "guix.fork-authentication.keyring" + keyring-reference) + (info (G_ "introduction, upstream branch and keyring recorded \ +in repository configuration file~%"))) + (warning (G_ "could not record introduction and keyring configuration\ + (Guile-Git too old?)~%")))) + + +(define (guix-fork-authenticate . args) + (define options + (parse-command-line args %options (list %default-options) + #:build-options? #f)) + + (define (command-line-arguments lst) + (reverse (filter-map (match-lambda + (('argument . arg) arg) + (_ #f)) + lst))) + + (define (make-reporter start-commit end-commit commits) + (format (current-error-port) + (G_ "Authenticating commits ~a to ~a (~h new \ +commits)...~%") + (commit-short-id start-commit) + (commit-short-id end-commit) + (length commits)) + (if (isatty? (current-error-port)) + (progress-reporter/bar (length commits)) + progress-reporter/silent)) + + (with-error-handling + (with-git-error-handling + ;; TODO: BUG: it doesn't recognize '~' in paths + ;; How to do 'realpath' in Guile? + (let* ((repository (repository-open (or (assoc-ref options 'directory) + (repository-discover ".")))) + (upstream commit signer (match (command-line-arguments options) + ((upstream commit signer) + (values + (branch-lookup repository upstream) + (string->oid commit) + (openpgp-fingerprint* signer))) + (() + (receive (upstream commit signer) + (fork-configured-introduction repository) + (values + (branch-lookup repository upstream) + (string->oid commit) + (openpgp-fingerprint* signer)))) + (_ + (missing-arguments)))) + (upstream-commit (assoc-ref options 'upstream-commit)) + (upstream-signer (assoc-ref options 'upstream-signer)) + (history (match (assoc-ref options 'historical-authorizations) + (#f '()) + (file (call-with-input-file file + read-authorizations)))) + (keyring (or (assoc-ref options 'keyring-reference) + (fork-configured-keyring-reference repository) + "keyring")) + (upstream-keyring (assoc-ref options 'upstream-keyring)) + (end (match (assoc-ref options 'end-commit) + (#f (reference-target + (repository-head repository))) + (oid oid))) + (upstream-end (match (assoc-ref options 'upstream-end-commit) + (#f + (reference-target upstream)) + (oid oid))) + (cache-key (or (assoc-ref options 'cache-key) + (repository-cache-key repository))) + (show-stats? (assoc-ref options 'show-stats?))) + + (define upstream-authentication-args + (filter identity + (list + (oid->string upstream-commit) + (bytevector->base16-string upstream-signer) + (string-append "--repository=" + (repository-directory repository)) + (string-append "--end=" + (oid->string upstream-end)) + (and upstream-keyring + (string-append "--keyring=" + upstream-keyring)) + (and show-stats? "--stats")))) + + (info (G_ "calling `guix git authenticate` for branch ~a...~%") + (branch-name upstream)) + + (apply run-guix-command 'git "authenticate" + upstream-authentication-args) + + (define fork-stats + (authenticate-repository + repository commit signer + #:end end + #:keyring-reference keyring + #:historical-authorizations history + #:cache-key cache-key + #:make-reporter make-reporter)) + + (unless (fork-configured? repository) + (record-fork-configuration repository + #:commit (oid->string commit) + #:signer (bytevector->base16-string signer) + #:upstream-branch (branch-name upstream) + #:keyring-reference keyring)) + + (when (and show-stats? (not (null? fork-stats))) + (show-authentication-stats fork-stats)) + + (info (G_ "successfully authenticated commit ~a~%") + (oid->string end))))))