From patchwork Mon Aug 16 10:46:25 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: M X-Patchwork-Id: 32126 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 CDA7227BC82; Mon, 16 Aug 2021 11:47:10 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, FREEMAIL_FROM,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, T_DKIM_INVALID,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 5053427BC78 for ; Mon, 16 Aug 2021 11:47:09 +0100 (BST) Received: from localhost ([::1]:57506 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mFa96-0006Wa-87 for patchwork@mira.cbaines.net; Mon, 16 Aug 2021 06:47:08 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:42022) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mFa90-0006WO-1R for guix-patches@gnu.org; Mon, 16 Aug 2021 06:47:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:37066) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mFa8z-00059m-RU for guix-patches@gnu.org; Mon, 16 Aug 2021 06:47:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mFa8z-0006nD-MP for guix-patches@gnu.org; Mon, 16 Aug 2021 06:47:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins. Resent-From: Maxime Devos Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 16 Aug 2021 10:47:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50072 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Sarah Morgensen , 50072@debbugs.gnu.org Received: via spool by 50072-submit@debbugs.gnu.org id=B50072.162911080426082 (code B ref 50072); Mon, 16 Aug 2021 10:47:01 +0000 Received: (at 50072) by debbugs.gnu.org; 16 Aug 2021 10:46:44 +0000 Received: from localhost ([127.0.0.1]:48612 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mFa8e-0006mW-40 for submit@debbugs.gnu.org; Mon, 16 Aug 2021 06:46:43 -0400 Received: from michel.telenet-ops.be ([195.130.137.88]:37734) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mFa8X-0006mI-LY for 50072@debbugs.gnu.org; Mon, 16 Aug 2021 06:46:38 -0400 Received: from ptr-bvsjgyjmffd7q9timvx.18120a2.ip6.access.telenet.be ([IPv6:2a02:1811:8c09:9d00:aaf1:9810:a0b8:a55d]) by michel.telenet-ops.be with bizsmtp id iAmX2500E0mfAB406AmXgz; Mon, 16 Aug 2021 12:46:32 +0200 Message-ID: From: Maxime Devos Date: Mon, 16 Aug 2021 12:46:25 +0200 In-Reply-To: <8d1ae518b23fac5b15812a30b11df1c360ab3fbf.1629068119.git.iskarian@mgsn.dev> References: <8d1ae518b23fac5b15812a30b11df1c360ab3fbf.1629068119.git.iskarian@mgsn.dev> User-Agent: Evolution 3.34.2 MIME-Version: 1.0 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=telenet.be; s=r21; t=1629110792; bh=Hrbyv12u/y89xtr1hGfsNsqGzX/rZo4WgsLM0uWQY6I=; h=Subject:From:To:Date:In-Reply-To:References; b=eWARWO3vQfCHneBxhTvA6f6shcvmiwfJby2uElrnbkEr2NeKIYBdbMLjnJM04q9yA C+f6glE2MTGRJW0s52xHrJphHTQxqU1NqtDJZtMxhhbHavF3iMwZFsyBdBGoDw4+wW +fwedWbU8ortwAZ6AdguE+m6MHNiY2yO9iAWzravEKpXC+6Oza0UrG77WejI3Ob6o1 D+1hbAPgFDfJj9B5vqhfqIaiCbHpkBhi0g5CaxCLE2lyDEXuBh+xVVzIwm7pieQgW/ 0rmWdyIxD8q4xSZmuxm5g9LerCMKVerEEV1CD+p1kKLH37BEeTEtyHZ0Ggee6+/H8k 7VTDWQ9Ct3MFg== 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" X-getmail-retrieved-from-mailbox: Patches Sarah Morgensen schreef op zo 15-08-2021 om 16:25 [-0700]: > * guix/git-download.scm (checkout-to-store): New procedure. > * guix/upstream.scm (guess-version-transform) > (package-update/git-fetch): New procedures. > (%method-updates): Add GIT-FETCH mapping. Does it support packages defined like (a) (define-public gnash (let ((commit "583ccbc1275c7701dc4843ec12142ff86bb305b4") (revision "0")) (package (name "gnash") (version (git-version "0.8.11" revision commit)) (source (git-reference (url "https://example.org") (commit commit))) [...]))) and (b) (define-public gnash (package (name "gnash") (version "0.8.11") (source (git-reference (url "https://example.org") (commit commit)) [...])) ? (Maybe (a) and (b) can be used as test cases.) FWIW, I had a try at supporting git-fetch origins in "--with-latest" and "guix refresh -e" myself, and had to modify 'package-update' to replace commit strings. IIRC, it supports (b), but not (a). The patch is attached, hopefully it will be useful. Greetings, Maxime. diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm index 4264341d6a..2904c3f94a 100644 --- a/guix/import/minetest.scm +++ b/guix/import/minetest.scm @@ -297,7 +297,7 @@ results. The return value is a list of records." (define (make-minetest-sexp author/name version repository commit inputs home-page synopsis description media-license license) - "Return a S-expression for the minetest package with the given author/NAME, + "Return a S-expression for the minetest package with the given AUTHOR/NAME, VERSION, REPOSITORY, COMMIT, INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, MEDIA-LICENSE and LICENSE." `(package @@ -452,3 +452,37 @@ list of AUTHOR/NAME strings." #:repo->guix-package minetest->guix-package* #:guix-name (compose contentdb->package-name author/name->name))) + +#| +(define (minetest-package? pkg) + (and (string-prefix? "minetest-" (package:package-name pkg)) + (assq-ref (package:package-properties pkg) 'upstream-name))) + +(define (latest-minetest-release pkg) + "Return an for the latest release of the package PKG." + (define upstream-name + (assoc-ref (package:package-properties pkg) 'upstream-name)) + (define contentdb-package (contentdb-fetch upstream-name)) + (define release (latest-release upstream-name)) + (and contentdb-package release + (and-let* ((old-origin (package:package-source pkg)) + (old-reference (package:origin-uri old-origin)) + (is-git? (download:git-reference? old-reference)) + (commit (release-commit release))) + (upstream-source + (package (package:package-name pkg)) + (version (release-title release)) + (urls (download:git-reference + (url (package-repository contentdb-package)) + (commit commit))))))) + +(define %minetest-updater + (upstream-updater + (name 'minetest) + (description "Updater for Minetest packages on ContentDB") + (pred minetest-package?) + (latest latest-minetest-release))) +|# +;; #:use-module (guix upstream) +;; #:use-module ((guix git-download) #:prefix download:) +;; #:use-module ((guix packages) #:prefix package:) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index fb6c52a567..4f3bbbcb94 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -28,8 +28,10 @@ #:use-module (guix ui) #:use-module (gcrypt hash) #:use-module (guix scripts) + #:use-module (guix serialization) #:use-module ((guix scripts build) #:select (%standard-build-options)) #:use-module (guix store) + #:use-module (guix build utils) #:use-module (guix utils) #:use-module (guix packages) #:use-module (guix profiles) @@ -307,6 +309,17 @@ update would trigger a complete rebuild." (G_ "no updater for ~a~%") (package-name package))) + +;; XXX adapted from (guix scripts hash) +(define (file-hash file select? recursive?) + ;; Compute the hash of FILE. + (if recursive? + (let-values (((port get-hash) (open-sha256-port))) + (write-file file port #:select? select?) + (force-output port) + (get-hash)) + (call-with-input-file file port-sha256))) + (define* (update-package store package updaters #:key (key-download 'interactive) warn?) "Update the source file that defines PACKAGE with the new version. @@ -347,8 +360,8 @@ warn about packages that have no matching updater." (package-name package) (upstream-input-change-name change))) (upstream-source-input-changes source)) - (let ((hash (call-with-input-file tarball - port-sha256))) + (let ((hash (file-hash tarball (const #t) + (directory-exists? tarball)))) (update-package-source package source hash))) (warning (G_ "~a: version ~a could not be \ downloaded and authenticated; not updating~%") diff --git a/guix/upstream.scm b/guix/upstream.scm index 632e9ebc4f..61f67b57c1 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -24,6 +24,11 @@ #:use-module (guix discovery) #:use-module ((guix download) #:select (download-to-store url-fetch)) + #:use-module ((guix git-download) + #:select (git-fetch git-reference? + git-reference-url + git-reference-commit + git-reference-recursive?)) #:use-module (guix gnupg) #:use-module (guix packages) #:use-module (guix diagnostics) @@ -33,6 +38,7 @@ #:use-module (guix store) #:use-module ((guix derivations) #:select (built-derivations derivation->output-path)) #:autoload (gcrypt hash) (port-sha256) + #:autoload (guix git) (latest-repository-commit) #:use-module (guix monads) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) @@ -93,7 +99,8 @@ upstream-source? (package upstream-source-package) ;string (version upstream-source-version) ;string - (urls upstream-source-urls) ;list of strings + ; list of strings or a + (urls upstream-source-urls) (signature-urls upstream-source-signature-urls ;#f | list of strings (default #f)) (input-changes upstream-source-input-changes @@ -361,6 +368,11 @@ values: 'interactive' (default), 'always', and 'never'." system target) "Download SOURCE from its first URL and lower it as a fixed-output derivation that would fetch it." + (define url + (match (upstream-source-urls source) + ((first . _) first) + (_ (raise (formatted-message + (G_ "git origins are unsupported by --with-latest")))))) (mlet* %store-monad ((url -> (first (upstream-source-urls source))) (signature -> (and=> (upstream-source-signature-urls source) @@ -430,9 +442,23 @@ SOURCE, an ." #:key-download key-download))) (values version tarball source)))))) +(define* (package-update/git-fetch store package source #:key key-download) + "Return the version, source code directory, and SOURCE, to update PACKAGE to +SOURCE, an ." + (match source + (($ _ version ref _) + (values version + (latest-repository-commit + store + (git-reference-url ref) + #:ref `(commit . ,(git-reference-commit ref)) + #:recursive? (git-reference-recursive? ref)) + source)))) + (define %method-updates ;; Mapping of origin methods to source update procedures. - `((,url-fetch . ,package-update/url-fetch))) + `((,url-fetch . ,package-update/url-fetch) + (,git-fetch . ,package-update/git-fetch))) (define* (package-update store package #:optional (updaters (force %updaters)) @@ -492,9 +518,22 @@ new version string if an update was made, and #f otherwise." (origin-hash (package-source package)))) (old-url (match (origin-uri (package-source package)) ((? string? url) url) + ((? git-reference? ref) + (git-reference-url ref)) (_ #f))) (new-url (match (upstream-source-urls source) - ((first _ ...) first))) + ((first _ ...) first) + ((? git-reference? ref) + (git-reference-url ref)) + (_ #f))) + (old-commit (match (origin-uri (package-source package)) + ((? git-reference? ref) + (git-reference-commit ref)) + (_ #f))) + (new-commit (match (upstream-source-urls source) + ((? git-reference? ref) + (git-reference-commit ref)) + (_ #f))) (file (and=> (location-file loc) (cut search-path %load-path <>)))) (if file @@ -508,6 +547,9 @@ new version string if an update was made, and #f otherwise." 'filename file)) (replacements `((,old-version . ,version) (,old-hash . ,hash) + ,@(if (and old-commit new-commit) + `((,old-commit . ,new-commit)) + '()) ,@(if (and old-url new-url) `((,(dirname old-url) . ,(dirname new-url)))