mirror/guix
mirror/guix
1
Fork 0
mirror of https://https.git.savannah.gnu.org/git/guix.git/ synced 2025-07-10 16:50:43 +02:00
Code Releases Activity

refresh: Add support for partial target versions.

Browse source 
* guix/import/utils.scm (find-version): New procedure.
* guix/scripts/refresh.scm (<update-spec>) [partial?]: New field.
(update-spec-partial?): New accessor.
(update-spec): Add a PARTIAL? optional argument.
(update-specification->update-spec) <update-spec>: Call with its new PARTIAL?
optional argument when FALLBACK-VERSION is provided, i.e. when
'--target-version' was used.
(update-package): Remove the PACKAGE and VERSION positional arguments, and
replace them with UPDATE-SPEC.  Update doc.  Call `package-update' with its
new #:partial-version? argument.
(check-for-package-update) <package-latest-release>: Pass the new
 #:partial-version? argument to it.
(guix-refresh) <update-package>: Adjust call accordingly.
(show-help): Udate doc.
* guix/upstream.scm (package-latest-release): Add #:partial-version? argument,
and apply it to the importer call.
(package-update): Add #:partial-version?> argument.  Update doc.  Pass it to
the `package-latest-release' call.
* guix/gnu-maintenance.scm (rewrite-url): Add #:partial-version? argument.
Update doc.  Crawl URL for newer compatible versions when provided.
(import-html-release): Add #:partial-version? argument, and pass it to the
`rewrite-url' call.  Use `find-version' to find the best version.
(import-release, import-ftp-release, import-gnu-release)
(import-release*): Add #:partial-version? argument and honor it.
(import-html-updatable-release): Add #:partial-version? argument, and pass it
to the `import-html-release' call.
* guix/import/gnome.scm (import-gnome-release)
<#:partial-version?>: Add new argument and honor it.
* guix/import/texlive.scm (latest-texlive-tag): Rename to...
(texlive-tags): ... this, and have it return all tags.
(texlive->guix-package): Adjust accordingly.
(latest-release): Add a #:partial-version? argument.  Update doc.
* guix/import/stackage.scm (latest-lts-release): New #:partial-version?
argument.
* guix/import/pypi.scm (import-release): New #:partial-version? argument; pass
it to `pypi-package->upstream-source'.
* guix/import/opam.scm (latest-release): New #:partial-version? argument.
* guix/import/minetest.scm (latest-minetest-release): New #:partial-version?
argument.
(pypi-package->upstream-source): New #:partial-version? argument.  Update doc.
* guix/import/launchpad.scm (latest-released-version): Rename to...
(release-versions): ... this, making it return all versions.
(import-release) <#:partial-version?>: New argument.
* guix/import/kde.scm (import-kde-release)
<#:partial-version?>: New argument.  Update doc.  Refactor to honor argument.
* guix/import/hexpm.scm (lookup-hexpm): Update doc.
(hexpm-latest-release): Rename to...
(hexpm-releases): ... this; return all release strings.
(hexpm->guix-package): Adjust accordingly.
(import-release): Add and honor a #:partial-version? argument.  Update doc.
* guix/import/hackage.scm (import-release): New #:partial-version? argument.
* guix/import/cpan.scm (latest-release): New #:partial-version? argument.
* guix/import/crate.scm (max-crate-version-of-semver): Improve doc.
(import-release): Add a #:partial-version? argument and honor it.
* guix/import/egg.scm (find-latest-version): Rename to...
(get-versions): ... this, returning all versions.
(egg-metadata): Adjust accordingly.
(egg->guix-package): Likewise.
(import-release): Add a new #:partial-version? argument and honor it.
* guix/import/elpa.scm (latest-release):  New #:partial-version? argument.
* guix/import/gem.scm (get-versions): New procedure.
(import-release): Add a new #:partial-version? argument and honor it.
* guix/import/git.scm (version-mapping): Update doc; streamline a bit.
(latest-tag): Rename to...
(get-tags): ... this, dropping the #:version keyword and returning the complete
tags alist.  Update doc.
(latest-git-tag-version): Rename to...
(get-package-tags): ... this, returning the complete tags alist of the
package.  Update doc.
(import-git-release): Add a new #:partial-version? argument and honor it.
Update doc.
* guix/import/github.scm (latest-released-version): Rename to...
(get-package-tags): ... this, returning all tags.  Update doc.
(import-release): Add a new #:partial-version? argument and honor it.
* guix/import/cran.scm (latest-cran-release)
(latest-bioconductor-release): Add #:partial-version? argument.
* guix/import/composer.scm (latest-version): Delete procedure.
(composer-fetch): Add #:partial-version? keyword and honor it.  Update doc.
(import-release): Likewise.
* guix/import/test.scm (import-release): Add #:partial-version? argument.
* tests/guix-refresh.sh: Add test.
* tests/gem.scm (test-foo-versions-json): New variable.
(package-latest-release): Mock new URL.
* tests/import-git.scm (latest-git-tag-version): New procedure.
* tests/gnu-maintenance.scm (libuv-dist-html)
(libuv-dist-1.46.0-html, libuv-dist-1.44.2-html)
(libuv-html-data): New variables.
(mock-http-fetch/cached): New procedure.
("rewrite-url, without to-version"): Rewrite using the above.
("rewrite-url, partial to-version"): New test.
* doc/guix.texi <"Invoking guix refresh">: Update doc.

Series-to: 75871@debbugs.gnu.org
Change-Id: I092a58b57ac42e54a2fa55e7761e8c6993af8ad4
This commit is contained in:
Maxim Cournoyer 2024-11-13 14:21:16 +09:00
parent 79a46d6537
commit f13f076968
No known key found for this signature in database
GPG key ID: 1260E46482E63562
29 changed files with 627 additions and 500 deletions
Download patch file Download diff file Expand all files Collapse all files

12
doc/guix.texi
View file

@ -14975,6 +14975,7 @@ gnu/packages/guile.scm:147:2: guile: updating from version 2.0.10 to version 2.0
@dots{}
@end example
@cindex target version, guix refresh
In some specific cases, you may have many packages specified via a
manifest or a module selection which should all be updated together; for
these cases, the @option{--target-version} option can be provided to have
@ -14995,6 +14996,17 @@ gnu/packages/qt.scm:2070:13: qtquickcontrols2 would be upgraded from 5.15.8 to 5
@dots{}
@end example
@cindex partial target version, guix refresh
The @option{--target-version} option accepts partial version prefixes,
which can be useful to update to the latest major or major-minor
prefixed version:
@example
$ guix refresh qtbase@@5 qtdeclarative@@5 --target-version=5
gnu/packages/qt.scm:1472:13: qtdeclarative would be upgraded from 5.15.8 to 5.15.10
gnu/packages/qt.scm:452:13: qtbase would be upgraded from 5.15.8 to 5.15.10
@end example
Sometimes the upstream name differs from the package name used in Guix,
and @command{guix refresh} needs a little help. Most updaters honor the
@code{upstream-name} property in package definitions, which can be used

118
guix/gnu-maintenance.scm
View file

@ -3,7 +3,7 @@
;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023, 2025 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -44,7 +44,7 @@
#:use-module (guix records)
#:use-module (guix upstream)
#:use-module (guix packages)
#:autoload (guix import utils) (false-if-networking-error)
#:autoload (guix import utils) (false-if-networking-error find-version)
#:autoload (zlib) (call-with-gzip-input-port)
#:autoload (htmlprag) (html->sxml) ;from Guile-Lib
#:export (gnu-package-name
@ -346,12 +346,15 @@ name/directory pairs."
(define* (import-ftp-release project
#:key
(version #f)
version
partial-version?
(server "ftp.gnu.org")
(directory (string-append "/gnu/" project))
(file->signature (cut string-append <> ".sig")))
"Return an <upstream-source> for the latest release of PROJECT on SERVER
under DIRECTORY, or #f. Optionally include a VERSION string to fetch a specific version.
under DIRECTORY, or #f. Optionally include a VERSION string to fetch a
specific version, which may be marked as partially specified via
PARTIAL-VERSION?.
Use FTP-OPEN and FTP-CLOSE to open (resp. close) FTP connections; this can be
useful to reuse connections.
@ -417,7 +420,9 @@ return the corresponding signature URL, or #f it signatures are unavailable."
(and (release-file? project file)
(file->source directory file)))
(_ #f))
entries)))
entries))
(versions (map upstream-source-version releases))
(version (find-version versions version partial-version?)))
;; Assume that SUBDIRS correspond to versions, and jump into the
;; one with the highest version number.
@ -440,14 +445,17 @@ return the corresponding signature URL, or #f it signatures are unavailable."
(define* (import-release package
#:key
(version #f)
version
partial-version?
(server "ftp.gnu.org")
(directory (string-append "/gnu/" package)))
"Return the <upstream-source> for the latest version of PACKAGE or #f.
PACKAGE must be the canonical name of a GNU package. Optionally include a
VERSION string to fetch a specific version."
VERSION string to fetch a specific version, which may be marked as partially
specified via PARTIAL-VERSION?."
(import-ftp-release package
#:version version
#:partial-version? partial-version?
#:server server
#:directory directory))
@ -463,7 +471,7 @@ of EXP otherwise."
(close-port port))
#f)))
(define* (import-release* package #:key (version #f))
(define* (import-release* package #:key version partial-version?)
"Like 'import-release', but (1) take a <package> object, and (2) ignore FTP
errors that might occur when PACKAGE is not actually a GNU package, or not
hosted on ftp.gnu.org, or not under that name (this is the case for
@ -474,6 +482,7 @@ hosted on ftp.gnu.org, or not under that name (this is the case for
(false-if-ftp-error
(import-release (package-upstream-name package)
#:version version
#:partial-version? partial-version?
#:server server
#:directory directory)))))
@ -561,16 +570,23 @@ URL is a directory instead of a file, it should be suffixed with a slash (/)."
;;; TODO: Extend to support the RPM and GNOME version schemes?
(define %version-rx "[0-9.]+")
(define* (rewrite-url url version #:key to-version)
(define* (rewrite-url url version #:key to-version partial-version?)
"Rewrite URL so that the URL path components matching the current VERSION or
VERSION-MAJOR.VERSION-MINOR are updated with that of the latest version found
by crawling the corresponding URL directories. Alternatively, when TO-VERSION
is specified, rewrite version matches directly to it without crawling URL.
is specified, rewrite version matches directly to it without crawling URL. If
TO-VERSION is provided and PARTIAL-VERSION? set to #t, then crawl URL to find
the newest compatible release (one that is prefixed by TO-VERSION).
For example, the URL
\"https://dist.libuv.org/dist/v1.45.0/libuv-v1.45.0.tar.gz\" could be
rewritten to something like
\"https://dist.libuv.org/dist/v1.46.0/libuv-v1.46.0.tar.gz\"."
\"https://dist.libuv.org/dist/v1.46.0/libuv-v1.46.0.tar.gz\".
With TO-VERSION set to \"1.49\" and PARTIAL-VERSION? set to #t, the URL
\"https://dist.libuv.org/dist/v1.45.0/libuv-v1.45.0.tar.gz\" could be
rewritten to something like
\"https://dist.libuv.org/dist/v1.49.2/libuv-v1.49.2.tar.gz\"."
;; XXX: major-minor may be #f if version is not a triplet but a single
;; number such as "2".
(let* ((major-minor (false-if-exception (version-major+minor version)))
@ -590,14 +606,15 @@ rewritten to something like
(reverse
(fold
(lambda (s parents)
(if to-version
(if (and to-version (not partial-version?))
;; Direct rewrite case; the archive is assumed to exist.
(let ((u (string-replace-substring s version to-version)))
(cons (if (and major-minor to-major-minor)
(string-replace-substring u major-minor to-major-minor)
u)
parents))
;; More involved HTML crawl case.
;; More involved HTML crawl case to get the latest version or a
;; partial to-version.
(let* ((pattern (if major-minor
(format #f "(~a|~a)" version major-minor)
(format #f "(~a)" version)))
@ -620,15 +637,14 @@ rewritten to something like
(m (string-match pattern l))
(v (match:substring m 1)))
(cons v l)))
links)))
;; Retrieve the item having the largest version.
(if (null? candidates)
parents
(cons (cdr (first (sort candidates
(lambda (x y)
(version>? (car x)
(car y))))))
parents)))
links))
(versions (map car candidates))
(version (find-version versions to-version
partial-version?)))
;; Retrieve the item having the greatest version.
(if version
(cons (assoc-ref candidates version) parents)
parents)) ;XXX: bogus case; throw an error?
;; No version found in path component; continue.
(cons s parents)))))
(reverse url-prefix-components)
@ -639,12 +655,14 @@ rewritten to something like
#:key
rewrite-url?
version
partial-version?
(directory (string-append
"/" (package-upstream-name package)))
file->signature)
"Return an <upstream-source> for the latest release of PACKAGE under
DIRECTORY at BASE-URL, or #f. Optionally include a VERSION string to fetch a
specific version.
specific version, which may be marked as partially specified via
PARTIAL-VERSION?.
BASE-URL should be the URL of an HTML page, typically a directory listing as
found on 'https://kernel.org/pub'.
@ -663,7 +681,8 @@ also updated to the latest version, as explained in the doc of the
base-url
(string-append base-url directory "/")))
(url (if rewrite-url?
(rewrite-url url current-version #:to-version version)
(rewrite-url url current-version #:to-version version
#:partial-version? partial-version?)
url))
(links (map (cut canonicalize-url <> url) (url->links url))))
@ -695,23 +714,18 @@ else #f. URL is assumed to fully specified."
(lambda (url) (list (uri-mirror-rewrite url))))))))))
(define candidates
(filter-map url->release links))
(coalesce-sources (filter-map url->release links)))
(match candidates
(() #f)
((first . _)
(if version
;; Find matching release version and return it.
(find (lambda (upstream)
(string=? (upstream-source-version upstream) version))
(coalesce-sources candidates))
;; Select the most recent release and return it.
(reduce (lambda (r1 r2)
(if (version>? (upstream-source-version r1)
(upstream-source-version r2))
r1 r2))
first
(coalesce-sources candidates)))))))
(define versions
(map upstream-source-version candidates))
(define new-version
(find-version versions version partial-version?))
(and new-version
(find (compose (cut string=? new-version <>)
upstream-source-version)
candidates))))
;;;
@ -743,7 +757,7 @@ else #f. URL is assumed to fully specified."
(call-with-gzip-input-port port
(compose string->lines get-string-all))))))
(define* (import-gnu-release package #:key (version #f))
(define* (import-gnu-release package #:key version partial-version?)
"Return the latest release of PACKAGE, a GNU package available via
ftp.gnu.org. Optionally include a VERSION string to fetch a specific version.
@ -776,12 +790,15 @@ list available from %GNU-FILE-LIST-URI over HTTP(S)."
(string-contains file directory)
(release-file? name (basename file))))
files))
;; find latest version
(version (or version
(and (not (null? relevant))
(tarball->version
(find-latest-tarball-version relevant)))))
;; find tarballs matching this version
(versions (delay (sort (delete-duplicates
(map tarball->version relevant))
version>?)))
(version (or (and version partial-version?
(find (cut version-prefix? version <>)
(force versions)))
version
(first (force versions))))
;; Find tarballs matching this version.
(tarballs (filter (lambda (file)
(string=? version (tarball->version file)))
relevant)))
@ -998,11 +1015,11 @@ updater."
(or (assoc-ref (package-properties package) 'release-monitoring-url)
((url-predicate http-url?) package)))
(define* (import-html-updatable-release package #:key (version #f))
(define* (import-html-updatable-release package #:key version partial-version?)
"Return the latest release of PACKAGE else #f. Do that by crawling the HTML
page of the directory containing its source tarball. Optionally include a
VERSION string to fetch a specific version."
VERSION string to fetch a specific version; which may be partially provided
when PARTIAL-VERSION? is #t."
(define (expand-uri uri)
(match uri
((and (? string?) (? (cut string-prefix? "mirror://" <>) url))
@ -1029,6 +1046,7 @@ VERSION string to fetch a specific version."
(import-html-release base package
#:rewrite-url? #t
#:version version
#:partial-version? partial-version?
#:directory directory))))
(define %gnu-updater

53
guix/import/composer.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -36,6 +37,7 @@
#:use-module (guix upstream)
#:use-module (guix utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (composer->guix-package
@ -58,10 +60,6 @@
(substring version 1))
(else version)))
(define (latest-version versions)
(fold (lambda (a b) (if (version>? (fix-version a) (fix-version b)) a b))
(car versions) versions))
(define (json->require dict)
(if dict
(let loop ((result '()) (require dict))
@ -102,31 +100,25 @@
(not (string-contains d "beta"))
(not (string-contains d "rc")))))
(define* (composer-fetch name #:key (version #f))
(define* (composer-fetch name #:key version partial-version?)
"Return a composer-package representation of the Composer metadata for the
package NAME with optional VERSION, or #f on failure."
(let* ((url (string-append (%composer-base-url) "/p/" name ".json"))
package NAME with optional VERSION, or #f on failure. VERSION may be gien as
version prefix if PARTIAL-VERSION? is #t."
(and-let* ((url (string-append (%composer-base-url) "/p/" name ".json"))
(packages (and=> (json-fetch url)
(lambda (pkg)
(let ((pkgs (assoc-ref pkg "packages")))
(or (assoc-ref pkgs name) pkg))))))
(if packages
(json->composer-package
(if version
(assoc-ref packages version)
(cdr
(fold
(lambda (new cur-max)
(match new
(((? valid-version? version) . tail)
(if (version>? (fix-version version)
(fix-version (car cur-max)))
(cons* version tail)
cur-max))
(_ cur-max)))
(cons* "0.0.0" #f)
packages))))
#f)))
(or (assoc-ref pkgs name) pkg)))))
(all-versions (map car packages))
(valid-versions (filter valid-version? all-versions))
(version (or (find-version valid-versions version partial-version?)
(and version
;; If the user-provided VERSION could not be
;; found, fallback to look through all
;; versions.
(find-version all-versions version
partial-version?)))))
(json->composer-package (assoc-ref packages version))))
(define (php-package-name name)
"Given the NAME of a package on Packagist, return a Guix-compliant name for
@ -246,10 +238,15 @@ package in Packagist."
(downstream-name (php-package-name dependency))
(type type)))
(define* (import-release package #:key (version #f))
"Return an <upstream-source> for VERSION or the latest release of PACKAGE."
(define* (import-release package #:key version partial-version?)
"Return an <upstream-source> for VERSION or the latest release of PACKAGE.
If PARTIAL-VERSION? is #t, the provided VERSION may be a partial version
prefix."
(let* ((php-name (guix-package->composer-name package))
(composer-package (composer-fetch php-name #:version version)))
(composer-package (composer-fetch php-name
#:version version
#:partial-version?
partial-version?)))
(if composer-package
(upstream-source
(package (composer-package-name composer-package))

2
guix/import/cpan.scm
View file

@ -328,7 +328,7 @@ in RELEASE, a <cpan-release> record."
")"))))
(url-predicate (cut regexp-exec cpan-rx <>))))
(define* (latest-release package #:key (version #f))
(define* (latest-release package #:key version partial-version?)
"Return an <upstream-source> for the latest release of PACKAGE."
(when version
(raise

4
guix/import/cran.scm
View file

@ -1028,7 +1028,7 @@ s-expression corresponding to that package, or #f on failure."
(_ #f)))
(_ #f)))))
(define* (latest-cran-release pkg #:key (version #f))
(define* (latest-cran-release pkg #:key version partial-version?)
"Return an <upstream-source> for the latest release of the package PKG."
(when version
(error
@ -1051,7 +1051,7 @@ s-expression corresponding to that package, or #f on failure."
(urls (cran-uri upstream-name version))
(inputs (cran-package-inputs meta 'cran))))))
(define* (latest-bioconductor-release pkg #:key (version #f))
(define* (latest-bioconductor-release pkg #:key version partial-version?)
"Return an <upstream-source> for the latest release of the package PKG."
(when version
(error

37
guix/import/crate.scm
View file

@ -7,6 +7,7 @@
;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2023, 2024 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2023, 2024 David Elsing <david.elsing@posteo.net>
;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2025 Herman Rimm <herman@rimm.ee>
;;;
;;; This file is part of GNU Guix.
@ -278,8 +279,9 @@ and LICENSE."
(loop curr remaining)
(loop next remaining))))))
(define (max-crate-version-of-semver semver-range range)
"Returns a <crate-version> of the highest version within the semver range."
(define (max-crate-version-of-semver semver-range versions)
"Returns the <crate-version> of the highest version found in VERSIONS that
satisfies SEMVER-RANGE."
(define (crate->semver crate)
(string->semver (crate-version-number crate)))
@ -287,7 +289,7 @@ and LICENSE."
(min-element
(filter (lambda (crate)
(semver-range-contains? semver-range (crate->semver crate)))
range)
versions)
(lambda args
(apply semver>? (map crate->semver args)))))
@ -491,25 +493,34 @@ look up the development dependencs for the given crate."
(define crate-package?
(url-predicate crate-url?))
(define* (import-release package #:key (version #f))
(define* (import-release package #:key version partial-version?)
"Return an <upstream-source> for the latest release of PACKAGE. Optionally
include a VERSION string to fetch a specific version."
include a VERSION string to fetch a specific version, which may be a partial
prefix when PARTIAL-VERSION? is #t."
(let* ((crate-name (guix-package->crate-name package))
(crate (lookup-crate crate-name))
(version (or version
(let ((max-crate-version
(versions (delay (nonyanked-crate-versions crate)))
(find-max-minor-patch-version (lambda (base-version)
(max-crate-version-of-semver
(string->semver-range
(string-append "^" (package-version package)))
(nonyanked-crate-versions crate))))
(and=> max-crate-version
(string-append
"^" base-version))
(force versions))))
(version (cond
((and version partial-version?) ;partial version
(and=> (find-max-minor-patch-version version)
crate-version-number))
((and version (not partial-version?)) ;exact version
version)
(else ;latest version
(and=> (find-max-minor-patch-version
(package-version package))
crate-version-number)))))
(if version
(and version
(upstream-source
(package (package-name package))
(version version)
(urls (list (crate-uri crate-name version))))
#f)))
(urls (list (crate-uri crate-name version)))))))
(define %crate-updater
(upstream-updater

27
guix/import/egg.scm
View file

@ -4,6 +4,7 @@
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2024 Ekaitz Zarraga <ekaitz@elenq.tech>
;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -24,6 +25,7 @@
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-71)
#:use-module (gcrypt hash)
#:use-module (guix git)
@ -99,12 +101,9 @@ to the repository."
(let ((eggs-directory (eggs-repository)))
(string-append eggs-directory "/" name)))
(define (find-latest-version name)
"Get the latest version of the egg NAME."
(let ((directory (scandir (egg-directory name))))
(if directory
(last directory)
#f)))
(define (get-versions name)
"Get the release versions of the egg NAME."
(or (scandir (egg-directory name)) '()))
(define* (egg-metadata name #:key (version #f) (file #f))
"Return the package metadata file for the egg NAME at version VERSION, or if
@ -112,7 +111,7 @@ FILE is specified, return the package metadata in FILE."
(call-with-input-file (or file
(string-append (egg-directory name) "/"
(or version
(find-latest-version name))
(first (get-versions name)))
"/" name ".egg"))
read))
@ -188,7 +187,7 @@ not work."
(if (not egg-content)
(values #f '()) ; egg doesn't exist
(let* ((version* (or (assoc-ref egg-content 'version)
(find-latest-version name)))
(first (get-versions name))))
(version (if (list? version*) (first version*) version*))
(source-url (if source #f `(egg-uri ,name version)))
(tarball (if source
@ -333,16 +332,18 @@ not work."
;;; Updater.
;;;
(define* (import-release package #:key (version #f))
(define* (import-release package #:key version partial-version?)
"Return an @code{<upstream-source>} for the latest release of PACKAGE.
Optionally include a VERSION string to fetch a specific version."
Optionally fetch a specific VERSION string, which may be a version prefix when
PARTIAL-VERSION? is #t."
(let* ((egg-name (guix-package->egg-name package))
(version (or version (find-latest-version egg-name)))
(source-url (egg-uri egg-name version)))
(versions (get-versions egg-name))
(version (find-version versions version partial-version?)))
(and version
(upstream-source
(package (package-name package))
(version version)
(urls (list source-url)))))
(urls (list (egg-uri egg-name version)))))))
(define %egg-updater
(upstream-updater

2
guix/import/elpa.scm
View file

@ -422,7 +422,7 @@ type '<elpa-package>'."
(string-drop (package-name package) 6)
(package-name package))))
(define* (latest-release package #:key (version #f))
(define* (latest-release package #:key version partial-version?)
"Return an <upstream-release> for the latest release of PACKAGE."
(define name (guix-package->elpa-name package))
(define repo (elpa-repository package))

23
guix/import/gem.scm
View file

@ -7,6 +7,7 @@
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -26,6 +27,7 @@
(define-module (guix import gem)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (json)
#:use-module (guix import utils)
#:use-module (guix import json)
@ -35,6 +37,7 @@
#:use-module (guix base16)
#:use-module (guix base32)
#:use-module ((guix build-system ruby) #:select (rubygems-uri))
#:use-module ((guix utils) #:select (version>? version-prefix?))
#:export (gem->guix-package
%gem-updater
gem-recursive-import))
@ -90,6 +93,15 @@
(string-append "https://rubygems.org/api/v1/gems/" name ".json")))
json->gem))
(define (get-versions name)
"Return all the versions for the gem NAME, sorted in decreasing order."
(let* ((url (string-append "https://rubygems.org/api/v1/versions/"
name ".json"))
(versions-data (json-fetch url)))
(sort (map (cut assoc-ref <> "number")
(vector->list versions-data))
version>?)))
(define (ruby-package-name name)
"Given the NAME of a package on RubyGems, return a Guix-compliant name for
the package."
@ -172,7 +184,7 @@ package on RubyGems."
(define gem-package?
(url-prefix-predicate "https://rubygems.org/downloads/"))
(define* (import-release package #:key (version #f))
(define* (import-release package #:key version partial-version?)
"Return an <upstream-source> for the latest release of PACKAGE."
(let* ((gem-name (guix-package->gem-name package))
(gem (rubygems-fetch gem-name))
@ -184,13 +196,14 @@ package on RubyGems."
(ruby-package-name name))
(type 'propagated))))
(gem-dependencies-runtime (gem-dependencies gem))))
(version (or version (gem-version gem)))
(url (rubygems-uri gem-name version)))
(versions (get-versions gem-name))
(version (find-version versions version partial-version?)))
(and version
(upstream-source
(package (package-name package))
(version version)
(urls (list url))
(inputs inputs))))
(urls (list (rubygems-uri gem-name version)))
(inputs inputs)))))
(define %gem-updater
(upstream-updater

81
guix/import/git.scm
View file

@ -26,7 +26,7 @@
#:use-module (guix git-download)
#:use-module (guix packages)
#:use-module (guix upstream)
#:use-module (guix utils)
#:use-module ((guix import utils) #:select (find-version))
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
@ -34,10 +34,7 @@
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-71)
#:export (%generic-git-updater
;; For tests.
latest-git-tag-version))
#:export (%generic-git-updater))
;;; Commentary:
;;;
@ -121,7 +118,9 @@ version corresponding to the tag, and the cdr is the name of the tag."
;; with "."
pre-release-rx suffix-rx))
(define (pre-release? tag)
(any (cut regexp-exec <> tag)
%pre-release-rx))
(define (get-version tag)
(let ((tag-match (regexp-exec (make-regexp tag-rx) tag)))
@ -135,30 +134,20 @@ version corresponding to the tag, and the cdr is the name of the tag."
(string-append version (match:substring tag-match 3))
version)))))
(define (entry<? a b)
(eq? (version-compare (car a) (car b)) '<))
(define (pre-release? tag)
(any (cut regexp-exec <> tag)
%pre-release-rx))
(stable-sort (filter-map (lambda (tag)
(filter-map (lambda (tag)
(let ((version (get-version tag)))
(and version
(or pre-releases?
(not (pre-release? version)))
(cons version tag))))
tags)
entry<?))
tags))
(define* (latest-tag url
#:key prefix suffix delim pre-releases? (version #f))
"Return the latest version and corresponding tag available from the Git
repository at URL. Optionally include a VERSION string to fetch a specific
version."
(define* (get-tags url #:key prefix suffix delim pre-releases?)
"Return a alist of the Git tags available from URL. The tags are keyed by
their version, a mapping derived from their name."
(let* ((tags (map (cut string-drop <> (string-length "refs/tags/"))
(remote-refs url #:tags? #t)))
(versions->tags
(versions+tags
(version-mapping tags
#:prefix prefix
#:suffix suffix
@ -167,48 +156,39 @@ version."
(cond
((null? tags)
(git-no-tags-error))
((null? versions->tags)
((null? versions+tags)
(git-no-valid-tags-error))
(else
(let ((versions (if version
(filter (match-lambda
((candidate-version . tag)
(string=? version candidate-version)))
versions->tags)
versions->tags)))
(if (null? versions)
(values #f #f)
(match (last versions)
((version . tag)
(values version tag)))))))))
versions+tags)))) ;already sorted
(define* (latest-git-tag-version package #:key (version #f))
"Given a PACKAGE, return the latest version of it and the corresponding git
tag, or #false and #false if the latest version could not be determined.
Optionally include a VERSION string to fetch a specific version."
(define* (get-package-tags package)
"Given a PACKAGE, return all its known tags, an alist keyed by the tags
associated versions. "
(guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
(warning (or (package-field-location package 'source)
(package-location package))
(G_ "~a for ~a~%")
(condition-message c)
(package-name package))
(values #f #f))
'())
((eq? (exception-kind c) 'git-error)
(warning (or (package-field-location package 'source)
(package-location package))
(G_ "failed to fetch Git repository for ~a~%")
(package-name package))
(values #f #f)))
'()))
(let* ((source (package-source package))
(url (git-reference-url (origin-uri source)))
(property (cute assq-ref (package-properties package) <>)))
(latest-tag url
#:version version
(get-tags url
#:prefix (property 'release-tag-prefix)
#:suffix (property 'release-tag-suffix)
#:delim (property 'release-tag-version-delimiter)
#:pre-releases? (property 'accept-pre-releases?)))))
;; Prevent Guile from inlining this procedure so we can use it in tests.
(set! get-package-tags get-package-tags)
(define (git-package? package)
"Return true if PACKAGE is hosted on a Git repository."
(match (package-source package)
@ -217,21 +197,24 @@ Optionally include a VERSION string to fetch a specific version."
(git-reference? (origin-uri origin))))
(_ #f)))
(define* (import-git-release package #:key (version #f))
(define* (import-git-release package #:key version partial-version?)
"Return an <upstream-source> for the latest release of PACKAGE.
Optionally include a VERSION string to fetch a specific version."
Optionally include a VERSION string to fetch a specific version, which may be
a version prefix when PARTIAL-VERSION? is #t."
(let* ((name (package-name package))
(old-version (package-version package))
(old-reference (origin-uri (package-source package)))
(new-version new-version-tag
(latest-git-tag-version package #:version version)))
(and new-version new-version-tag
(tags (get-package-tags package))
(versions (map car tags))
(version (find-version versions version partial-version?))
(tag (assoc-ref tags version)))
(and version
(upstream-source
(package name)
(version new-version)
(version version)
(urls (git-reference
(url (git-reference-url old-reference))
(commit new-version-tag)
(commit tag)
(recursive? (git-reference-recursive? old-reference))))))))
(define %generic-git-updater

102
guix/import/github.scm
View file

@ -7,6 +7,7 @@
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -30,7 +31,8 @@
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-71)
#:use-module (guix utils)
#:use-module ((guix import utils) #:select (find-version))
#:use-module ((guix utils) #:select (string-replace-substring))
#:use-module (guix i18n)
#:use-module (guix diagnostics)
#:use-module ((guix ui) #:select (display-hint))
@ -246,40 +248,49 @@ Alternatively, you can wait until your rate limit is reset, or use the
#:headers headers))))
(match result
(#()
;; We got the empty list, presumably because the user didn't use GitHub's
;; "release" mechanism, but hopefully they did use Git tags.
;; We got the empty list, presumably because the user
;; didn't use GitHub's "release" mechanism, but hopefully
;; they did use Git tags.
(json->scm (http-fetch tag-url
#:port connection
#:keep-alive? #t
#:headers headers)))
(x x)))))))))
(define* (latest-released-version url package-name #:key (version #f))
"Return the newest released version and its tag given a string URL like
'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz' and the name of
the package e.g. 'bedtools2'. Return #f (two values) if there are no
releases.
(define* (get-package-tags package)
"Return an alist of tags keyed by their version for PACKAGE, a <package>
object."
(define (github-uri uri)
(match uri
((? string? url)
url) ;surely a github.com URL
((? download:git-reference? ref)
(download:git-reference-url ref))
((urls ...)
(find (cut string-contains <> "github.com") urls))))
Optionally include a VERSION string to fetch a specific version."
(define (pre-release? x)
(assoc-ref x "prerelease"))
(define source-uri
(github-uri (origin-uri (package-source package))))
;; This procedure returns (version . tag) pair, or #f
;; if RELEASE doesn't seyem to correspond to a version.
(define (release->version release)
(let ((tag (or (assoc-ref release "tag_name") ;a "release"
(let* ((tag (or (assoc-ref release "tag_name") ;a "release"
(assoc-ref release "name"))) ;a tag
(name-length (string-length package-name)))
(name (package-upstream-name package))
(name-length (string-length name)))
(cond
;; some tags include the name of the package e.g. "fdupes-1.51"
;; so remove these
;; Some tags include the name of the package e.g. "fdupes-1.51"; remove
;; these.
((and (< name-length (string-length tag))
(string=? (string-append package-name "-")
(string=? (string-append name "-")
(substring tag 0 (+ name-length 1))))
(cons (substring tag (+ name-length 1)) tag))
;; some tags start with a "v" e.g. "v0.25.0"
;; or with the word "version" e.g. "version.2.1"
;; where some are just the version number
;; Some tags start with a "v" e.g. "v0.25.0" or with the word "version"
;; e.g. "version.2.1" where some are just the version number.
((string-prefix? "version" tag)
(cons (if (char-set-contains? char-set:digit (string-ref tag 7))
(substring tag 7)
@ -294,53 +305,32 @@ Optionally include a VERSION string to fetch a specific version."
(cons tag tag))
(else #f))))
(match (and=> (fetch-releases-or-tags url) vector->list)
(#f (values #f #f))
(match (and=> (fetch-releases-or-tags source-uri) vector->list)
(#f '())
(json
(let ((releases (filter-map release->version
(filter-map release->version
(match (remove pre-release? json)
(() json) ; keep everything
(releases releases)))))
(match (if version
;; Find matching release version.
(filter (match-lambda
((candidate-version . tag)
(string=? version candidate-version)))
releases)
;; Sort releases descending.
(sort releases
(lambda (x y) (version>? (car x) (car y)))))
(((latest-version . tag) . _) (values latest-version tag))
(() (values #f #f)))))))
(() json) ;keep everything
(releases releases))))))
(define* (import-release pkg #:key (version #f))
(define* (import-release pkg #:key version partial-version?)
"Return an <upstream-source> for the latest release of PKG.
Optionally include a VERSION string to fetch a specific version."
(define (github-uri uri)
(match uri
((? string? url)
url) ;surely a github.com URL
((? download:git-reference? ref)
(download:git-reference-url ref))
((urls ...)
(find (cut string-contains <> "github.com") urls))))
Optionally include a VERSION string to fetch a specific version, which may be
a partial version prefix if PARTIAL-VERSION? is #t."
(let* ((original-uri (origin-uri (package-source pkg)))
(source-uri (github-uri original-uri))
(name (package-upstream-name pkg))
(newest-version version-tag
(latest-released-version source-uri name
#:version version)))
(if newest-version
(tags (get-package-tags pkg))
(versions (map car tags))
(version (find-version versions version partial-version?))
(tag (assoc-ref tags version)))
(and version
(upstream-source
(package name)
(version newest-version)
(package (package-upstream-name pkg))
(version version)
(urls (if (download:git-reference? original-uri)
(download:git-reference
(inherit original-uri)
(commit version-tag))
(list (updated-github-url pkg newest-version)))))
#f))) ; On GitHub but no proper releases
(commit tag))
(list (updated-github-url pkg version))))))))
(define %github-updater
(upstream-updater
@ -348,5 +338,3 @@ Optionally include a VERSION string to fetch a specific version."
(description "Updater for GitHub packages")
(pred github-package?)
(import import-release)))

50
guix/import/gnome.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2019, 2021, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2022, 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; This file is part of GNU Guix.
@ -19,14 +19,15 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import gnome)
#:use-module ((guix import utils) #:select (find-version))
#:use-module (guix upstream)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix http-client)
#:use-module (guix diagnostics)
#:use-module (guix i18n)
#:use-module (json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (web uri)
#:use-module (ice-9 match)
@ -58,10 +59,10 @@ source for metadata."
name "/" relative-url))))
'("tar.lz" "tar.xz" "tar.bz2" "tar.gz")))))))
(define* (import-gnome-release package #:key (version #f))
(define* (import-gnome-release package #:key version partial-version?)
"Return the latest release of PACKAGE, a GNOME package, or #f if it could
not be determined. Optionally include a VERSION string to fetch a specific
version."
version, which may be partial if PARTIAL-VERSION? is #t."
(define %not-dot
(char-set-complement (char-set #\.)))
@ -90,28 +91,6 @@ https://discourse.gnome.org/t/new-gnome-versioning-scheme/4235"
;; Some packages like "NetworkManager" have camel-case names.
(package-upstream-name package))
(define (find-latest-release releases)
(fold (match-lambda*
(((key . value) result)
(cond ((release-version? key)
(match result
(#f
(cons key value))
((newest . _)
(if (version>? key newest)
(cons key value)
result))))
(else
result))))
#f
releases))
(define (find-version-release releases version)
(find (match-lambda
((key . value)
(string=? key version)))
releases))
(guard (c ((http-get-error? c)
(unless (= 404 (http-get-error-code c))
(warning (G_ "failed to download from '~a': ~a (~s)~%")
@ -135,11 +114,20 @@ https://discourse.gnome.org/t/new-gnome-versioning-scheme/4235"
(match json
(#(4 releases _ ...)
(let* ((releases (assoc-ref releases upstream-name))
(latest (if version
(find-version-release releases version)
(find-latest-release releases))))
(and latest
(jsonish->upstream-source upstream-name latest))))))))
(all-versions (map car releases))
(release-versions (filter release-version? all-versions))
(version (or (find-version release-versions
version partial-version?)
(and version
;; If the user-provided VERSION could not be
;; found, fallback to look through all
;; versions.
(find-version all-versions
version partial-version?)))))
(and version
(jsonish->upstream-source
upstream-name
(find (compose (cut string=? version <>) car) releases)))))))))
(define %gnome-updater
(upstream-updater

2
guix/import/hackage.scm
View file

@ -379,7 +379,7 @@ respectively."
(let ((hackage-rx (make-regexp "(https?://hackage.haskell.org|mirror://hackage/)")))
(url-predicate (cut regexp-exec hackage-rx <>))))
(define* (import-release package #:key (version #f))
(define* (import-release package #:key version partial-version?)
"Return an <upstream-source> for the latest release of PACKAGE."
(let* ((hackage-name (package-upstream-name* package))
(cabal-meta (hackage-fetch hackage-name version)))

36
guix/import/hexpm.scm
View file

@ -3,7 +3,7 @@
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2017, 2019-2021, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2019, 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020-2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; This file is part of GNU Guix.
@ -32,7 +32,7 @@
call-with-temporary-output-file))
#:use-module (guix packages)
#:use-module (guix upstream)
#:autoload (guix utils) (version>? file-sans-extension)
#:autoload (guix utils) (file-sans-extension version>? version-prefix?)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@ -95,7 +95,7 @@
(define (lookup-hexpm name)
"Look up NAME on hex.pm and return the corresponding <hexpm> record
"Look up NAME on hex.pm and return the corresponding <hexpm-pkgdef> record
or #f if it was not found."
(and=> (json-fetch (package-url name))
json->hexpm))
@ -215,16 +215,11 @@ build-system, and DEPENDENCIES the inputs for the package."
license)))
strings))
(define (hexpm-latest-release package)
"Return the version string for the latest stable release of PACKAGE."
;; Use latest-stable if specified (see comment in hexpm-pkgdef above),
;; otherwise compare the lists of release versions.
(let ((latest-stable (hexpm-latest-stable package)))
(if (not (unspecified? latest-stable))
latest-stable
(let ((versions (map hexpm-version-number (hexpm-versions package))))
(fold (lambda (a b)
(if (version>? a b) a b)) (car versions) versions)))))
(define (hexpm-releases package)
"Return the version strings for releases of PACKAGE, a <hexpm-pkgdef>
object, ordered from newest to oldest."
(sort (map hexpm-version-number (hexpm-versions package))
version>?))
(define* (hexpm->guix-package package-name #:key version #:allow-other-keys)
"Fetch the metadata for PACKAGE-NAME from hexpms.io, and return the
@ -238,7 +233,7 @@ latest version of PACKAGE-NAME."
(define version-number
(and package
(or version
(hexpm-latest-release package))))
(first (hexpm-releases package)))))
(define version*
(and package
@ -320,17 +315,20 @@ latest version of PACKAGE-NAME."
;;; Updater
;;;
(define* (import-release package #:key (version #f))
(define* (import-release package #:key version partial-version?)
"Return an <upstream-source> for the latest release of PACKAGE. Optionally
include a VERSION string to fetch a specific version."
include a VERSION string to fetch a specific version, which may be a version
prefix when PARTIAL-VERSION? is #t."
(let* ((hexpm-name (guix-package->hexpm-name package))
(hexpm (lookup-hexpm hexpm-name))
(version (or version (hexpm-latest-release hexpm)))
(url (hexpm-uri hexpm-name version)))
(latest-stable (hexpm-latest-stable hexpm))
(releases (hexpm-releases hexpm))
(version (find-version releases version partial-version?)))
(and version
(upstream-source
(package (package-name package))
(version version)
(urls (list url)))))
(urls (list (hexpm-uri hexpm-name version)))))))
(define %hexpm-updater
(upstream-updater

47
guix/import/kde.scm
View file

@ -2,6 +2,7 @@
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,6 +20,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import kde)
#:use-module ((guix import utils) #:select (find-version))
#:use-module (guix http-client)
#:use-module (guix gnu-maintenance)
#:use-module (guix packages)
@ -149,48 +151,39 @@ Output:
(string-join (map version->pattern directory-parts) "/")
"/"))))
(define* (import-kde-release package #:key (version #f))
(define* (import-kde-release package #:key version partial-version?)
"Return the latest release of PACKAGE, a KDE package, or #f if it could
not be determined. Optionally include a VERSION string to fetch a specific
version."
(define (find-latest-archive-version archives)
(fold (lambda (file1 file2)
(if (and file2
(version>? (tarball-sans-extension (basename file2))
(tarball-sans-extension (basename file1))))
file2
file1))
#f
archives))
version, which may be a partial prefix when PARTIAL-VERSION? is #t."
(let* ((uri (string->uri (origin-uri (package-source package))))
(path-rx (uri->kde-path-pattern uri))
(name (package-upstream-name package))
(files (download.kde.org-files))
;; select archives for this package
;; Select archives for this package.
(relevant (filter (lambda (file)
(and (regexp-exec path-rx file)
(release-file? name (basename file))))
files))
;; Find latest version.
(version (or version
(and (not (null? relevant))
(tarball->version (find-latest-archive-version relevant)))))
;; Find archives matching this version.
(tarballs (filter (lambda (file)
(string=? version (tarball->version file)))
relevant)))
(match tarballs
(() #f)
(_
;; Build an association list of file names keyed by their version.
(all-tarballs (map (lambda (x)
(cons (tarball->version x) x))
relevant))
(versions (map car all-tarballs))
;; Find the latest version.
(version (find-version versions version partial-version?))
;; Find all archives matching this version.
(tarballs (and version
(map cdr (filter (match-lambda
((x . file-name)
(string=? version x)))
all-tarballs)))))
(and version tarballs
(upstream-source
(package name)
(version version)
(urls (map (lambda (file)
(string-append "mirror://kde/" file))
tarballs)))))))
tarballs))))))
(define %kde-updater
(upstream-updater

34
guix/import/launchpad.scm
View file

@ -3,6 +3,7 @@
;;; Copyright © 2021 Matthew James Kraai <kraai@ftbfs.org>
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -26,9 +27,10 @@
#:use-module (web uri)
#:use-module ((guix download) #:prefix download:)
#:use-module (guix import json)
#:use-module ((guix import utils) #:select (find-version))
#:use-module (guix packages)
#:use-module (guix upstream)
#:use-module (guix utils)
#:use-module ((guix utils) #:select (version-major+minor))
#:export (%launchpad-updater))
(define (find-extension url)
@ -103,9 +105,9 @@ URL of the form
(match (string-split (uri-path (string->uri url)) #\/)
((_ repo . rest) repo)))
(define (latest-released-version repository)
"Return a string of the newest released version name given the REPOSITORY,
for example, 'linuxdcpp'. Return #f if there is no releases."
(define (release-versions repository)
"Return a list of the release version strings available for REPOSITORY, a
repository name such as 'linuxdcpp'."
(define (pre-release? x)
;; Versions containing anything other than digit characters and "." (for
;; example, "5.1.0-rc1") are assumed to be pre-releases.
@ -118,29 +120,29 @@ for example, 'linuxdcpp'. Return #f if there is no releases."
repository "/releases"))
(#f #f) ;404 or similar
(json
(assoc-ref
(last (remove pre-release? (vector->list (assoc-ref json "entries"))))
"version"))))
(let ((releases (remove pre-release?
(vector->list (assoc-ref json "entries")))))
(map (cut assoc-ref <> "version") releases)))))
(define* (import-release pkg #:key (version #f))
(define* (import-release pkg #:key version partial-version?)
"Return an <upstream-source> for the latest release of PKG. Optionally
include a VERSION string to fetch a specific version."
include a VERSION string to fetch a specific version. When PARTIAL-VERSION?
is #t, update to the latest version prefixed by VERSION."
(define (origin-launchpad-uri origin)
(match (origin-uri origin)
((? string? url) url) ; surely a Launchpad URL
((? string? url) url) ;surely a Launchpad URL
((urls ...)
(find (cut string-contains <> "launchpad.net") urls))))
(let* ((source-uri (origin-launchpad-uri (package-source pkg)))
(name (package-name pkg))
(repository (launchpad-repository source-uri))
(newest-version (or version (latest-released-version repository))))
(if newest-version
(versions (release-versions (launchpad-repository source-uri)))
(version (find-version versions version partial-version?)))
(and version
(upstream-source
(package name)
(version newest-version)
(urls (list (updated-launchpad-url pkg newest-version))))
#f))) ; On Launchpad but no proper releases
(version version)
(urls (list (updated-launchpad-url pkg version)))))))
(define %launchpad-updater
(upstream-updater

2
guix/import/minetest.scm
View file

@ -483,7 +483,7 @@ list of AUTHOR/NAME strings."
(and (string-prefix? "minetest-" (package:package-name pkg))
(assq-ref (package:package-properties pkg) 'upstream-name)))
(define* (latest-minetest-release pkg #:key (version #f))
(define* (latest-minetest-release pkg #:key version partial-version?)
"Return an <upstream-source> for the latest release of the package PKG,
or #false if the latest release couldn't be determined."
(define author/name

2
guix/import/opam.scm
View file

@ -417,7 +417,7 @@ package in OPAM."
(member (build-system-name (package-build-system package)) '(dune ocaml))
(not (string-prefix? "ocaml4" (package-name package)))))
(define* (latest-release package #:key (version #f))
(define* (latest-release package #:key version partial-version?)
"Return an <upstream-source> for the latest release of PACKAGE."
(when version
(raise

21
guix/import/pypi.scm
View file

@ -35,6 +35,7 @@
#:use-module (ice-9 regex)
#:use-module ((ice-9 rdelim) #:select (read-line))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@ -522,11 +523,17 @@ pypi-uri declaration in the generated package. You may need to replace ~s with
a substring of the PyPI URI that identifies the package.") pypi-url name))
name)))
(define* (pypi-package->upstream-source pypi-package #:optional version)
(define* (pypi-package->upstream-source pypi-package
#:optional version partial-version?)
"Return the upstream source for the given VERSION of PYPI-PACKAGE, a
<pypi-project> record. If VERSION is omitted or #f, use the latest version."
<pypi-project> record. If VERSION is omitted or #f, use the latest version.
If PARTIAL-VERSION? is #t, use the latest version found that is prefixed by
VERSION."
(let* ((info (pypi-project-info pypi-package))
(version (or version (project-info-version info)))
(versions (map (match-lambda
((version . _) version))
(pypi-project-releases pypi-package)))
(version (find-version versions version partial-version?))
(dist (source-release pypi-package version))
(source-url (distribution-url dist))
(wheel-url (and=> (wheel-release pypi-package version)
@ -661,14 +668,14 @@ source. To build it from source, refer to the upstream repository at
(string-prefix? "https://pypi.org/packages" url)
(string-prefix? "https://files.pythonhosted.org/packages" url)))))
(define* (import-release package #:key (version #f))
(define* (import-release package #:key version partial-version?)
"Return an <upstream-source> for the latest release of PACKAGE. Optionally
include a VERSION string to fetch a specific version."
(let* ((pypi-name (guix-package->pypi-name package))
(and-let* ((pypi-name (guix-package->pypi-name package))
(pypi-package (pypi-fetch pypi-name)))
(and pypi-package
(guard (c ((missing-source-error? c) #f))
(pypi-package->upstream-source pypi-package version)))))
(pypi-package->upstream-source pypi-package
version partial-version?))))
(define %pypi-updater
(upstream-updater

2
guix/import/stackage.scm
View file

@ -142,7 +142,7 @@ included in the Stackage LTS release."
(mlambda ()
(stackage-lts-packages
(stackage-lts-info-fetch %default-lts-version)))))
(lambda* (pkg #:key (version #f))
(lambda* (pkg #:key version partial-version?)
"Return an <upstream-source> for the latest Stackage LTS release of
PACKAGE or #f if the package is not included in the Stackage LTS release."
(when version

15
guix/import/test.scm
View file

@ -18,6 +18,8 @@
(define-module (guix import test)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module ((guix import utils) #:select (find-version))
#:use-module (guix packages)
#:use-module (guix upstream)
#:use-module ((guix utils) #:select (version-prefix?))
@ -76,18 +78,17 @@
(and (not (vlist-null? (test-target-version))) ;cheap test
(pair? (available-updates package))))
(define* (import-release package #:key (version #f))
(define* (import-release package #:key version partial-version?)
"Return the <upstream-source> record denoting either the latest version of
PACKAGE or VERSION."
(match (available-updates package)
(() #f)
((sources ...)
(if version
(find (lambda (source)
(string=? (upstream-source-version source)
version))
sources)
(first sources)))))
(let* ((versions (map upstream-source-version sources))
(version (find-version versions version partial-version?)))
(and version
(find (compose (cut string=? version <>) upstream-source-version)
sources))))))
(define %test-updater
(upstream-updater

38
guix/import/texlive.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2021, 2022, 2023 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021, 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2024 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;;
;;; This file is part of GNU Guix.
@ -35,7 +35,8 @@
#:use-module (guix store)
#:use-module (guix svn-download)
#:use-module (guix upstream)
#:use-module ((guix utils) #:select (downstream-package-name))
#:use-module ((guix utils) #:select (downstream-package-name
version>? version-prefix?))
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
@ -261,17 +262,21 @@ not succeed."
"Return number of days since Epoch."
(floor (/ (time-second (current-time)) (* 24 60 60))))
(define latest-texlive-tag
;; Return the latest TeX Live tag in repository. The argument refers to
;; current day, so memoization is only active a single day, as the
;; repository may have been updated between two calls.
(define texlive-tags
(memoize
(lambda* (#:key (day (current-day)))
(let ((output
(svn-command "ls" (string-append %texlive-repository "tags") "-v")))
;; E.g. "70951 karl april 15 18:11 texlive-2024.2/\n\n"
(and=> (string-match "texlive-([^/]+)/\n*$" output)
(cut match:substring <> 1))))))
"Return all tags found in for the TeX Live tags in repository, from
latest to oldest. The argument refers to current day, so memoization is only
active a single day, as the repository may have been updated between two
calls."
(let* ((output (svn-command
"ls" (string-append %texlive-repository "tags") "-v"))
(lines (string-split output #\newline)))
;; Each line look like "70951 karl april 15 18:11 texlive-2024.2/\n\n".
(filter-map (lambda (l)
(and=> (string-match "texlive-([^/]+)/\n*$" l)
(cut match:substring <> 1)))
lines)))))
(define string->license
(match-lambda
@ -761,7 +766,7 @@ associated Guix package, or #f on failure. Fetch metadata for a specific
version whenever VERSION keyword is specified. Otherwise, grab package latest
release. When DATABASE is provided, fetch metadata from there, ignoring
VERSION."
(let ((version (or version (latest-texlive-tag))))
(let ((version (or version (first (texlive-tags)))))
(tlpdb->package name version (or database (tlpdb/cached version))))))
(define* (texlive-recursive-import name #:key repo version)
@ -785,13 +790,14 @@ VERSION."
(eq? 'texlive
(build-system-name (package-build-system package)))))))
(define* (latest-release package #:key version)
(define* (latest-release package #:key version partial-version?)
"Return an <upstream-source> for the latest release of PACKAGE. Optionally
include a VERSION string to fetch a specific version."
(let* ((version (or version (latest-texlive-tag)))
include a VERSION string to fetch a specific version, which may be a partial
prefix when PARTIAL-VERSION? is #t."
(let* ((version (find-version (texlive-tags) version partial-version?))
(database (tlpdb/cached version))
(upstream-name (package-upstream-name* package)))
(and (assoc-ref database upstream-name)
(and version (assoc-ref database upstream-name)
(upstream-source
(package upstream-name)
(version version)

20
guix/import/utils.scm
View file

@ -7,7 +7,7 @@
;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
;;; Copyright © 2020 Helio Machado <0x2b3bfa0+guix@googlemail.com>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021, 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2022 Alice Brenon <alice.brenon@ens-lyon.fr>
@ -85,6 +85,8 @@
guix-name
find-version
recursive-import))
(define (factorize-uri uri version)
@ -620,6 +622,22 @@ separated by PRED."
(define-deprecated/alias guix-name downstream-package-name)
(define* (find-version versions #:optional version partial?)
"Find VERSION amongst VERSIONS. When VERSION is not provided, return the
latest version. When PARTIAL? is #t, VERSION is treated as a version prefix;
e.g. finding version \"0.1\" may return \"0.1.8\" if it is the newest \"0.1\"
prefixed version found in VERSIONS. Return #f when VERSION could not be
found."
(let ((versions (sort versions version>?)))
(cond
((and version partial?) ;partial version
(find (cut version-prefix? version <>) versions))
((and version (not partial?)) ;exact version
(find (cut string=? version <>) versions))
((not (null? versions)) ;latest version
(first versions))
(else #f)))) ;should not happen
(define (topological-sort nodes
node-dependencies
node-name)

62
guix/scripts/refresh.scm
View file

@ -10,7 +10,7 @@
;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2023, 2025 Maxim Cournoyer maxim.cournoyer@gmail.com>
;;; Copyright © 2023-2025 Maxim Cournoyer maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -170,7 +170,9 @@ specified with `--select'.\n"))
-m, --manifest=FILE select all the packages from the manifest in FILE"))
(display (G_ "
--target-version=VERSION
update the package or packages to VERSION"))
update the package or packages to VERSION
VERSION may be partially specified, e.g. as 6
or 6.4 instead of 6.4.3"))
(display (G_ "
-t, --type=UPDATER,... restrict to updates from the specified updaters
(e.g., 'gnu')"))
@ -213,20 +215,22 @@ specified with `--select'.\n"))
;;;
(define-record-type <update-spec>
(%update-spec package version)
(%update-spec package version partial?)
update?
(package update-spec-package)
(version update-spec-version))
(version update-spec-version)
(partial? update-spec-partial?))
(define* (update-spec package #:optional version)
(%update-spec package version))
(define* (update-spec package #:optional version partial?)
(%update-spec package version partial?))
(define (update-specification->update-spec spec fallback-version)
"Given SPEC, a package name like \"guile@2.0=2.0.8\", return a <update>
record with two fields: the package to upgrade, and the target version. When
SPEC lacks a version, use FALLBACK-VERSION."
(match (string-rindex spec #\=)
(#f (update-spec (specification->package spec) fallback-version))
(#f (update-spec (specification->package spec) fallback-version
(not (not fallback-version))))
(idx (update-spec (specification->package (substring spec 0 idx))
(substring spec (1+ idx))))))
@ -282,9 +286,9 @@ update would trigger a complete rebuild."
spec target-version)))
(('expression . exp)
(list (update-spec (read/eval-package-expression exp)
target-version)))
target-version #t)))
(('manifest . manifest)
(map (cut update-spec <> target-version)
(map (cut update-spec <> target-version #t)
(packages-from-manifest manifest)))
(_
'()))
@ -364,17 +368,23 @@ update would trigger a complete rebuild."
(G_ "no updater for ~a~%")
(package-name package)))
(define* (update-package store package version updaters
(define* (update-package store update-spec updaters
#:key (key-download 'auto) key-server
warn?)
"Update the source file that defines PACKAGE with the new version.
KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
values: 'auto' (default), interactive', 'always', and 'never'. When WARN? is
true, warn about packages that have no matching updater."
"Update the source file that correspond to the package in UPDATE-SPEC,
an <update-spec> object. KEY-DOWNLOAD specifies a download policy for
missing OpenPGP keys; allowed values: 'auto' (default), 'interactive',
'always', and 'never'. When WARN? is true, warn about packages that
have no matching updater. PARTIAL-VERSION? is provided to the
underlying `package-update' call; see its documentation for the
details."
(match update-spec
(($ <update-spec> package version partial?)
(if (lookup-updater package updaters)
(let ((version output source
(package-update store package updaters
#:version version
#:partial-version? partial?
#:key-download key-download
#:key-server key-server))
(loc (or (package-field-location package 'version)
@ -392,17 +402,16 @@ true, warn about packages that have no matching updater."
downloaded and authenticated; not updating~%")
(package-name package) version))))
(when warn?
(warn-no-updater package))))
(warn-no-updater package))))))
(define* (check-for-package-update update-spec updaters #:key warn?)
"Check whether UPDATE-SPEC is feasible, and print a message.
When WARN? is true and no updater exists for PACKAGE, print a warning."
(define package
(update-spec-package update-spec))
(match update-spec
(($ <update-spec> package version partial?)
(match (package-latest-release package updaters
#:version
(update-spec-version update-spec))
#:version version
#:partial-version? partial?)
((? upstream-source? source)
(let ((loc (or (package-field-location package 'version)
(package-location package))))
@ -420,7 +429,7 @@ When WARN? is true and no updater exists for PACKAGE, print a warning."
(package-version package)
(package-name package))))
(else
(if (update-spec-version update-spec)
(if version
(info loc
(G_ "~a would be downgraded from ~a to ~a~%")
(package-name package)
@ -438,10 +447,10 @@ the latest known version of ~a (~a)~%")
;; Distinguish between "no updater" and "failing updater."
(match (lookup-updater package updaters)
((? upstream-updater? updater)
(if (update-spec-version update-spec)
(if version
(warning (G_ "'~a' updater failed to find version ~a of '~a'~%")
(upstream-updater-name updater)
(update-spec-version update-spec)
version
(package-name package))
(warning (package-location package)
(G_ "'~a' updater failed to determine available \
@ -449,7 +458,7 @@ releases for ~a~%")
(upstream-updater-name updater)
(package-name package))))
(#f
(warn-no-updater package)))))))
(warn-no-updater package)))))))))
;;;
@ -634,10 +643,9 @@ all are dependent packages: ~{~a~^ ~}~%")
(compose location-line
spec->location)))))
(for-each
(lambda (update)
(lambda (spec)
(update-package store
(update-spec-package update)
(update-spec-version update)
spec
updaters
#:key-server (%openpgp-key-server)
#:key-download key-download

26
guix/upstream.scm
View file

@ -263,16 +263,17 @@ them matches."
(define* (package-latest-release package
#:optional
(updaters (force %updaters))
#:key (version #f))
"Return an upstream source to update PACKAGE, a <package> object, or #f if
none of UPDATERS matches PACKAGE. When several updaters match PACKAGE, try
them until one of them returns an upstream source. It is the caller's
responsibility to ensure that the returned source is newer than the current
one."
#:key version partial-version?)
"Return an <upstream-source> object to update PACKAGE, a <package> object,
or #f if none of UPDATERS matches PACKAGE. When several updaters match
PACKAGE, try them until one of them returns an upstream source. It is the
caller's responsibility to ensure that the returned source is newer than the
current one."
(any (match-lambda
(($ <upstream-updater> name description pred import)
(and (pred package)
(import package #:version version))))
(import package #:version version
#:partial-version? partial-version?))))
updaters))
(define* (package-latest-release* package
@ -511,7 +512,7 @@ SOURCE, an <upstream-source>."
(define* (package-update store package
#:optional (updaters (force %updaters))
#:key (version #f)
#:key version partial-version?
(key-download 'auto) key-server)
"Return the new version, the file name of the new version tarball, and input
changes for PACKAGE; return #f (three values) when PACKAGE is up-to-date;
@ -520,8 +521,13 @@ KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
values: 'always', 'auto' (default), 'never', and 'interactive'.
When VERSION is specified, update PACKAGE to that version, even if that is a
downgrade."
(match (package-latest-release package updaters #:version version)
downgrade. When PARTIAL-VERSION? is true, treat VERSION as having been only
partially specified, in which case the package will be updated to the newest
compatible version if there are no exact match for VERSION. For example,
providing \"46\" as the version may update the package to version \"46.6.4\"."
(match (package-latest-release package updaters
#:version version
#:partial-version? partial-version?)
((? upstream-source? source)
(if (or (version>? (upstream-source-version source)
(package-version package))

22
tests/gem.scm
View file

@ -49,6 +49,25 @@
\"licenses\": [\"MIT\", \"Apache 2.0\"]
}")
(define test-foo-versions-json
"[{\"authors\": \" Maxim \",
\"built_at\": \"2012-10-24T00:00:00.000Z\",
\"created_at\": \"2012-11-03T07:41:49.007Z\",
\"description\": \"test gem\",
\"downloads_count\" :9195,
\"metadata\": {\"homepage_uri\":\"\"},
\"number\": \"1.0.0\",
\"summary\": \"foo!!!\",
\"platform\": \"ruby\",
\"rubygems_version\": \"\u003e= 0\",
\"ruby_version\": null,
\"priceless\": false,
\"licenses\": null,
\"requirements\": null,
\"sha\": \"523009a5b977f79c8eaa79b521e416f26482bc4fbbcc04bd08580696e303a715\",
\"spec_sha\": \"c7cf42bac0d01eb12b68294d1cdb4e20e7cb222ca958ad70ed1e9a686b551819\"
}]")
(define test-foo-v2-json
"{
\"name\": \"foo\",
@ -273,6 +292,9 @@
("https://rubygems.org/api/v1/gems/foo.json"
(values (open-input-string test-foo-json)
(string-length test-foo-json)))
("https://rubygems.org/api/v1/versions/foo.json"
(values (open-input-string test-foo-versions-json)
(string-length test-foo-versions-json)))
(_ (error "Unexpected URL: " url)))))
(let ((source (package-latest-release
(dummy-package "ruby-foo"

65
tests/gnu-maintenance.scm
View file

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2023-2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -26,6 +27,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
#:use-module ((web client) #:select (current-http-proxy))
#:use-module ((web uri) #:select (uri? uri->string))
#:use-module (ice-9 match))
(test-begin "gnu-maintenance")
@ -157,11 +159,17 @@ submodules/qtbase-everywhere-src-6.5.2.tar.xz"
(rewrite-url "https://download.qt.io/official_releases/qt/6.3/6.3.2/\
submodules/qtbase-everywhere-src-6.3.2.tar.xz" "6.3.2" #:to-version "6.5.2"))
(test-equal "rewrite-url, without to-version"
"http://dist.libuv.example.org/dist/v1.46.0/libuv-v1.46.0.tar.gz"
(with-http-server
;; First reply, crawling http://dist.libuv.example.org/dist/.
`((200 "\
(define (mock-http-fetch/cached testcase)
(lambda (url . rest)
(let* ((url (if (uri? url)
(uri->string url)
url))
(body (assoc-ref testcase url)))
(if body
(open-input-string body)
(error "mocked http-fetch Unexpected URL: " url)))))
(define libuv-dist-html "\
<!DOCTYPE html>
<html>
<head><title>Index of dist</title></head>
@ -174,8 +182,8 @@ submodules/qtbase-everywhere-src-6.3.2.tar.xz" "6.3.2" #:to-version "6.5.2"))
<a href=\"v1.46.0/\" title=\"v1.46.0/\">v1.46.0/</a>
</body>
</html>")
;; Second reply, crawling http://dist.libuv.example.org/dist/v1.46.0/.
(200 "\
(define libuv-dist-1.46.0-html "\
<!DOCTYPE html>
<html>
<head><title>Index of dist/v1.46.0</title></head>
@ -190,9 +198,44 @@ submodules/qtbase-everywhere-src-6.3.2.tar.xz" "6.3.2" #:to-version "6.5.2"))
<a href=\"libuv-v1.46.0.tar.gz.sign\" title=\"libuv-v1.46.0.tar.gz.sign\">
libuv-v1.46.0.tar.gz.sign</a>
</body>
</html>"))
(parameterize ((current-http-proxy (%local-url)))
(rewrite-url "http://dist.libuv.example.org/dist/v1.45.0/libuv-v1.45.0.tar.gz"
"1.45.0"))))
</html>")
(define libuv-dist-1.44.2-html "\
<!DOCTYPE html>
<html>
<head><title>Index of dist/v1.44.2</title></head>
<body>
<a href=\"../\">../</a>
<a href=\"libuv-v1.44.2-dist.tar.gz\" title=\"libuv-v1.44.2-dist.tar.gz\">
libuv-v1.44.2-dist.tar.gz</a>
<a href=\"libuv-v1.44.2-dist.tar.gz.sign\" title=\"libuv-v1.44.2-dist.tar.gz.sign\">
libuv-v1.44.2-dist.tar.gz.sign</a>
<a href=\"libuv-v1.44.2.tar.gz\" title=\"libuv-v1.44.2.tar.gz\">
libuv-v1.44.2.tar.gz</a>
<a href=\"libuv-v1.44.2.tar.gz.sign\" title=\"libuv-v1.44.2.tar.gz.sign\">
libuv-v1.44.2.tar.gz.sign</a>
</body>
</html>")
(define libuv-html-data
`(("http://dist.libuv.example.org/dist" . ,libuv-dist-html)
("http://dist.libuv.example.org/dist/v1.44.2" . ,libuv-dist-1.44.2-html)
("http://dist.libuv.example.org/dist/v1.46.0" . ,libuv-dist-1.46.0-html)))
(test-equal "rewrite-url, without to-version"
"http://dist.libuv.example.org/dist/v1.46.0/libuv-v1.46.0.tar.gz"
(mock ((guix http-client) http-fetch/cached
(mock-http-fetch/cached libuv-html-data))
(rewrite-url
"http://dist.libuv.example.org/dist/v1.45.0/libuv-v1.45.0.tar.gz"
"1.45.0")))
(test-equal "rewrite-url, partial to-version"
"http://dist.libuv.example.org/dist/v1.44.2/libuv-v1.44.2.tar.gz"
(mock ((guix http-client) http-fetch/cached
(mock-http-fetch/cached libuv-html-data))
(rewrite-url
"http://dist.libuv.example.org/dist/v1.45.0/libuv-v1.45.0.tar.gz"
"1.45.0" #:to-version "1.44" #:partial-version? #t)))
(test-end)

10
tests/guix-refresh.sh
View file

@ -31,7 +31,8 @@ export GUIX_TEST_UPDATER_TARGETS
idutils_version="$(guix package -A ^idutils$ | cut -f2)"
GUIX_TEST_UPDATER_TARGETS='
(("guile" "3" (("12.5" "file:///dev/null")
("1.6.4" "file:///dev/null")))
("1.6.4" "file:///dev/null")
("3.13.3" "file:///dev/null")))
("libreoffice" "" (("1.0" "file:///dev/null")))
("idutils" "" (("'$idutils_version'" "file:///dev/null")))
("the-test-package" "" (("5.5" "file://'$PWD/$module_dir'/source"
@ -116,6 +117,13 @@ case "$(guix refresh -t test guile --target-version=2.0.0 2>&1)" in
*) false;;
esac
# Partial target version => select the newest release prefixed by it.
guix refresh -t test guile --target-version=3 # XXX: should return non-zero?
case "$(guix refresh -t test guile --target-version=3 2>&1)" in
*"would be upgraded"*"3.13.3"*) true;;
*) false;;
esac
for spec in "guile=1.6.4" "guile@3=1.6.4"
do
guix refresh -t test "$spec"

4
tests/import-git.scm
View file

@ -22,6 +22,7 @@
#:use-module (guix tests)
#:use-module (guix packages)
#:use-module (guix import git)
#:use-module ((guix import utils) #:select (find-version))
#:use-module (guix git-download)
#:use-module (guix tests git)
#:use-module (srfi srfi-1)
@ -45,6 +46,9 @@
(base32
"0000000000000000000000000000000000000000000000000000"))))))
(define (latest-git-tag-version package)
(find-version (map car ((@@ (guix import git) get-package-tags) package))))
(test-equal "latest-git-tag-version: no custom prefix, suffix, and delimiter"
"1.0.1"
(with-temporary-git-repository directory