diff options
author | Efraim Flashner <efraim@flashner.co.il> | 2021-03-24 15:28:33 +0200 |
---|---|---|
committer | Efraim Flashner <efraim@flashner.co.il> | 2021-03-24 20:50:44 +0200 |
commit | 2aab587f842908a886e3bd08b028885dddd650e0 (patch) | |
tree | 87c0723a9ae2c69ab6920d90b6e87ad8510492fe /guix/build/download.scm | |
parent | 5664bcdcb0e4c10dfe48dd5e4730fc3c746a21e2 (diff) | |
parent | 65c46e79e0495fe4d32f6f2725d7233fff10fd70 (diff) | |
download | guix-patches-2aab587f842908a886e3bd08b028885dddd650e0.tar guix-patches-2aab587f842908a886e3bd08b028885dddd650e0.tar.gz |
Merge remote-tracking branch 'origin/master' into core-updates
Diffstat (limited to 'guix/build/download.scm')
-rw-r--r-- | guix/build/download.scm | 40 |
1 files changed, 27 insertions, 13 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm index 46af149b2f..a22d4064ca 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; @@ -28,7 +28,6 @@ #:use-module (guix build utils) #:use-module (guix progress) #:use-module (rnrs io ports) - #:use-module ((ice-9 binary-ports) #:select (unget-bytevector)) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) @@ -306,14 +305,22 @@ host name without trailing dot." (let ((record (session-record-port session))) (define (read! bv start count) - (define read-bv (get-bytevector-some record)) - (if (eof-object? read-bv) - 0 ; read! returns 0 on eof-object - (let ((read-bv-len (bytevector-length read-bv))) - (bytevector-copy! read-bv 0 bv start (min read-bv-len count)) - (when (< count read-bv-len) - (unget-bytevector record bv count (- read-bv-len count))) - read-bv-len))) + (define read + (catch 'gnutls-error + (lambda () + (get-bytevector-n! record bv start count)) + (lambda (key err proc . rest) + ;; When responding to "Connection: close" requests, some + ;; servers close the connection abruptly after sending the + ;; response body, without doing a proper TLS connection + ;; termination. Treat it as EOF. + (if (eq? err error/premature-termination) + the-eof-object + (apply throw key err proc rest))))) + + (if (eof-object? read) + 0 + read)) (define (write! bv start count) (put-bytevector record bv start count) (force-output record) @@ -328,17 +335,24 @@ host name without trailing dot." (unless (port-closed? record) (close-port record))) + (define (unbuffered port) + (setvbuf port 'none) + port) + (setvbuf record 'block) ;; Return a port that wraps RECORD to ensure that closing it also ;; closes PORT, the actual socket port, and its file descriptor. + ;; Make sure it does not introduce extra buffering (custom ports + ;; are buffered by default as of Guile 3.0.5). ;; XXX: This wrapper would be unnecessary if GnuTLS could ;; automatically close SESSION's file descriptor when RECORD is ;; closed, but that doesn't seem to be possible currently (as of ;; 3.6.9). - (make-custom-binary-input/output-port "gnutls wrapped port" read! write! - get-position set-position! - close)))) + (unbuffered + (make-custom-binary-input/output-port "gnutls wrapped port" read! write! + get-position set-position! + close))))) (define (ensure-uri uri-or-string) ;XXX: copied from (web http) (cond |