From debbugs-submit-bounces@debbugs.gnu.org Sun Feb 06 08:00:50 2022 Received: (at 53818) by debbugs.gnu.org; 6 Feb 2022 13:00:50 +0000 Received: from localhost ([127.0.0.1]:36738 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nGh9r-0006qp-3P for submit@debbugs.gnu.org; Sun, 06 Feb 2022 08:00:50 -0500 Received: from h178-251-242-94.cust.a3fiber.se ([178.251.242.94]:59566 helo=mail.yoctocell.xyz) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nGh9p-0006qY-Je for 53818@debbugs.gnu.org; Sun, 06 Feb 2022 08:00:46 -0500 From: Xinglu Chen DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=yoctocell.xyz; s=mail; t=1644152438; bh=S5OekjJ2N4vruz0JVpeRRmwYuEgUgM5YHEZ0vPFbk88=; h=From:To:Subject:In-Reply-To:References:Date; b=d6vc96Bg90kUnxzVrd88UV0Uof3XSk7jOPXDv9ZRH48GYnq0oYLIZqZGSznx50LIz EQonpbq3z63nUK++Rw5a6soxGkrs76uiiTA+Ysd4Isn9v3qoOrc6xXmBqYCrjHGoHm Kmae7aKVg6CO5Pmck/ngK6vIMxw7845rbdsC6HIA= To: 53818@debbugs.gnu.org Subject: [PATCH 2/3] import: Add 'repology' updater. In-Reply-To: References: Message-Id: <88f866aff65c0ec9611b6cc0ee9d680ba711df38.1644147246.git.public@yoctocell.xyz> Date: Sun, 06 Feb 2022 14:00:37 +0100 MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: 2.5 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: * guix/import/repology.scm * tests/import-repology.scm: New files. * Makefile.am (MODULES): Register them. * doc/guix.texi (Invoking guix refresh): Document it. --- Makefile.am | 3 + doc/guix.texi | 7 [...] Content analysis details: (2.5 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 SPF_PASS SPF: sender matches SPF record 0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record 1.6 PDS_OTHER_BAD_TLD Untrustworthy TLDs [URI: yoctocell.xyz (xyz)] 0.4 RDNS_DYNAMIC Delivered to internal network by host with dynamic-looking rDNS 0.5 FROM_SUSPICIOUS_NTLD From abused NTLD -0.0 T_SCC_BODY_TEXT_LINE No description available. 0.0 PDS_RDNS_DYNAMIC_FP RDNS_DYNAMIC with FP steps X-Debbugs-Envelope-To: 53818 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 1.5 (+) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: * guix/import/repology.scm * tests/import-repology.scm: New files. * Makefile.am (MODULES): Register them. * doc/guix.texi (Invoking guix refresh): Document it. --- Makefile.am | 3 + doc/guix.texi | 7 [...] Content analysis details: (1.5 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 SPF_PASS SPF: sender matches SPF record 0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record 1.6 PDS_OTHER_BAD_TLD Untrustworthy TLDs [URI: yoctocell.xyz (xyz)] 0.4 RDNS_DYNAMIC Delivered to internal network by host with dynamic-looking rDNS 0.5 FROM_SUSPICIOUS_NTLD From abused NTLD -0.0 T_SCC_BODY_TEXT_LINE No description available. -1.0 MAILING_LIST_MULTI Multiple indicators imply a widely-seen list manager 0.0 PDS_RDNS_DYNAMIC_FP RDNS_DYNAMIC with FP steps * guix/import/repology.scm * tests/import-repology.scm: New files. * Makefile.am (MODULES): Register them. * doc/guix.texi (Invoking guix refresh): Document it. --- Makefile.am | 3 + doc/guix.texi | 7 ++ guix/import/repology.scm | 226 ++++++++++++++++++++++++++++++++++++++ tests/import-repology.scm | 145 ++++++++++++++++++++++++ 4 files changed, 381 insertions(+) create mode 100644 guix/import/repology.scm create mode 100644 tests/import-repology.scm diff --git a/Makefile.am b/Makefile.am index 7463606d20..6792917b59 100644 --- a/Makefile.am +++ b/Makefile.am @@ -16,6 +16,7 @@ # Copyright =C2=A9 2019 Efraim Flashner # Copyright =C2=A9 2021 Chris Marusich # Copyright =C2=A9 2021 Andrew Tropin +# Copyright =C2=A9 2022 Xinglu Chen # # This file is part of GNU Guix. # @@ -271,6 +272,7 @@ MODULES =3D \ guix/import/opam.scm \ guix/import/print.scm \ guix/import/pypi.scm \ + guix/import/repology.scm \ guix/import/stackage.scm \ guix/import/texlive.scm \ guix/import/utils.scm \ @@ -488,6 +490,7 @@ SCM_TESTS =3D \ tests/home-import.scm \ tests/import-git.scm \ tests/import-github.scm \ + tests/import-repology.scm \ tests/import-utils.scm \ tests/inferior.scm \ tests/lint.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 0cf865a672..15d215dd48 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12932,6 +12932,13 @@ (release-tag-version-delimiter . ":")))) @end lisp =20 +@item repology +an updater that scans @uref{https://repology.org, Repology}, a website +that tracks packages on various package repositories, for updates. + +The name of a package in Guix is not always that same as the name on +Repology; users can set the @code{repology-name} package property to +make the updater use the correct name. =20 @end table =20 diff --git a/guix/import/repology.scm b/guix/import/repology.scm new file mode 100644 index 0000000000..1d88022c1d --- /dev/null +++ b/guix/import/repology.scm @@ -0,0 +1,226 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2022 Xinglu Chen +;;; +;;; 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 . + +(define-module (guix import repology) + #:use-module (guix diagnostics) + #:use-module (guix diagnostics) + #:use-module (guix git-download) + #:use-module (guix i18n) + #:use-module (guix import json) + #:use-module (guix import utils) + #:use-module (guix memoization) + #:use-module (guix packages) + #:use-module (guix upstream) + #:use-module (guix utils) + #:use-module (ice-9 match) + #:use-module (json) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-2) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-43) + #:export (repology-latest-release + %repology-updater)) + +;;; Commentary: +;;; +;;; This module provides an updater which scans Repology, a site that moni= tors +;;; several package repolsitories, for updates. This means that if any ot= her +;;; package repository has a version of a package that is newer than the +;;; version in Guix, the package should be able to be updated. The updater +;;; should in theory work for all packages in Guix, but the names of some +;;; packages on Repology don't match the name in Guix. The 'repology-name' +;;; package property can be used to fix this. +;;; +;;; Guix already has many different updaters for language-specific package= s, +;;; and these typically provide more accurate data, e.g., input changes, +;;; signature URLs. The Repology updater should really be treated as a la= st +;;; resort for those packages that don't have any other updater to rely on. +;;; +;;; See for the API. +;;; +;;; Code: + +(define %repology-url + "https://repology.org/api/v1/project") + +(define* (package-name->repology-name name #:key (attempt 1)) + "Convert NAME, the name of a Guix package, to the name of the package on +Repology. It doesn't always guess the correct name on the first attempt, = so +on the second attempt it will try to guess another name." + (match attempt + (1 (cond + ((string-prefix? "ghc-" name) + (string-append "haskell:" + (string-drop name (string-length "ghc-")))) + ((string-prefix? "ocaml-" name) + (string-append "ocaml:" + (string-drop name (string-length "ocaml-")))) + ((string-prefix? "perl-" name) + (string-append "perl:" + (string-drop name (string-length "perl-")))) + ((string-prefix? "emacs-" name) + (string-append "emacs:" + (string-drop name (string-length "emacs-")))) + ((string-prefix? "go-" name) + (string-append "go:" + (string-drop name (string-length "go-")))) + ((string-prefix? "rust-" name) + (string-append "rust:" + (string-drop name (string-length "rust-")))) + ((string-prefix? "lua-" name) + (string-append "lua:" + (string-drop name (string-length "lua-")))) + ((string-prefix? "node-" name) + (string-append "node:" + (string-drop name (string-length "node-")))) + ((string-prefix? "python-" name) + (string-append "python:" + (string-drop name (string-length "python-")))) + ((string-prefix? "java-" name) + (string-append "java:" + (string-drop name (string-length "java-")))) + ((string-prefix? "r-" name) + (string-append "r:" + (string-drop name (string-length "r-")))) + ((string-prefix? "ruby-" name) + (string-append "ruby:" + (string-drop name (string-length "ruby-")))) + ((string-prefix? "xf86-" name) + (string-append "xdrv:" + (string-drop name (string-length "xf86-")))) + ((string-prefix? "font-" name) + (string-append "fonts:" + (string-drop name (string-length "font-")))) + (else name))) + (2 (cond + ((string-prefix? "xf86-video" name) + (string-append "xdrv:" + (string-drop name (string-length "xf86-video-")))) + ((string-prefix? "xf86-input" name) + (string-append "xdrv:" + (string-drop name (string-length "xf86-input-")))) + (else name)))))=20=20 + + +;;; JSON mappings. + +(define-json-mapping make-repology-package + repology-package? + json->repology-package + (repository repology-package-repository "repo") + (src-name repology-package-src-name "srcname") + (binary-name repology-package-binary-name "binname") + (visible-name repology-package-visible-name "visiblename") + (version repology-package-version) + (original-version repology-package-original-version "origversion") + (status repology-package-status) + (summary repology-package-summary) + (categories repology-package-categories) + (licenses repology-package-licenses) + (maintainers repology-package-maintainers)) + + +;;; Updater. + +(define repology-fetch-info + (memoize + (lambda (package) + "Fetch information about PACKAGE using the Repology API." + (define (name->info name ) + (let ((url (string-append %repology-url "/" name))) + (and=3D> (json-fetch url) + (lambda (url) + (vector-map (lambda (a b) + (json->repology-package b)) + url))))) +=20=20=20=20=20 + (let* ((name (or (assoc-ref (package-properties package) + 'repology-name) + (package-name->repology-name (package-name package))= )) + (info (name->info name))) + (if (and info (not (vector-empty? info))) + info + (let ((info (name->info (package-name->repology-name + (package-name package) + #:attempt 2)))) + (if (and info (not (vector-empty? info))) + info + (begin + (warning (G_ "package not found on Repology: ~a\n") + (package-name package)) + #f)))))))) + +(define (update-url url old-version new-version) + "Replace OLD-VERSION in URL with NEW-VERSION." + (match (factorize-uri url old-version) + ((? string? uri) #f) + ((factorized ...) + (apply string-append + (map (lambda (component) + (match component + ('version new-version) + ((? string?) component))) + factorized))))) + +(define (package-source-urls package version) + "Return a list of URLs for PACKAGE at VERSION. If no URL was successful= ly constructed, return #f." + (let ((old-version (package-version package))) + ;; XXX: (guix upstream) only supports tarballs and Git repos for now. + (match (origin-uri (package-source package)) + (($ url commit recursive?) + (and-let* ((updated-commit (if (string=3D? old-version commit) + version + (update-url commit old-version versi= on)))) + (list (git-reference + (url url) + (commit updated-commit) + (recursive? recursive?))))) + ((? string? url) + (list (update-url url old-version version))) + ((? list? urls) + (map (cut update-url <> old-version version) urls)) + (_ #f)))) + +(define (stable-version? repology-package) + (and (or (equal? "newest" (repology-package-status repology-package)) + (equal? "unique" (repology-package-status repology-package))) + (repology-package-version repology-package))) + +;; XXX: 'package' will clash with the 'package' field of 'upstream-source'. +(define (repology-latest-release pkg) + "Return the latest release of the PKG on Repology named NAME." + (and-let* ((packages (repology-fetch-info pkg)) + (versions (filter-map stable-version? + (vector->list packages))) + (latest-version (if (null? versions) + #f + (car versions)))) + ;; TODO: set 'signature-urls'. + (upstream-source + (package (package-name pkg)) + (version latest-version) + (urls (package-source-urls pkg latest-version))))) + +(define %repology-updater +(upstream-updater + (name 'repology) + (description "Updater for packages on Repology") + (pred (const #t)) + (latest repology-latest-release))) + +;;; repology.scm ends here diff --git a/tests/import-repology.scm b/tests/import-repology.scm new file mode 100644 index 0000000000..f95071ce07 --- /dev/null +++ b/tests/import-repology.scm @@ -0,0 +1,145 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2022 Xinglu Chen +;;; +;;; 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 . + +(define-module (test-import-repology) + #:use-module (guix download) + #:use-module (guix git-download) + #:use-module (guix import repology) + #:use-module (guix packages) + #:use-module (guix tests) + #:use-module (guix upstream) + #:use-module (json) + #:use-module (srfi srfi-64)) + +(test-begin "repology") + +(define package-using-git-repository + (dummy-package + "foo" + (version "1.0") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://git.example.org/foo") + (commit "1.0"))) + (sha256 #f))))) + +(define package-using-tarball + (dummy-package + "foo" + (version "1.0") + (source + (origin + (method git-fetch) + (uri (string-append "https://example.org/foo-" version ".tar.gz")) + (sha256 #f))))) + +(define package-using-tarball-multiple-urls + (dummy-package + "foo" + (version "1.0") + (source + (origin + (method git-fetch) + (uri (list (string-append "https://example.org/foo-" + version ".tar.gz") + (string-append "https://mirror.example.org/foo-" + version ".tar.gz"))) + (sha256 #f))))) + +(define %test-json +"[ + { + \"repo\": \"aur\", + \"srcname\": \"foo\", + \"binname\": \"foo\", + \"visiblename\": \"foo\", + \"version\": \"1.0.r25.gb86405a\", + \"maintainers\": [ + \"bob@aur\" + ], + \"licenses\": [ + \"LGPL3+\" + ], + \"summary\": \"foo bar\" + \"status\": \"rolling\", + \"origversion\": \"1.0.r25.gb86405a-1\" + }, + { + \"repo\": \"gnuguix\", + \"srcname\": \"foo\", + \"binname\": \"foo\", + \"visiblename\": \"foo\", + \"version\": \"1.0\", + \"summary\": \"foo bar\", + \"status\": \"outdated\", + \"origversion\": null + }, + { + \"repo\": \"nix_unstable\", + \"name\": \"foo\", + \"visiblename\": \"foo\", + \"version\": \"2.0\", + \"maintainers\": [ + \"bob@example.org\" + ], + \"licenses\": [ + \"LGPL-3.0-or-later\" + ], + \"summary\": \"foo bar\", + \"status\": \"newest\", + \"origversion\": null + } +]") + +(define (latest-release package) + (mock ((guix import json) json-fetch + (lambda (url) + (json-string->scm %test-json))) + (repology-latest-release package))) + +(test-equal "package using Git repo: version" + "2.0" + (upstream-source-version + (latest-release package-using-git-repository))) + +(test-equal "package using Git repo: git-reference" + (list (git-reference + (url "https://git.example.org/foo") + (commit "2.0"))) + (upstream-source-urls + (latest-release package-using-git-repository))) + +(test-equal "package using tarball: version" + "2.0" + (upstream-source-version + (latest-release package-using-tarball))) + +(test-equal "package using tarball: URL" + (list "https://example.org/foo-2.0.tar.gz") + (upstream-source-urls + (latest-release package-using-tarball))) + +(test-equal "package using tarball: multiple URLs" + (list "https://example.org/foo-2.0.tar.gz" + "https://mirror.example.org/foo-2.0.tar.gz") + (upstream-source-urls + (latest-release package-using-tarball-multiple-urls))) + +(test-end "repology") --=20 2.34.1