[bug#50072] [PATCH WIP 0/4] Add upstream updater for git-fetch origins.

[Sarah Morgensen]

Hi Maxime,

Thanks for taking a look at this. :)

Maxime Devos <maximedevos@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