mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-18 13:36:36 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

upstream: Extract ‘preferred-upstream-source-url’.

Browse source 
* guix/upstream.scm (preferred-upstream-source-url): New procedure.
(package-update/url-fetch): Use it.

Change-Id: I229cdf7668567e30ca156b3d65b77c90ead8bb05
This commit is contained in:
Ludovic Courtès 2024-12-27 11:32:34 +01:00
parent 47ef459174
commit af79677cb4
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 18 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
guix/upstream.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2010-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2010-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;;; Copyright © 2019, 2022-2024 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
@ -430,23 +430,29 @@ (define (package-archive-type package)
(string-contains extension "tar"))
extension)))))
(define (preferred-upstream-source-url source package)
"Return two values: a source URL that matches the archive type of
PACKAGE (gz, xz, bz2, etc.) and the corresponding signature URL or #f if there
is no signature. Return #f and #f when this is not applicable."
(let ((archive-type (package-archive-type package)))
(find2 (lambda (url sig-url)
;; Some URIs lack a file extension, like
;; 'https://crates.io/???/0.1/download'. In that case, pick the
;; first URL.
(or (not archive-type)
(string-suffix? archive-type url)))
(upstream-source-urls source)
(or (upstream-source-signature-urls source)
(circular-list #f)))))
(define* (package-update/url-fetch store package source
#:key key-download key-server)
"Return the version, tarball, and SOURCE, to update PACKAGE to
SOURCE, an <upstream-source>."
(match source
(($ <upstream-source> _ version urls signature-urls)
(let* ((archive-type (package-archive-type package))
(url signature-url
;; Try to find a URL that matches ARCHIVE-TYPE.
(find2 (lambda (url sig-url)
;; Some URIs lack a file extension, like
;; 'https://crates.io/???/0.1/download'. In that
;; case, pick the first URL.
(or (not archive-type)
(string-suffix? archive-type url)))
urls
(or signature-urls (circular-list #f)))))
(let ((url signature-url
(preferred-upstream-source-url source package)))
;; If none of URLS matches ARCHIVE-TYPE, then URL is #f; in that case,
;; pick up the first element of URLS.
(let ((tarball (download-tarball store