Subject: bug#50359: closed (Re: [PATCH v3 0/3] Add 'generic-git' updater)

From: [email-masked] (GNU bug Tracking System)
Date: Sat, 18 Sep 2021 17:48:02 +0000

Your bug report

#50359: [PATCH] import: Add 'generic-git' updater.

which was filed against the guix-patches package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
50359: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=50359
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: [PATCH v3 0/3] Add 'generic-git' updater
From: Ludovic Courtès <[email-masked]>
To: Xinglu Chen <[email-masked]>
Cc: Sarah Morgensen <[email-masked]>, [email-masked]
Date: Sat, 18 Sep 2021 19:47:34 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

Hello!

Xinglu Chen <[email-masked]> skribis:

> Changes since v2:
>
> * Address the feedback by Ludovic and Sarah.
>
> One problem I noticed was that when ‘accept-pre-releases?’ is #t, a tag
> like “1-2-3-alpha” would turn into “1.2.3.alpha”, but I think the
> correct version string would be “1.2.3-alpha”.
>
> I solved the problem by making the pre-release part a separate regexp
> group, and then appending the pre-release part after extracting the
> version from the tag.  That way, the “-” in “-alpha” would not be
> interpreted as a version delimiter.  I also added a new test for testing
> this.

I think that’s fine; this is all guesswork anyway, and there are always
cases where we’ll get it wrong.  What’s useful though is tests to guard
against regressions in the heuristics.

> One of the tests in tests/channels.scm is failing; I am not sure why.
> Before the first and second patches were applied, 6 of them were failing
> for me, so I guess it’s an improvement.  However, on IRC, Ludovic said
> that all of them were passing (prior to apply my patches).  It would
> be great if people could run the tests before and after applying
> patches, and see if they pass.

Turns out that the failure in tests/channels.scm was a real bug:
‘channel-news-entry-commit’ was not resolving annotated tags correctly
(it would return the ID of the tag instead of the ID of the commit
pointed to by the tag).  Fixed in
778c1fb4eabbb48c05f6c7555c89466d5249ebce.

>   tests: git: Don't read from the users global Git config file.
>   tests: git: Make 'tag' directive non-interactive.
>   import: Add 'generic-git' updater.

Applied!  I changed the second patch to preserve support for
non-annotated tags and to leave tests/channels.scm unchanged.

BTW, “git tag xyz” is not interactive AFAICS.

Thanks Sarah & Xinglu for this work!  Let’s update our packages!  :-)

Ludo’.

Subject: [PATCH] import: Add 'generic-git' updater.
From: Xinglu Chen <[email-masked]>
To: [email-masked]
Date: Fri, 03 Sep 2021 17:50:56 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

* guix/import/git.scm: New file.
* doc/guix.texi (Invoking guix refresh): Document it.
* Makefile.am (MODULES): Register it.
---
This patch adds a new ‘generic-git’ updater which can check for new tags
for package hosted on Git repos.  However, it cannot download Git repos
and update the package definitions, i.e. ‘guix refresh -u’.  There is a
pending patch that would add this feature though[1].

‘guix refresh -L’ now reports

  Available updaters:
  […]
  94.5% of the packages are covered by these updaters.

We are getting close to 100% :-)

See it in action!

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env guix refresh harmonist scdoc gmnisrv
gnu/packages/web.scm:7931:4: warning: no tags were found for package `gmnisrv'
gnu/packages/web.scm:7931:4: warning: 'generic-git' updater failed to determine available releases for gmnisrv
gnu/packages/man.scm:339:12: scdoc would be upgraded from 1.10.1 to 1.11.1
gnu/packages/games.scm:9433:2: warning: failed to fetch Git repository for package `harmonist'
gnu/packages/games.scm:9433:2: warning: 'generic-git' updater failed to determine available releases for harmonist
--8<---------------cut here---------------end--------------->8---
  
[1]: <https://issues.guix.gnu.org/50072>

 Makefile.am         |   1 +
 doc/guix.texi       |  27 ++++++
 guix/import/git.scm | 223 ++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 251 insertions(+)
 create mode 100644 guix/import/git.scm

diff --git a/Makefile.am b/Makefile.am
index 3c79760734..c4d3a456b1 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -254,6 +254,7 @@ MODULES =					\
   guix/import/egg.scm   			\
   guix/import/elpa.scm   			\
   guix/import/gem.scm				\
+  guix/import/git.scm                           \
   guix/import/github.scm   			\
   guix/import/gnome.scm				\
   guix/import/gnu.scm				\
diff --git a/doc/guix.texi b/doc/guix.texi
index 36a0c7f5ec..26afb1607a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11920,6 +11920,33 @@ the updater for @uref{https://launchpad.net, Launchpad} packages.
 @item generic-html
 a generic updater that crawls the HTML page where the source tarball of
 the package is hosted, when applicable.
+@item generic-git
+a generic updater for packages hosted on Git repositories.  It tries to
+be smart about parsing Git tag names, but if it is not able to parse the
+tag name and compare tags correctly, users can define the following
+properties for a package.
+
+@itemize
+@item @code{tag-prefix}: a regular expression for matching a prefix of
+the tag name.
+
+@item @code{tag-suffix}: a regular expression for matching a suffix of
+the tag name.
+
+@item @code{tag-version-delimiter}: a string used as the delimiter in
+the tag name for separating the numbers of the version.
+@end itemize
+
+@lisp
+(package
+  (name "foo")
+  ;; ...
+  (properties
+    '((tag-prefix . "^release0-")
+      (tag-suffix . "[a-z]?$")
+      (tag-version-delimiter . ":"))))
+@end lisp      
+
 @end table
 
 For instance, the following command only checks for updates of Emacs
diff --git a/guix/import/git.scm b/guix/import/git.scm
new file mode 100644
index 0000000000..9a654c1972
--- /dev/null
+++ b/guix/import/git.scm
@@ -0,0 +1,223 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <[email-masked]>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import git)
+  #:use-module (git)
+  #:use-module (guix build utils)
+  #:use-module (guix diagnostics)
+  #:use-module (guix git)
+  #:use-module (guix git-download)
+  #:use-module (guix i18n)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix utils)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-28)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
+  #:export (%generic-git-updater))
+
+;;; Commentary:
+;;;
+;;; This module provides a generic package updater for packages hosted on Git
+;;; repositories.
+;;;
+;;; It tries to be smart about tag names, but if it is not automatically able
+;;; to parse the tag names correctly, users can set the `tag-prefix',
+;;; `tag-suffix' and `tag-version-delimiter' properties of the package to make
+;;; the updater parse the Git tag name correctly.
+;;;
+;;; Code:
+
+;;; Errors & warnings
+
+(define-condition-type &git-tag-error &error
+  git-tag-error?
+  (kind git-tag-error-kind))
+
+(define (git-tag-error kind)
+  (raise (condition (&message (message (format "bad `~a' property")))
+                    (&git-tag-error
+                     (kind kind)))))
+
+(define (git-tag-warning package c)
+  (warning (package-location package)
+           (G_ "~a for package `~a'~%")
+           (condition-message c)
+           (package-name package)))
+
+(define-condition-type &git-no-tags-error &error
+  git-no-tags-error?)
+
+(define (git-no-tags-error)
+  (raise (condition (&message (message "no tags were found"))
+                    (&git-no-tags-error))))
+
+(define (git-no-tags-warning package c)
+  (warning (package-location package)
+           (G_ "~a for package `~a'~%")
+           (condition-message c)
+           (package-name package)))
+
+(define (git-fetch-warning package)
+  (warning (package-location package)
+           (G_ "failed to fetch Git repository for package `~a'~%")
+           (package-name package)))
+
+
+;;; Helper functions
+
+(define (string-split* str delim)
+  "Like `string-split', but DELIM is a string instead of a
+char-set."
+  (filter (lambda (str) (not (equal? str "")))
+          (string-split str (string->char-set delim))))
+
+(define* (get-version package tag #:key prefix suffix delim)
+  (define delim* (if delim delim "."))
+  (define prefix-regexp "^[^0-9]*")
+  (define suffix-regexp (string-append "[^0-9" (regexp-quote delim*) "]*$"))
+  (define delim-regexp (string-append "^[0-9]+" (regexp-quote delim*) "[0-9]+"))
+
+  (define no-prefix
+    (let ((match (string-match (or prefix prefix-regexp) tag)))
+      (if match
+          (regexp-substitute #f match 'post)
+          (git-tag-error 'tag-prefix))))
+
+  (define no-suffix
+    (let ((match (string-match (or suffix suffix-regexp) no-prefix)))
+      (if match
+          (regexp-substitute #f match 'pre)
+          (git-tag-error 'tag-suffix))))
+
+  (define no-delims
+    (if (string-match delim-regexp no-suffix)
+        (string-split* no-suffix delim*)
+        (git-tag-error 'tag-version-delimiter)))
+
+  (string-join no-delims "."))
+
+(define (sort-tags tags)
+  "Sort TAGS, a list if Git tags, such that the latest tag is the last element."
+  (sort tags (lambda (a b)
+               (eq? (version-compare a b) '<))))
+
+
+;;; Updater
+
+(define (get-remote url git-uri)
+  "Given a URL and GIT-URI, a <git-reference> record, return the ``origin'' remote."
+  (let* ((checkout (update-cached-checkout url
+                                           #:recursive?
+                                           (git-reference-recursive? git-uri)))
+         (repository (repository-open checkout)))
+    (remote-lookup repository "origin")))
+
+(define (get-latest-tag remote)
+  "Given a Git REMOTE, return that latest tag available."
+  (remote-connect remote)
+
+  (define tags
+    (sort-tags
+     (map (lambda (tag)
+            (string-drop tag (string-length "refs/tags/")))
+          (filter (lambda (ref)
+                    ;; Every tag has two refs:
+                    ;;
+                    ;; * refs/tags/1.2.3^{}
+                    ;; * refs/tags/1.2.3
+                    ;;
+                    ;; remove the one with the trailing ^{}
+                    (and (not (string-suffix? "^{}" ref))
+                         (string-prefix? "refs/tags/" ref)))
+                  (map (lambda (remote-head)
+                         (remote-head-name remote-head))
+                       (remote-ls remote))))))
+
+  (remote-disconnect remote)
+
+  (if (null? tags)
+      (git-no-tags-error)
+      (last tags)))
+
+(define (latest-git-tag-version package tag-prefix tag-suffix
+                                tag-version-delimiter)
+  "Given a PACKAGE, the TAG-PREFIX, TAG-SUFFIX, and TAG-VERSION-DELIMITER
+properties of PACKAGE, returns the latest version of PACKAGE."
+  (guard (c ((eq? (exception-kind c) 'git-error)
+             (git-fetch-warning package)
+             #f)
+            ((git-tag-error? c)
+             (git-tag-warning package c)
+             #f)
+            ((git-no-tags-error? c)
+             (git-no-tags-warning package c)
+             #f))
+    (let* ((source (package-source package))
+           (git-uri (origin-uri source))
+           (url (git-reference-url (origin-uri source)))
+           (remote (get-remote url git-uri))
+           (latest-tag (get-latest-tag remote)))
+      (get-version package
+                   latest-tag
+                   #:prefix tag-prefix
+                   #:suffix tag-suffix
+                   #:delim tag-version-delimiter))))
+
+(define (git-package? package)
+  "Whether the origin of PACKAGE is a Git repostiory."
+  (match (package-source package)
+    ((? origin? origin)
+     (and (eq? (origin-method origin) git-fetch)
+          (git-reference? (origin-uri origin))))
+    (_ #f)))
+
+(define (latest-git-release package)
+  "Return the latest release of PACKAGE."
+  (let* ((name (package-name package))
+         (properties (package-properties package))
+         (tag-prefix (assq-ref properties 'tag-prefix))
+         (tag-suffix (assq-ref properties 'tag-suffix))
+         (tag-version-delimiter (assq-ref properties 'tag-version-delimiter))
+         (old-version (package-version package))
+         (url (git-reference-url (origin-uri (package-source package))))
+         (new-version (latest-git-tag-version package
+                                              tag-prefix
+                                              tag-suffix
+                                              tag-version-delimiter)))
+
+    (if new-version
+        (upstream-source
+         (package name)
+         (version new-version)
+         (urls (list url)))
+        ;; No new release or no tags available.
+        #f)))
+
+(define %generic-git-updater
+  (upstream-updater
+   (name 'generic-git)
+   (description "Updater for packages hosted on Git repositories")
+   (pred git-package?)
+   (latest latest-git-release)))

base-commit: 9540323458de87b0b8aa421e449a4fe27af7c393
-- 
2.33.0