[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/03: web: Do not wrap TLS port on GnuTLS >= 3.7.7.
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] 01/03: web: Do not wrap TLS port on GnuTLS >= 3.7.7. |
|
Date: |
Thu, 4 Aug 2022 10:03:36 -0400 (EDT) |
civodul pushed a commit to branch main
in repository guile.
commit c01ca10b3f175ec7d116f8d2832f438dd4279253
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Aug 4 15:19:30 2022 +0200
web: 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.
Backported from Guix commit dd573ceea73295c7a872088ecd91e5f0fd74bf2b.
* web/client.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'.
---
module/web/client.scm | 110 +++++++++++++++++++++++++-------------------------
1 file changed, 55 insertions(+), 55 deletions(-)
diff --git a/module/web/client.scm b/module/web/client.scm
index 3bd22f81b..d3356361f 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -1,6 +1,6 @@
;;; Web client
-;; Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2020, 2021
Free Software Foundation, Inc.
+;; Copyright (C) 2011-2018, 2020-2022 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -171,6 +171,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."
@@ -236,62 +284,14 @@ host name without trailing dot."
(close-port port)
(apply throw args))))
- ;; FIXME: It appears that session-record-port is entirely
- ;; sufficient; it's already a port. The only value of this code is
- ;; to keep a reference on "port", to keep it alive! To fix this we
- ;; need to arrange to either hand GnuTLS its own fd to close, or to
- ;; arrange a reference from the session-record-port to the
- ;; underlying socket.
(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)
- (rnrs-ports:port-position record))
- (define (set-position! new-position)
- (rnrs-ports: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).
- ;; 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-reference uri-or-string)
(cond