Package: guix-patches;
Reported by: Sarah Morgensen <iskarian <at> mgsn.dev>
Date: Sun, 15 Aug 2021 23:17:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
Message #20 received at 50072 <at> debbugs.gnu.org (full text, mbox):
From: Maxime Devos <maximedevos <at> telenet.be> To: Sarah Morgensen <iskarian <at> mgsn.dev>, 50072 <at> debbugs.gnu.org Subject: Re: [bug#50072] [PATCH WIP 4/4] upstream: Support updating git-fetch origins. Date: Mon, 16 Aug 2021 12:46:25 +0200
[Message part 1 (text/plain, inline)]
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.
[git-fetch.patch (text/x-patch, inline)]
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 <package/keys> 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 <upstream-source> 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 <git-reference>
+ (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 <upstream-source>."
#: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 <upstream-source>."
+ (match source
+ (($ <upstream-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)))
[signature.asc (application/pgp-signature, inline)]
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.