diff mbox series

[bug#50072,WIP,4/4] upstream: Support updating git-fetch origins.

Message ID cbcef388b1df20c24b6615a006c0daaf50f74b1f.camel@telenet.be
State Accepted
Headers show
Series None | expand

Commit Message

M Aug. 16, 2021, 10:46 a.m. UTC
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.

Comments

Xinglu Chen Aug. 16, 2021, 1:02 p.m. UTC | #1
On Mon, Aug 16 2021, Maxime Devos wrote:

> 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")

IIUC, it only supports GitHub URLs at the moment.  I have a WIP patch
for adding support for any arbitrary Git repository[1].

[1]:
<https://git.yoctocell.xyz/guix/commit/?h=guix-upstream-git-fetch&id=0356c7603a4611d40875b4eb352e3378295f34bc>
M Aug. 16, 2021, 6:15 p.m. UTC | #2
Xinglu Chen schreef op ma 16-08-2021 om 15:02 [+0200]:
> On Mon, Aug 16 2021, Maxime Devos wrote:
> 
> > 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")
> 
> IIUC, it only supports GitHub URLs at the moment.  I have a WIP patch
> for adding support for any arbitrary Git repository[1].

This patch series doesn't mention GitHub anywhere (except in the patch
series description) so I don't think it only supports GitHub URLs.
Admittedly, only one updater, "github", currently produces git-reference
URLs, but I sent a patch series [2] that adds an importer which produces
git-reference URLs and the corresponding updater (see ‘git-fetch.patch’)
produces appropriate git-reference objects.

[2]: <https://issues.guix.gnu.org/49828#51>.

Greetings,
Maxime.
Sarah Morgensen Aug. 16, 2021, 7:56 p.m. UTC | #3
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
M Aug. 17, 2021, 10:18 a.m. UTC | #4
Sarah Morgensen schreef op ma 16-08-2021 om 12:56 [-0700]:
> 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.

Perhaps a 'surrounding-expression-location' procedure can be defined?

(define (surrounding-expression-location inner-location)
  "Determine the location of the S-expression that surrounds the S-expression
at INNER-LOCATION, or #false if the inner S-expression is at the top-level."
  ??? Something like 'read', but in reverse, maybe?
  Doesn't need to support every construct, just "string without escapes" and
  (parentheses other-things) might be good enough in practice for now)

Seems tricky to implement, but it would be more robust than relying
on conventions like ‘the surrounding 'let' can be found by moving two columns
and two lines backwards’.  Or see another method (let&) below that is actually
implemented ...

> 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.

The 'file-name' field of 'origin' is not thunked, and refers to the 'version'
field of the 'package' (also not thunked).  If 'version' would use the 'git-version*'
from above, then there would be a loop (I'm having the 'gnash' package in mind,
see "guix edit gnash").  And git-version* cannot be a procedure, it must be a macro,
as it used 'this-package', which can only be expanded inside a package definition.

Alternatively, what do you think of a let& macro, that adjusts the inner expression
to have the source location of the 'let&' form:

(define-syntax with-source-location
  (lambda (s)
    (syntax-case s ()
      ((_ (exp . exp*) source)
       "Expand to (EXP . EXP*), but with the source location replaced
by the source location of SOURCE."
       (datum->syntax s (cons #'exp #'exp*) #:source (syntax-source #'source))))))

(define-syntax let&
  (lambda (s)
    "Like 'let', but let the inner expression have the location
of the 'let&' form when it is expanded.  Only a single inner
expression is allowed."
    (syntax-case s ()
      ((_ bindings exp)
       #'(let bindings
           (with-source-location exp s))))))

That way, 'update-package-source' doesn't need to know about the surrounding
'let' form; it would simply use 'edit-expression' as usual (though something
like

                                    ,@(if (and old-commit new-commit)
                                          `((,old-commit . ,new-commit))
                                          '())

would need to be added, and something to replace ‘(revision "N")’ with
‘(revision "N+1")’.)

A complete example is attached (a.scm).  The previous usages of
(let ((commit ...) (revision ...)) ...) would need to be adjusted
to use let& instead (build-aux/update-guix-package.scm needs to
be adjusted as well).

Personally, I'd go with the 'let&' form

> > 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---

The latter.

> Then that wouldn't be too hard to support.  There seem to be ~136
> packages with this idiom.

FWIW, the patch I sent modified 'update-package-source' to replace
the commit in this case (b) (but not case (a)).

> > [the patch Maxime sent]
> > 
> >    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>?

No, 'git-fetch' from (guix git-download) only accepts a single <git-reference>
object, it doesn't support lists of <git-reference>.  It will throw a type
error if a list is passed.  Compare with 'url-fetch*', which does accept a list
of URLs (in which case it will fall-back to the second, the third, the fourth ...
entry when the first entry gives a 404 or something).

>   I'm still not sure what the purpose of multiple urls
> is, since nearly everthing seems to just take (first urls)...

As I understand it, the second, third, fourth ... URL (when using url-fetch)
are fall-backs.  Also, (guix upstream) sometimes distinguishes between the
different URLs, see e.g. package-update/url-fetch, which will try to choose a
tarball with the same kind of extension (.zip, .tar.gz, .tar.xz, ...) as the original
URI.

> >    (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.

It is used to ‘lower’ <upstream-source> objects.  More specifically,
transform-package-latest from (guix transformations) will sometimes
replace the 'source' of a package with a <upstream-source> object,
and 'upstream-source-compiler' is used to turn the <upstream-source>
into a (fixed-output) derivation that can be built into a
/gnu/store/...-checkout or /gnu/store/...-version.tar.gz file in the store.

Greetings,
Maxime
Xinglu Chen Aug. 18, 2021, 2:45 p.m. UTC | #5
On Mon, Aug 16 2021, Maxime Devos wrote:

> Xinglu Chen schreef op ma 16-08-2021 om 15:02 [+0200]:
>> On Mon, Aug 16 2021, Maxime Devos wrote:
>> 
>> > 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")
>> 
>> IIUC, it only supports GitHub URLs at the moment.  I have a WIP patch
>> for adding support for any arbitrary Git repository[1].
>
> This patch series doesn't mention GitHub anywhere (except in the patch
> series description) so I don't think it only supports GitHub URLs.
> Admittedly, only one updater, "github", currently produces git-reference
> URLs,

That was what I was referring to, sorry for not making it clearer.

Only the ‘github’ updater can update ‘git-fetch’ origins;
=> only GitHub URLs can are recognized by the ‘github’ updater;
=> thus, only packages hosted on GitHub can be updated.

> but I sent a patch series [2] that adds an importer which produces
> git-reference URLs and the corresponding updater (see ‘git-fetch.patch’)
> produces appropriate git-reference objects.
>
> [2]: <https://issues.guix.gnu.org/49828#51>.

I haven’t looked at the patches yet, but that looks very cool!  :-)
M Aug. 30, 2021, 9:36 p.m. UTC | #6
Maxime Devos schreef op di 17-08-2021 om 12:18 [+0200]:
> [... stuff about let&, let*&, supporting packages like:
> > > (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)))
> > >       [...])))
> > ...
> ... by fudging the source locations ...]

I went ahead and send a patch replacing 'let' with 'let&':
<https://issues.guix.gnu.org/50286>.

Greetings,
Maxime.
Ludovic Courtès Sept. 6, 2021, 10:23 a.m. UTC | #7
Hi,

Maxime Devos <maximedevos@telenet.be> skribis:

> Sarah Morgensen schreef op ma 16-08-2021 om 12:56 [-0700]:
>> 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.
>
> Perhaps a 'surrounding-expression-location' procedure can be defined?
>
> (define (surrounding-expression-location inner-location)
>   "Determine the location of the S-expression that surrounds the S-expression
> at INNER-LOCATION, or #false if the inner S-expression is at the top-level."
>   ??? Something like 'read', but in reverse, maybe?
>   Doesn't need to support every construct, just "string without escapes" and
>   (parentheses other-things) might be good enough in practice for now)
>
> Seems tricky to implement, but it would be more robust than relying
> on conventions like ‘the surrounding 'let' can be found by moving two columns
> and two lines backwards’.  Or see another method (let&) below that is actually
> implemented ...

I think we can work incrementally.  It wouldn’t be unreasonable to start
with a ‘definition-location’ procedure that would work in a way similar
to ‘package-field-location’ (essentially ‘read’ each top-level sexp of
the file and record the location of the one that immediately precedes
the package location.)

But maybe the discussion in <https://issues.guix.gnu.org/50286> will
give us something nice.

Thanks,
Ludo’.
M Sept. 6, 2021, 11:47 a.m. UTC | #8
Hi,

Ludovic Courtès schreef op ma 06-09-2021 om 12:23 [+0200]:
> > > > 
> > > > [...]
> > > > 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.
> > 
> > Perhaps a 'surrounding-expression-location' procedure can be defined?
> > 
> > (define (surrounding-expression-location inner-location)
> >   "Determine the location of the S-expression that surrounds the S-expression
> > at INNER-LOCATION, or #false if the inner S-expression is at the top-level."
> >   ??? Something like 'read', but in reverse, maybe?
> >   Doesn't need to support every construct, just "string without escapes" and
> >   (parentheses other-things) might be good enough in practice for now)
> > 
> > Seems tricky to implement, but it would be more robust than relying
> > on conventions like ‘the surrounding 'let' can be found by moving two columns
> > and two lines backwards’.  Or see another method (let&) below that is actually
> > implemented ...
> 
> I think we can work incrementally.  It wouldn’t be unreasonable to start
> with a ‘definition-location’ procedure that would work in a way similar
> to ‘package-field-location’ (essentially ‘read’ each top-level sexp of
> the file and record the location of the one that immediately precedes
> the package location.)

‘package-field-location’ (currently) doesn't work like that.  Currently,
it extracts the location from the package, opens the file, uses a procedure
'goto' that works like 'seek' except that it accepts line and column numbers
instead of byte offsets.

What you proposed could work, though it seems a bit inefficient to me.
Asking upstream for an update probably takes a lot more time though.

> But maybe the discussion in <https://issues.guix.gnu.org/50286> will
> give us something nice.

Greetings,
Maxime
Sarah Morgensen Sept. 7, 2021, 1:16 a.m. UTC | #9
Hi Maxime,

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)))
>       [...])))

Thinking about this again, since updaters typically returns actual
versions (tags) instead of commits, how much would such a
feature be used?

OTOH, I could definitely see use for an ability to update packages like
these to proper versions (removing the surrounding 'let') but that's
probably more rare and may not be worth the implementation effort.

--
SEarah
M Sept. 7, 2021, 10 a.m. UTC | #10
Sarah Morgensen schreef op ma 06-09-2021 om 18:16 [-0700]:
> Hi Maxime,
> 
> 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)))
> >       [...])))
> 
> Thinking about this again, since updaters typically returns actual
> versions (tags) instead of commits, how much would such a
> feature be used?

The minetest updater returns version numbers.
It also returns a git-reference object, which includes the commit.
Just returning a version number often isn't sufficient,
because many repositories of minetest mods do not keep version tags.

See <https://issues.guix.gnu.org/50072#5>.

Greetings,
Maxime.
Sarah Morgensen Sept. 7, 2021, 5:51 p.m. UTC | #11
Hi,

Maxime Devos <maximedevos@telenet.be> writes:

> Sarah Morgensen schreef op ma 06-09-2021 om 18:16 [-0700]:
>> Hi Maxime,
>> 
>> 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)))
>> >       [...])))
>> 
>> Thinking about this again, since updaters typically returns actual
>> versions (tags) instead of commits, how much would such a
>> feature be used?
>
> The minetest updater returns version numbers.
> It also returns a git-reference object, which includes the commit.
> Just returning a version number often isn't sufficient,
> because many repositories of minetest mods do not keep version tags.

Thanks for the explanation.

So there is a version number indicated elsewhere than in the tags for
some minetest packages?  (Is this data in the package's git repo or in
e.g. minetest repo metadata?)  That is, the minetest updater always uses
"blessed versions" (not just random commits), such that "revision" will
always be "0"?

Are current minetest packages like this formatted like 'gnash' above?

> See <https://issues.guix.gnu.org/50072#5>.

That's the message I quoted ;)

--
Sarah
M Sept. 7, 2021, 8:58 p.m. UTC | #12
Sarah Morgensen schreef op di 07-09-2021 om 10:51 [-0700]:
> So there is a version number indicated elsewhere than in the tags for
> some minetest packages?  (Is this data in the package's git repo or in
> e.g. minetest repo metadata?)  That is, the minetest updater always uses
> "blessed versions" (not just random commits), such that "revision" will
> always be "0"?

The minetest importer looks at ContentDB.  E.g., for Jeija/mesecons:
https://content.minetest.net/packages/Jeija/mesecons/.  It doesn't look
at git tags at all.  It only clones the git repository to compute the hash.

Strictly speaking, ContentDB only has ‘release titles’, and not ‘version numbers’.
Release titles are usually version numbers or dates.  In the former case, all is
well.  In the latter case, there isn't much the importer/updater can do about that,
so it will use the date even though it isn't a ‘proper version number’.

Releases on ContentDB are ordered.  The importer and refresher always use the
latest release, not some random commit.  ContentDB has a mapping from releases
to their commits, which the importer and refresher uses.

So, yes, there are ‘blessed versions’.  However, due to particularities of how
minetest mods are released, revision won't always be 0, because there are
minetest mods that make a new release on ContentDB without a corresponding
version bump (e.g. minetest-ethereal, minetest-mesecons, minetest-throwing,
minetest-throwing-arrows).

> Are current minetest packages like this formatted like 'gnash' above?

About a third are formatted like 'gnash' (let ((commit ...) (revision ...)) ...)).

Greetings,
Maxime
diff mbox series

Patch

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)))