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 #29 received at 50072 <at> debbugs.gnu.org (full text, mbox):
From: Sarah Morgensen <iskarian <at> mgsn.dev> To: Maxime Devos <maximedevos <at> telenet.be> Cc: Xinglu Chen <public <at> yoctocell.xyz>, 50072 <at> debbugs.gnu.org Subject: Re: bug#50072: [PATCH WIP 0/4] Add upstream updater for git-fetch origins. Date: Mon, 16 Aug 2021 12:56:46 -0700
Hi Maxime,
Thanks for taking a look at this. :)
Maxime Devos <maximedevos <at> telenet.be> writes:
> 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)))
> [...])))
No, it doesn't. Since the commit definition isn't part of the actual
package definition, the current code has no way of updating it. It
would require a rewrite of the edit-in-place logic with probably a lot
of special-casing.
There are currently ~1250 package which use this format, though, so it
could be worth it... Perhaps what we actually need is a better idiom to
express this situation. Package properties ('git-commit)? A 'git-version*'?
--8<---------------cut here---------------start------------->8---
(define (git-version* version revision)
(let* ((source (package-source this-package))
(commit (git-reference-commit (origin-uri source))))
(git-version version revision commit)))
--8<---------------cut here---------------end--------------->8---
I'm not sure if binding order would be an issue with that.
> and (b)
>
> (define-public gnash
> (package
> (name "gnash")
> (version "0.8.11")
> (source (git-reference
> (url "https://example.org")
> (commit commit))
> [...]))
> ?
Is this missing a definition for commit? If it's like above, the same
applies. Or if you mean
--8<---------------cut here---------------start------------->8---
(source (git-reference
(url "https://example.org")
(commit "583ccbc1275c7701dc4843ec12142ff86bb305b"))
--8<---------------cut here---------------end--------------->8---
Then that wouldn't be too hard to support. There seem to be ~136
packages with this idiom.
> (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 <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)))))))
Aha! This is actually what should be done, having the updater put the
git-reference into upstream-source, since the updater is going to know
better how to manipulate the uri.
> +
> +(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)
Is it possible for an updater to want to return a list of
<git-reference>? I'm still not sure what the purpose of multiple urls
is, since nearly everthing seems to just take (first 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))))))
What is this 'upstream-source-compiler' actually used for? I couldn't
figure that out, so I just left it untouched.
>
> +(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)))
Thanks for sharing your work; it was very helpful!
--
Sarah
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.