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: Switch to SRFI-71.

Browse source 
* guix/upstream.scm (download-tarball, package-update/url-fetch): Use
SRFI-71 instead of SRFI-11.

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

35
guix/upstream.scm
View file

@ -44,7 +44,6 @@ (define-module (guix upstream)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
@ -339,12 +338,11 @@ (define* (download-tarball store url signature-url
(mbegin %store-monad (mbegin %store-monad
(built-derivations (list drv)) (built-derivations (list drv))
(return (derivation->output-path drv)))))))) (return (derivation->output-path drv))))))))
(let-values (((status data) (let ((status data (if sig
(if sig (gnupg-verify* sig data
(gnupg-verify* sig data #:server key-server
#:server key-server #:key-download key-download)
#:key-download key-download) (values 'missing-signature data))))
(values 'missing-signature data))))
(match status (match status
('valid-signature ('valid-signature
tarball) tarball)
@ -438,18 +436,17 @@ (define* (package-update/url-fetch store package source
SOURCE, an <upstream-source>." SOURCE, an <upstream-source>."
(match source (match source
(($ <upstream-source> _ version urls signature-urls) (($ <upstream-source> _ version urls signature-urls)
(let*-values (((archive-type) (let* ((archive-type (package-archive-type package))
(package-archive-type package)) (url signature-url
((url signature-url) ;; Try to find a URL that matches ARCHIVE-TYPE.
;; Try to find a URL that matches ARCHIVE-TYPE. (find2 (lambda (url sig-url)
(find2 (lambda (url sig-url) ;; Some URIs lack a file extension, like
;; Some URIs lack a file extension, like ;; 'https://crates.io/???/0.1/download'. In that
;; 'https://crates.io/???/0.1/download'. In that ;; case, pick the first URL.
;; case, pick the first URL. (or (not archive-type)
(or (not archive-type) (string-suffix? archive-type url)))
(string-suffix? archive-type url))) urls
urls (or signature-urls (circular-list #f)))))
(or signature-urls (circular-list #f)))))
;; If none of URLS matches ARCHIVE-TYPE, then URL is #f; in that case, ;; If none of URLS matches ARCHIVE-TYPE, then URL is #f; in that case,
;; pick up the first element of URLS. ;; pick up the first element of URLS.
(let ((tarball (download-tarball store (let ((tarball (download-tarball store