ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-12 14:16:55 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix: Improve download-nar.

Browse source 
Previously download-nar worked with gzipped nars and queried
berlin.guix.gnu.org (also known as ci.guix.gnu.org). ci.guix.gnu.org no longer
serves gzipped nars so this is of limited use.

This commit changes download-nar to query both the default substitute servers,
and queries for lzipped rather than gzipped nars, since those are available
from both.

* guix/build/download-nar.scm (urls-for-item): Return urls for lzip rather
than gzip compression, and from both default substitute servers. The comment
about CDN's is no longer relevant.
(restore-gzipped-nar): Rename to restore-lzipped-nar and reimplement
accordingly.
(download-nar): Add progress reporting and switch to use lzip rather than
gzip.
* guix/cvs-download.scm (cvs-fetch): Replace guile-zlib with guile-lzlib.
* guix/git-download.scm (git-fetch): Replace guile-zlib with guile-lzlib.
* guix/hg-download.scm (hg-fetch): Replace guile-zlib with guile-lzlib.
* guix/android-repo-download.scm (android-repo-fetch): Add guile-lzlib for
download-nar.

Signed-off-by: Christopher Baines <mail@cbaines.net>
This commit is contained in:
Christopher Baines 2023-03-11 19:43:29 +00:00
parent b68d4118e7
commit b59f89cf18
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577
5 changed files with 39 additions and 58 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
guix/android-repo-download.scm
View file

@ -78,6 +78,9 @@ (define zlib
(define guile-json
(module-ref (resolve-interface '(gnu packages guile)) 'guile-json-4))
(define guile-lzlib
(module-ref (resolve-interface '(gnu packages guile)) 'guile-lzlib))
(define gnutls
(module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
@ -99,7 +102,8 @@ (define modules
(define build
(with-imported-modules modules
(with-extensions (list gnutls guile-json) ;for (guix swh)
(with-extensions (list gnutls guile-json ;for (guix swh)
guile-lzlib)
#~(begin
(use-modules (guix build android-repo)
(guix build utils)

73
guix/build/download-nar.scm
View file

@ -19,7 +19,7 @@
(define-module (guix build download-nar)
#:use-module (guix build download)
#:use-module ((guix serialization) #:hide (dump-port*))
#:autoload (zlib) (call-with-gzip-input-port)
#:autoload (lzlib) (call-with-lzip-input-port)
#:use-module (guix progress)
#:use-module (web uri)
#:use-module (srfi srfi-11)
@ -41,52 +41,21 @@ (define (urls-for-item item)
"Return the fallback nar URL for ITEM--e.g.,
\"/gnu/store/cabbag3…-foo-1.2-checkout\"."
;; Here we hard-code nar URLs without checking narinfos. That's probably OK
;; though. Use berlin.guix.gnu.org instead of its ci.guix.gnu.org front end to
;; avoid sending these requests to CDN providers without user consent.
;; though.
;; TODO: Use HTTPS? The downside is the extra dependency.
(let ((bases '("http://berlin.guix.gnu.org"))
(let ((bases '("http://bordeaux.guix.gnu.org"
"http://ci.guix.gnu.org"))
(item (basename item)))
(append (map (cut string-append <> "/nar/gzip/" item) bases)
(append (map (cut string-append <> "/nar/lzip/" item) bases)
(map (cut string-append <> "/nar/" item) bases))))
(define (restore-gzipped-nar port item size)
"Restore the gzipped nar read from PORT, of SIZE bytes (compressed), to
(define (restore-lzipped-nar port item size)
"Restore the lzipped nar read from PORT, of SIZE bytes (compressed), to
ITEM."
;; Since PORT is typically a non-file port (for instance because 'http-get'
;; returns a delimited port), create a child process so we're back to a file
;; port that can be passed to 'call-with-gzip-input-port'.
(match (pipe)
((input . output)
(match (primitive-fork)
(0
(dynamic-wind
(const #t)
(lambda ()
(close-port output)
(close-port port)
(catch #t
(lambda ()
(call-with-gzip-input-port input
(cut restore-file <> item)))
(lambda (key . args)
(print-exception (current-error-port)
(stack-ref (make-stack #t) 1)
key args)
(primitive-exit 1))))
(lambda ()
(primitive-exit 0))))
(child
(close-port input)
(dump-port* port output
#:reporter (progress-reporter/file item size
#:abbreviation
store-path-abbreviation))
(close-port output)
(newline)
(match (waitpid child)
((_ . status)
(unless (zero? status)
(error "nar decompression failed" status)))))))))
(call-with-lzip-input-port port
(lambda (decompressed-port)
(restore-file decompressed-port
item))))
(define (download-nar item)
"Download and extract the normalized archive for ITEM. Return #t on
@ -108,17 +77,25 @@ (define (download-nar item)
(values #f #f)))))
(if (not port)
(loop rest)
(begin
(let* ((reporter (progress-reporter/file
url
size
(current-error-port)
#:abbreviation nar-uri-abbreviation))
(port-with-progress
(progress-report-port reporter port
#:download-size size)))
(if size
(format #t "Downloading from ~a (~,2h MiB)...~%" url
(/ size (expt 2 20.)))
(format #t "Downloading from ~a...~%" url))
(if (string-contains url "/gzip")
(restore-gzipped-nar port item size)
(if (string-contains url "/lzip")
(restore-lzipped-nar port-with-progress
item
size)
(begin
;; FIXME: Add progress report.
(restore-file port item)
(close-port port)))
(restore-file port-with-progress
item)))
#t))))
(()
#f))))

6
guix/cvs-download.scm
View file

@ -61,8 +61,8 @@ (define* (cvs-fetch ref hash-algo hash
"Return a fixed-output derivation that fetches REF, a <cvs-reference>
object. The output is expected to have recursive hash HASH of type
HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
(define guile-zlib
(module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
(define guile-lzlib
(module-ref (resolve-interface '(gnu packages guile)) 'guile-lzlib))
(define guile-json
(module-ref (resolve-interface '(gnu packages guile)) 'guile-json-4))
@ -77,7 +77,7 @@ (define modules
(define build
(with-imported-modules modules
(with-extensions (list guile-json gnutls ;for (guix swh)
guile-zlib)
guile-lzlib)
#~(begin
(use-modules (guix build cvs)
(guix build download-nar))

6
guix/git-download.scm
View file

@ -101,8 +101,8 @@ (define inputs
(define guile-json
(module-ref (resolve-interface '(gnu packages guile)) 'guile-json-4))
(define guile-zlib
(module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
(define guile-lzlib
(module-ref (resolve-interface '(gnu packages guile)) 'guile-lzlib))
(define gnutls
(module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
@ -123,7 +123,7 @@ (define modules
(define build
(with-imported-modules modules
(with-extensions (list guile-json gnutls ;for (guix swh)
guile-zlib)
guile-lzlib)
#~(begin
(use-modules (guix build git)
(guix build utils)

6
guix/hg-download.scm
View file

@ -72,8 +72,8 @@ (define inputs
("tar" ,(module-ref (resolve-interface '(gnu packages base))
'tar))))
(define guile-zlib
(module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
(define guile-lzlib
(module-ref (resolve-interface '(gnu packages guile)) 'guile-lzlib))
(define guile-json
(module-ref (resolve-interface '(gnu packages guile)) 'guile-json-4))
@ -90,7 +90,7 @@ (define modules
(define build
(with-imported-modules modules
(with-extensions (list guile-json gnutls ;for (guix swh)
guile-zlib)
guile-lzlib)
#~(begin
(use-modules (guix build hg)
(guix build utils) ;for `set-path-environment-variable'