From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id aHGzDl6alV9MTAAA0tVLHw (envelope-from ) for ; Sun, 25 Oct 2020 15:31:42 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id oKhmCl6alV9sJQAAbx9fmQ (envelope-from ) for ; Sun, 25 Oct 2020 15:31:42 +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 A7D0B9403E8 for ; Sun, 25 Oct 2020 15:31:41 +0000 (UTC) Received: from localhost ([::1]:52684 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kWhzg-0007X5-Cz for larch@yhetil.org; Sun, 25 Oct 2020 11:31:40 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:46908) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kWhz4-0007Wg-6f for bug-guix@gnu.org; Sun, 25 Oct 2020 11:31:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:54055) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kWhz3-000424-So for bug-guix@gnu.org; Sun, 25 Oct 2020 11:31:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kWhz3-0002pr-PC for bug-guix@gnu.org; Sun, 25 Oct 2020 11:31:01 -0400 X-Loop: help-debbugs@gnu.org Subject: bug#43893: [PATCH v3] maint: update-guix-package: Prevent accidentally breaking guix pull. Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: bug-guix@gnu.org Resent-Date: Sun, 25 Oct 2020 15:31:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 43893 X-GNU-PR-Package: guix X-GNU-PR-Keywords: patch To: Maxim Cournoyer Received: via spool by 43893-submit@debbugs.gnu.org id=B43893.160363980510749 (code B ref 43893); Sun, 25 Oct 2020 15:31:01 +0000 Received: (at 43893) by debbugs.gnu.org; 25 Oct 2020 15:30:05 +0000 Received: from localhost ([127.0.0.1]:37363 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kWhy8-0002nI-Pb for submit@debbugs.gnu.org; Sun, 25 Oct 2020 11:30:05 -0400 Received: from eggs.gnu.org ([209.51.188.92]:46670) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kWhy6-0002mK-Bz for 43893@debbugs.gnu.org; Sun, 25 Oct 2020 11:30:03 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:35996) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kWhy1-0003m1-4f; Sun, 25 Oct 2020 11:29:57 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=55088 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1kWhy0-0005J7-3K; Sun, 25 Oct 2020 11:29:56 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= References: <87imbedsko.fsf@gnu.org> <20201014031705.4516-1-maxim.cournoyer@gmail.com> <87lfg0bo9m.fsf@gnu.org> <87v9f44852.fsf@gmail.com> <875z749czt.fsf@gnu.org> <87eelpd0af.fsf@gmail.com> <87k0vhm1fg.fsf@gnu.org> <87d0172adj.fsf@gmail.com> <87k0vefjgv.fsf@gnu.org> Date: Sun, 25 Oct 2020 16:29:53 +0100 In-Reply-To: <87k0vefjgv.fsf@gnu.org> ("Ludovic =?UTF-8?Q?Court=C3=A8s?="'s message of "Sun, 25 Oct 2020 15:50:24 +0100") Message-ID: <874kmifhn2.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.1 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" 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: , Cc: 43893@debbugs.gnu.org Errors-To: bug-guix-bounces+larch=yhetil.org@gnu.org Sender: "bug-Guix" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; 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: -0.51 X-TUID: CSwhpsjY1a2s --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi again, How about this variant of the initial script? I think it addresses the main issues we discussed here: 1. By default it doesn=E2=80=99t re-add the source in the store, so wrong commit/hash issues are caught when running =E2=80=98guix build guix=E2= =80=99. 2. It diagnoses dirty trees early on. It does not explicitly diagnose missing upstream commits though, but again they=E2=80=99re caught when running =E2=80=98guix build guix=E2=80=99. WDYT? Sorry for all the back-and-forth on what looks like a tiny issue. I do think we=E2=80=99re making progress anyway! Thanks, Ludo=E2=80=99. --=-=-= Content-Type: text/plain; charset=utf-8 Content-Disposition: inline; filename=update-guix-package.scm Content-Transfer-Encoding: quoted-printable Content-Description: the code ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2017, 2018 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2020 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . ;;; Commentary: ;;; ;;; This scripts updates the definition of the 'guix' package in Guix for t= he ;;; current commit. It requires Git to be installed. ;;; ;;; Code: (use-modules (git) (guix) (guix git-download) (guix upstream) (guix utils) (guix base32) (guix build utils) (guix i18n) (guix diagnostics) (gnu packages package-management) (ice-9 match)) (define %top-srcdir (string-append (current-source-directory) "/..")) (define version-controlled? (git-predicate %top-srcdir)) (define (package-definition-location) "Return the source properties of the definition of the 'guix' package." (call-with-input-file (location-file (package-location guix)) (lambda (port) (let loop () (match (read port) ((? eof-object?) (error "definition of 'guix' package could not be found" (port-filename port))) (('define-public 'guix value) (source-properties value)) (_ (loop))))))) (define* (update-definition commit hash #:key version old-hash) "Return a one-argument procedure that takes a string, the definition of t= he 'guix' package, and returns a string, the update definition for VERSION, COMMIT." (define (linear-offset str line column) ;; Return the offset in characters to reach LINE and COLUMN (both ;; zero-indexed) in STR. (call-with-input-string str (lambda (port) (let loop ((offset 0)) (cond ((and (=3D (port-column port) column) (=3D (port-line port) line)) offset) ((eof-object? (read-char port)) (error "line and column not reached!" str)) (else (loop (+ 1 offset)))))))) (define (update-hash str) ;; Replace OLD-HASH with HASH in STR. (string-replace-substring str (bytevector->nix-base32-string old-hash) (bytevector->nix-base32-string hash))) (lambda (str) (match (call-with-input-string str read) (('let (('version old-version) ('commit old-commit) ('revision old-revision)) defn) (let* ((location (source-properties defn)) (line (assq-ref location 'line)) (column 0) (offset (linear-offset str line column))) (string-append (format #f "(let ((version \"~a\") (commit \"~a\") (revision ~a))\n" (or version old-version) commit (if (and version (not (string=3D? version old-versi= on))) 0 (+ 1 old-revision))) (string-drop (update-hash str) offset)))) (exp (error "'guix' package definition is not as expected" exp))))) (define (keep-source-in-store store source) "Add SOURCE to the store under the name that the 'guix' package expects." ;; Add SOURCE to the store, but this time under the real name used in the ;; 'origin'. This allows us to build the package without having to make a ;; real checkout; thus, it also works when working on a private branch. (reload-module (resolve-module '(gnu packages package-management))) (let* ((source (add-to-store store (origin-file-name (package-source guix)) #t "sha256" source)) (root (store-path-package-name source))) ;; Add an indirect GC root for SOURCE in the current directory. (false-if-exception (delete-file root)) (symlink source root) (add-indirect-root store (string-append (getcwd) "/" root)) (info (G_ "source code kept in ~a (GC root: ~a)~%") source root))) (define (assert-clean-checkout repository) "Error out if the working directory at REPOSITORY contains local modifications." (define description (let ((format-options (make-describe-format-options #:dirty-suffix "-dirty"))) (describe-format (describe-workdir repository) format-options))) (when (string-suffix? "-dirty" description) (leave (G_ "attempt to update 'guix' package from a dirty tree (~a)~%") description)) (info (G_ "updating 'guix' package to '~a'~%") description)) (define (main . args) (match args ((commit version) (with-store store (let* ((source (add-to-store store "guix-checkout" ;dummy name #t "sha256" %top-srcdir #:select? version-controlled?)) (hash (query-path-hash store source)) (location (package-definition-location)) (old-hash (content-hash-value (origin-hash (package-source guix))))) (unless (getenv "GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT") (let ((repository (repository-open "."))) (assert-clean-checkout repository) (repository-close! repository))) (edit-expression location (update-definition commit hash #:old-hash old-hash #:version version)) (when (getenv "GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT") (keep-source-in-store store source))))) ((commit) ;; Automatically deduce the version and revision numbers. (main commit #f)))) (apply main (cdr (command-line))) --=-=-=--