download: Disarchive mirrors can be URL-returning procedures.

As discussed at <https://issues.guix.gnu.org/47336#16>.

* guix/build/download.scm (url-fetch)[disarchive-uris]: Accept MIRROR as
a procedure.
* guix/download.scm (%disarchive-mirrors): Add comment.  This change can
only be made once a 'guix perform-download' that understands procedures
is widely deployed.
This commit is contained in:
Ludovic Courtès 2021-09-14 10:11:42 +02:00
parent 67da646087
commit 3cb5ae8577
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 16 additions and 9 deletions

View file

@ -747,15 +747,20 @@ (define content-addressed-uris
content-addressed-mirrors)) content-addressed-mirrors))
(define disarchive-uris (define disarchive-uris
(append-map (match-lambda (append-map (lambda (mirror)
((? string? mirror) (let ((make-url (match mirror
(map (match-lambda ((? string?)
((hash-algo . hash) (lambda (hash-algo hash)
(string->uri (string-append
(string-append mirror mirror
(symbol->string hash-algo) "/" (symbol->string hash-algo) "/"
(bytevector->base16-string hash))))) (bytevector->base16-string hash))))
hashes))) ((? procedure?)
mirror))))
(map (match-lambda
((hash-algo . hash)
(string->uri (make-url hash-algo hash))))
hashes)))
disarchive-mirrors)) disarchive-mirrors))
;; Make this unbuffered so 'progress-report/file' works as expected. 'line ;; Make this unbuffered so 'progress-report/file' works as expected. 'line

View file

@ -400,6 +400,8 @@ (define %content-addressed-mirror-file
(object->string %content-addressed-mirrors))) (object->string %content-addressed-mirrors)))
(define %disarchive-mirrors (define %disarchive-mirrors
;; TODO: Eventually turn into a procedure that takes a hash algorithm
;; (symbol) and hash (bytevector).
'("https://disarchive.ngyro.com/")) '("https://disarchive.ngyro.com/"))
(define %disarchive-mirror-file (define %disarchive-mirror-file