From patchwork Sat Mar 11 20:11:52 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 47908 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 891C516BA9; Sat, 11 Mar 2023 20:12:16 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.0 required=5.0 tests=MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id E68D616A59 for ; Sat, 11 Mar 2023 20:12:14 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pb5ZU-0006we-Ix; Sat, 11 Mar 2023 15:12:04 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pb5ZT-0006wB-1K for guix-patches@gnu.org; Sat, 11 Mar 2023 15:12:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pb5ZS-0001aI-PW for guix-patches@gnu.org; Sat, 11 Mar 2023 15:12:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pb5ZS-0007Fi-Ag for guix-patches@gnu.org; Sat, 11 Mar 2023 15:12:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#62129] [PATCH] guix: Improve download-nar. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 11 Mar 2023 20:12:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 62129 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 62129@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.167856552127869 (code B ref -1); Sat, 11 Mar 2023 20:12:02 +0000 Received: (at submit) by debbugs.gnu.org; 11 Mar 2023 20:12:01 +0000 Received: from localhost ([127.0.0.1]:58729 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pb5ZQ-0007FR-Qx for submit@debbugs.gnu.org; Sat, 11 Mar 2023 15:12:01 -0500 Received: from lists.gnu.org ([209.51.188.17]:42742) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pb5ZO-0007FJ-NG for submit@debbugs.gnu.org; Sat, 11 Mar 2023 15:11:59 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pb5ZO-0006vt-DP for guix-patches@gnu.org; Sat, 11 Mar 2023 15:11:58 -0500 Received: from mira.cbaines.net ([212.71.252.8]) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pb5ZM-0001WY-EI for guix-patches@gnu.org; Sat, 11 Mar 2023 15:11:58 -0500 Received: from localhost (unknown [IPv6:2a02:8010:68c1:0:3a91:a0a4:ecee:f157]) by mira.cbaines.net (Postfix) with ESMTPSA id 1786716454 for ; Sat, 11 Mar 2023 20:11:54 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 7f24a7cd for ; Sat, 11 Mar 2023 20:11:52 +0000 (UTC) From: Christopher Baines Date: Sat, 11 Mar 2023 20:11:52 +0000 Message-Id: <20230311201152.18865-1-mail@cbaines.net> X-Mailer: git-send-email 2.39.1 MIME-Version: 1.0 Received-SPF: pass client-ip=212.71.252.8; envelope-from=mail@cbaines.net; helo=mira.cbaines.net X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, UNPARSEABLE_RELAY=0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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 --- guix/android-repo-download.scm | 6 ++- guix/build/download-nar.scm | 73 ++++++++++++---------------------- guix/cvs-download.scm | 6 +-- guix/git-download.scm | 6 +-- guix/hg-download.scm | 6 +-- 5 files changed, 39 insertions(+), 58 deletions(-) diff --git a/guix/android-repo-download.scm b/guix/android-repo-download.scm index 1c3502e673..544c5c8be2 100644 --- a/guix/android-repo-download.scm +++ b/guix/android-repo-download.scm @@ -81,6 +81,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)) @@ -102,7 +105,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) diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm index 867f3c10bb..7de447c61a 100644 --- a/guix/build/download-nar.scm +++ b/guix/build/download-nar.scm @@ -20,7 +20,7 @@ (define-module (guix build download-nar) #:use-module (guix build download) #:use-module (guix build utils) #: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) @@ -42,52 +42,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 @@ -109,17 +78,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)))) diff --git a/guix/cvs-download.scm b/guix/cvs-download.scm index 943d971622..22af2461e9 100644 --- a/guix/cvs-download.scm +++ b/guix/cvs-download.scm @@ -61,8 +61,8 @@ (define* (cvs-fetch ref hash-algo hash "Return a fixed-output derivation that fetches REF, a 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)) diff --git a/guix/git-download.scm b/guix/git-download.scm index 3dc306e39d..027ef47468 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -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) diff --git a/guix/hg-download.scm b/guix/hg-download.scm index 382c34922a..8d71553bee 100644 --- a/guix/hg-download.scm +++ b/guix/hg-download.scm @@ -73,8 +73,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)) @@ -91,7 +91,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'