From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp11.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id cGeXMQTVAWQ6SgEAbAwnHQ (envelope-from ) for ; Fri, 03 Mar 2023 12:07:48 +0100 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp11.migadu.com with LMTPS id QC6NMQTVAWT9KgEA9RJhRA (envelope-from ) for ; Fri, 03 Mar 2023 12:07:48 +0100 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 7A7D01380B for ; Fri, 3 Mar 2023 12:07:48 +0100 (CET) Authentication-Results: aspmx1.migadu.com; dkim=none; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=gnu.org ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1677841668; h=from:from:sender:sender:reply-to:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post; bh=2ZPbroN4yml0ja8B2Pardh3sgViIMuNPAvuFrMSKKrA=; b=JfEMG7OUYsJFDoHSUnXNIakeZhoij4W7nfHudUA6NRk1oolJCOaQJgfLR4TywaNUM2WW/+ W0imuwnzMGNAEeKZCeR2Xnng0M3msRqC6VKQW2LqzdsiK+eho5sEpM60Db1oNGHPEx0kch V2vjkRjjnopIUZNHjNuUgsHG3Ezg7C57WvEkTsYbUE+VlsPYP/v/Sp4P6yyPYUyJ4001kO H2+S9zZIWB91M4tnTFhHl1TAustXj737Ul3DShXHKwYgRpPz/4cOKowYvUrNsJuLDwwNq8 IvU+YB1qAuGD0xkwxR2LhlfDBO0MhQZuyQ+lrlORF+LAI9lwHI36KpjtfKBnfA== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=gnu.org ARC-Seal: i=1; s=key1; d=yhetil.org; t=1677841668; a=rsa-sha256; cv=none; b=C6fKuOhJi3grMxOnD82UTK3Mj26GL6hgZ+hlbX10gFXnChYOJIy9BXlaPBVc6TzIsTq66+ jXq1dnS34dggVS7U3XomBS5BUxiNr2o+Gvd+/AuFcpAykz2Zq5UW8KfmMQA7z7z+aNSXCs sdDqd7LfG8blFhVeVGPV/pouqRUBCwEwS3r0CJRT2UDlMLLNTpjoKsGeiB/Zq53iS6iqj+ YDlfjF9JYb93nYsNk8TTODj5PEQZVEHEhWahSwQpZ7/bMkCGLK5XIvoSpsqak0XaQ1K25n StVoV1zUa7AvTF3yYbIWVKRTh4BHJ0ZnXv8t97RpM47lso4SivWiYtqYNg+YxA== Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pY3Fg-0001X3-Ng; Fri, 03 Mar 2023 06:07:04 -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 1pY3Fe-0001W7-A7 for guix-patches@gnu.org; Fri, 03 Mar 2023 06:07:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pY3Fd-0007t2-T7 for guix-patches@gnu.org; Fri, 03 Mar 2023 06:07:01 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pY3Fd-0001ta-OA for guix-patches@gnu.org; Fri, 03 Mar 2023 06:07:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61930] [PATCH] import: factorising git->origin in guix/import/utils.scm. References: <87ilfi3yvm.fsf@ngraves.fr> In-Reply-To: <87ilfi3yvm.fsf@ngraves.fr> Resent-From: Nicolas Graves Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 03 Mar 2023 11:07:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 61930 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 61930@debbugs.gnu.org Cc: ngraves@ngraves.fr Received: via spool by 61930-submit@debbugs.gnu.org id=B61930.16778415897248 (code B ref 61930); Fri, 03 Mar 2023 11:07:01 +0000 Received: (at 61930) by debbugs.gnu.org; 3 Mar 2023 11:06:29 +0000 Received: from localhost ([127.0.0.1]:59782 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pY3F6-0001so-IQ for submit@debbugs.gnu.org; Fri, 03 Mar 2023 06:06:29 -0500 Received: from 6.mo575.mail-out.ovh.net ([46.105.63.100]:40111) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pY3F3-0001sd-Kf for 61930@debbugs.gnu.org; Fri, 03 Mar 2023 06:06:27 -0500 Received: from director8.ghost.mail-out.ovh.net (unknown [10.108.16.32]) by mo575.mail-out.ovh.net (Postfix) with ESMTP id 1752C23851 for <61930@debbugs.gnu.org>; Fri, 3 Mar 2023 11:06:22 +0000 (UTC) Received: from ghost-submission-6684bf9d7b-txjsz (unknown [10.110.103.46]) by director8.ghost.mail-out.ovh.net (Postfix) with ESMTPS id 5A7A61FE0A; Fri, 3 Mar 2023 11:06:21 +0000 (UTC) Received: from ngraves.fr ([37.59.142.96]) by ghost-submission-6684bf9d7b-txjsz with ESMTPSA id mNmbBq3UAWTDoAAAXKQCxA (envelope-from ); Fri, 03 Mar 2023 11:06:21 +0000 X-OVh-ClientIp: 81.67.140.142 Date: Fri, 3 Mar 2023 12:06:19 +0100 Message-Id: <20230303110619.21119-1-ngraves@ngraves.fr> X-Mailer: git-send-email 2.39.1 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Ovh-Tracer-Id: 15325186585740567266 X-VR-SPAMSTATE: OK X-VR-SPAMSCORE: 11 X-VR-SPAMCAUSE: gggruggvucftvghtrhhoucdtuddrgedvhedrudelledgudelucetufdoteggodetrfdotffvucfrrhhofhhilhgvmecuqfggjfdpvefjgfevmfevgfenuceurghilhhouhhtmecuhedttdenucgfrhhlucfvnfffucdluddumdenucfjughrpefhvfevufffkffogggtgfesthekredtredtjeenucfhrhhomheppfhitgholhgrshcuifhrrghvvghsuceonhhgrhgrvhgvshesnhhgrhgrvhgvshdrfhhrqeenucggtffrrghtthgvrhhnpeekvdethfetuddutefgkeeludetgfevgfduleejgeeviefhvdehjeetteetkeduueenucffohhmrghinhepghhithhlrggsrdgtohhmpdhsphgugidrohhrghenucfkphepuddvjedrtddrtddruddpfeejrdehledrudegvddrleeinecuvehluhhsthgvrhfuihiivgeptdenucfrrghrrghmpehinhgvthepuddvjedrtddrtddruddpmhgrihhlfhhrohhmpeeonhhgrhgrvhgvshesnhhgrhgrvhgvshdrfhhrqedpnhgspghrtghpthhtohepuddprhgtphhtthhopeeiudelfedtseguvggssghughhsrdhgnhhurdhorhhgpdfovfetjfhoshhtpehmohehjeehpdhmohguvgepshhmthhpohhuth 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: , Reply-to: Nicolas Graves X-ACL-Warn: , Nicolas Graves via Guix-patches X-Migadu-Spam-Score: -4.60 X-Spam-Score: -4.60 X-Migadu-Scanner: scn0.migadu.com X-Migadu-Queue-Id: 7A7D01380B From: Nicolas Graves via Guix-patches via Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: guix-patches-bounces+larch=yhetil.org@gnu.org X-Migadu-Country: US X-Migadu-Flow: FLOW_IN X-TUID: CzDoouUzL3TL --- guix/import/elpa.scm | 44 +++++++++++-------------------------- guix/import/go.scm | 47 +++++++++------------------------------- guix/import/minetest.scm | 28 ++---------------------- guix/import/utils.scm | 36 ++++++++++++++++++++++++++++++ tests/minetest.scm | 11 ++-------- 5 files changed, 63 insertions(+), 103 deletions(-) diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index f9e9f2de53..cfd149a697 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2021 Sarah Morgensen ;;; Copyright © 2021 Simon Tournier ;;; Copyright © 2022 Hartmut Goebel +;;; Copyright © 2023 Nicolas Graves ;;; ;;; This file is part of GNU Guix. ;;; @@ -45,7 +46,6 @@ (define-module (guix import elpa) #:use-module ((guix serialization) #:select (write-file)) #:use-module (guix store) #:use-module (guix ui) - #:use-module (guix base32) #:use-module (guix upstream) #:use-module (guix packages) #:use-module (guix memoization) @@ -210,11 +210,6 @@ (define* (fetch-elpa-package name #:optional (repo 'gnu)) url))) (_ #f)))) -(define* (download-git-repository url ref) - "Fetch the given REF from the Git repository at URL." - (with-store store - (latest-repository-commit store url #:ref ref))) - (define (package-name->melpa-recipe package-name) "Fetch the MELPA recipe for PACKAGE-NAME, represented as an alist from keywords to values." @@ -234,28 +229,15 @@ (define (data->recipe data) (close-port port) (data->recipe (cons ':name data)))) -(define (git-repository->origin recipe url) - "Fetch origin details from the Git repository at URL for the provided MELPA -RECIPE." - (define ref - (cond - ((assoc-ref recipe #:branch) - => (lambda (branch) (cons 'branch branch))) - ((assoc-ref recipe #:commit) - => (lambda (commit) (cons 'commit commit))) - (else - '()))) - - (let-values (((directory commit) (download-git-repository url ref))) - `(origin - (method git-fetch) - (uri (git-reference - (url ,url) - (commit ,commit))) - (sha256 - (base32 - ,(bytevector->nix-base32-string - (file-hash* directory #:recursive? #true))))))) +(define (ref recipe) + "Create REF from MELPA RECIPE." + (cond + ((assoc-ref recipe #:branch) + => (lambda (branch) (cons 'branch branch))) + ((assoc-ref recipe #:commit) + => (lambda (commit) (cons 'commit commit))) + (else + '()))) (define* (melpa-recipe->origin recipe) "Fetch origin details from the MELPA recipe and associated repository for @@ -266,9 +248,9 @@ (define (gitlab-repo->url repo) (string-append "https://gitlab.com/" repo ".git")) (match (assq-ref recipe ':fetcher) - ('github (git-repository->origin recipe (github-repo->url (assq-ref recipe ':repo)))) - ('gitlab (git-repository->origin recipe (gitlab-repo->url (assq-ref recipe ':repo)))) - ('git (git-repository->origin recipe (assq-ref recipe ':url))) + ('github (git->origin (github-repo->url (assq-ref recipe ':repo)) (ref recipe))) + ('gitlab (git->origin (gitlab-repo->url (assq-ref recipe ':repo)) (ref recipe))) + ('git (git->origin (assq-ref recipe ':url) (ref recipe))) (#f #f) ; if we're not using melpa then this stops us printing a warning (_ (warning (G_ "Unsupported MELPA fetcher: ~a, falling back to unstable MELPA source.~%") (assq-ref recipe ':fetcher)) diff --git a/guix/import/go.scm b/guix/import/go.scm index 90d4c8931d..c8ee16fd39 100644 --- a/guix/import/go.scm +++ b/guix/import/go.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2021 Xinglu Chen ;;; Copyright © 2021 Sarah Morgensen ;;; Copyright © 2021 Simon Tournier +;;; Copyright © 2023 Nicolas Graves ;;; ;;; This file is part of GNU Guix. ;;; @@ -501,49 +502,21 @@ (define (module-meta-data-repo-url meta-data goproxy) goproxy (module-meta-repo-root meta-data))) -(define* (git-checkout-hash url reference algorithm) - "Return the ALGORITHM hash of the checkout of URL at REFERENCE, a commit or -tag." - (define cache - (string-append (or (getenv "TMPDIR") "/tmp") - "/guix-import-go-" - (passwd:name (getpwuid (getuid))))) - - ;; Use a custom cache to avoid cluttering the default one under - ;; ~/.cache/guix, but choose one under /tmp so that it's persistent across - ;; subsequent "guix import" invocations. - (mkdir-p cache) - (chmod cache #o700) - (let-values (((checkout commit _) - (parameterize ((%repository-cache-directory cache)) - (update-cached-checkout url - #:ref - `(tag-or-commit . ,reference))))) - (file-hash* checkout #:algorithm algorithm #:recursive? #true))) +;; This is done because the version field of the package, which the generated +;; quoted expression refers to, has been stripped of any 'v' prefixed. +(define (transform-version version) + (let ((plain-version? (string=? version (go-version->git-ref version))) + (v-prefixed? (string-prefix? "v" version))) + ,(if (and plain-version? v-prefixed?) + '(string-append "v" version) + '(go-version->git-ref version)))) (define (vcs->origin vcs-type vcs-repo-url version) "Generate the `origin' block of a package depending on what type of source control system is being used." (case vcs-type ((git) - (let ((plain-version? (string=? version (go-version->git-ref version))) - (v-prefixed? (string-prefix? "v" version))) - `(origin - (method git-fetch) - (uri (git-reference - (url ,vcs-repo-url) - ;; This is done because the version field of the package, - ;; which the generated quoted expression refers to, has been - ;; stripped of any 'v' prefixed. - (commit ,(if (and plain-version? v-prefixed?) - '(string-append "v" version) - '(go-version->git-ref version))))) - (file-name (git-file-name name version)) - (sha256 - (base32 - ,(bytevector->nix-base32-string - (git-checkout-hash vcs-repo-url (go-version->git-ref version) - (hash-algorithm sha256)))))))) + (git->origin vcs-repo-url `(tag-or-commit . ,version) transform-version)) ((hg) `(origin (method hg-fetch) diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm index e5775e2fa9..f080539bda 100644 --- a/guix/import/minetest.scm +++ b/guix/import/minetest.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021, 2022 Maxime Devos ;;; Copyright © 2022 Hartmut Goebel +;;; Copyright © 2023 Nicolas Graves ;;; ;;; This file is part of GNU Guix. ;;; @@ -38,7 +39,6 @@ (define-module (guix import minetest) #:use-module (guix import json) #:use-module ((gcrypt hash) #:select (open-sha256-port port-sha256)) #:use-module (json) - #:use-module (guix base32) #:use-module (guix git) #:use-module ((guix git-download) #:prefix download:) #:use-module (guix hash) @@ -283,12 +283,6 @@ (define url (string-append (%contentdb-api) "packages/?type=" type -;; XXX copied from (guix import elpa) -(define* (download-git-repository url ref) - "Fetch the given REF from the Git repository at URL." - (with-store store - (latest-repository-commit store url #:ref ref))) - (define (make-minetest-sexp author/name version repository commit inputs home-page synopsis description media-license license) @@ -298,25 +292,7 @@ (define (make-minetest-sexp author/name version repository commit `(package (name ,(contentdb->package-name author/name)) (version ,version) - (source - (origin - (method git-fetch) - (uri (git-reference - (url ,repository) - (commit ,commit))) - (sha256 - (base32 - ;; The git commit is not always available. - ,(and commit - (bytevector->nix-base32-string - (file-hash* - (download-git-repository repository - `(commit . ,commit)) - ;; 'download-git-repository' already filtered out the '.git' - ;; directory. - #:select? (const #true) - #:recursive? #true))))) - (file-name (git-file-name name version)))) + (source ,(git->origin repository `(tag-or-commit . ,commit))) (build-system minetest-mod-build-system) ,@(maybe-propagated-inputs (map contentdb->package-name inputs)) (home-page ,home-page) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 72795d2c61..3b31338e00 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -13,6 +13,7 @@ ;;; Copyright © 2022 Alice Brenon ;;; Copyright © 2022 Kyle Meyer ;;; Copyright © 2022 Philip McGrath +;;; Copyright © 2023 Nicolas Graves ;;; ;;; This file is part of GNU Guix. ;;; @@ -40,6 +41,8 @@ (define-module (guix import utils) #:use-module (guix discovery) #:use-module (guix build-system) #:use-module (guix gexp) + #:use-module (guix git) + #:use-module (guix hash) #:use-module ((guix i18n) #:select (G_)) #:use-module (guix store) #:use-module (guix download) @@ -63,6 +66,7 @@ (define-module (guix import utils) url-fetch guix-hash-url + git->origin package-names->package-inputs maybe-inputs @@ -153,6 +157,38 @@ (define (guix-hash-url filename) "Return the hash of FILENAME in nix-base32 format." (bytevector->nix-base32-string (file-sha256 filename))) +(define* (git->origin repo-url ref #:optional ref->commit) + "Generate the `origin' block of a package depending on the git source +control system. REPO-URL or REF can be null." + (let-values (((directory commit) + (with-store store + (latest-repository-commit store repo-url #:ref ref)))) + (let* ((version (if (pair? ref) + (cdr ref) + #f)) + (vcommit (match ref->commit + (#t + commit) + (null? + version) + (_ + (ref->commit version))))) + `(origin + (method git-fetch) + (uri (git-reference + (url ,(and (not (eq? repo-url 'null)) repo-url)) + (commit ,vcommit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + ,(if (pair? ref) + (bytevector->nix-base32-string + (file-hash* directory + ;; 'git-fetch' already filtered out the '.git' directory. + #:select? (const #true) + #:recursive? #true)) + #f))))))) + (define %spdx-license-identifiers ;; https://spdx.org/licenses/ ;; The gfl1.0, nmap, repoze diff --git a/tests/minetest.scm b/tests/minetest.scm index cbb9e83889..c03f731845 100644 --- a/tests/minetest.scm +++ b/tests/minetest.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Maxime Devos +;;; Copyright © 2023 Nicolas Graves ;;; ;;; This file is part of GNU Guix. ;;; @@ -57,15 +58,7 @@ (define* (make-package-sexp #:key `(package (name ,guix-name) (version ,version) - (source - (origin - (method git-fetch) - (uri (git-reference - (url ,(and (not (eq? repo 'null)) repo)) - (commit #f))) - (sha256 - (base32 #f)) - (file-name (git-file-name name version)))) + (source (git->origin repo #f)) (build-system minetest-mod-build-system) ,@(maybe-propagated-inputs inputs) (home-page ,home-page) -- 2.39.1