summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-08-01 11:01:52 +0200
committerLudovic Courtès <ludo@gnu.org>2022-08-03 17:43:29 +0200
commitdd573ceea73295c7a872088ecd91e5f0fd74bf2b (patch)
tree50de6f5e8b3387837e1e2929e87becdece592112 /guix
parent2eb2501d66d4f0d40e77aac6b0a15d5872f5848b (diff)
download: Do not wrap TLS port on GnuTLS >= 3.7.7.
The custom input/output port wrapping the TLS session record port would introduce overhead, and it would also prevent its uses in a non-blocking context--e.g., with Fibers. The port close mechanism added in GnuTLS 3.7.7 allows us to get rid of that wrapper. * guix/build/download.scm (wrap-record-port-for-gnutls<3.7.7): New procedure, with code formerly in 'tls-wrap'. (tls-wrap): Check for 'set-session-record-port-close!' and use it when available; otherwise call 'wrap-record-port-for-gnutls<3.7.7'.
Diffstat (limited to 'guix')
-rw-r--r--guix/build/download.scm102
1 files changed, 54 insertions, 48 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 951ca3a57a..db0a39084b 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -245,6 +245,54 @@ way."
(set-exception-printer! 'tls-certificate-error
print-tls-certificate-error)
+(define (wrap-record-port-for-gnutls<3.7.7 record port)
+ "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).
+
+This wrapper is unnecessary with GnuTLS >= 3.7.7, which can automatically
+close SESSION's file descriptor when RECORD is closed."
+ (define (read! bv start count)
+ (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. This is fixed in GnuTLS 3.7.7.
+ (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)
+ count)
+ (define (get-position)
+ (port-position record))
+ (define (set-position! new-position)
+ (set-port-position! record new-position))
+ (define (close)
+ (unless (port-closed? port)
+ (close-port port))
+ (unless (port-closed? record)
+ (close-port record)))
+
+ (define (unbuffered port)
+ (setvbuf port 'none)
+ port)
+
+ (unbuffered
+ (make-custom-binary-input/output-port "gnutls wrapped port" read! write!
+ get-position set-position!
+ close)))
+
(define* (tls-wrap port server #:key (verify-certificate? #t))
"Return PORT wrapped in a TLS connection to SERVER. SERVER must be a DNS
host name without trailing dot."
@@ -317,55 +365,13 @@ host name without trailing dot."
(apply throw args))))
(let ((record (session-record-port session)))
- (define (read! bv start count)
- (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)
- count)
- (define (get-position)
- (port-position record))
- (define (set-position! new-position)
- (set-port-position! record new-position))
- (define (close)
- (unless (port-closed? port)
- (close-port port))
- (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).
- (unbuffered
- (make-custom-binary-input/output-port "gnutls wrapped port" read! write!
- get-position set-position!
- close)))))
+ (if (module-defined? (resolve-interface '(gnutls))
+ 'set-session-record-port-close!) ;GnuTLS >= 3.7.7
+ (let ((close-wrapped-port (lambda (_) (close-port port))))
+ (set-session-record-port-close! record close-wrapped-port)
+ record)
+ (wrap-record-port-for-gnutls<3.7.7 record port)))))
(define (ensure-uri uri-or-string) ;XXX: copied from (web http)
(cond