As described in the GnuTLS documentation on Asynchronous operation, GNUTLS_NONBLOCK should be passed to gnutls_init, and the Guile equivalent is passing connection-flag/nonblock to make-session.
Additionally, error/again or error/interrupted should lead to a retry of the handshake, after waiting for the appropriate I/O on the port. As record-get-direction is new in Guile-GnuTLS, specifically check if this is defined. * module/web/client.scm (tls-wrap): Call make-session with connection-flag/nonblock if the port is non-blocking, and handle waiting for I/O when performing the handshake. --- module/web/client.scm | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/module/web/client.scm b/module/web/client.scm index f26b5d259..caf8e5f35 100644 --- a/module/web/client.scm +++ b/module/web/client.scm @@ -33,6 +33,7 @@ (define-module (web client) #:use-module (rnrs bytevectors) + #:use-module (ice-9 suspendable-ports) #:use-module (ice-9 binary-ports) #:use-module (ice-9 copy-tree) #:use-module (ice-9 iconv) @@ -225,7 +226,14 @@ host name without trailing dot." (load-gnutls) - (let ((session (make-session connection-end/client)) + (let ((session + (apply + make-session + (cons connection-end/client + (if (zero? (logand O_NONBLOCK (fcntl port F_GETFL))) + '() + ;; If the port is non-blocking, tell GnuTLS + (list connection-flag/nonblock))))) (ca-certs (x509-certificate-directory))) ;; Some servers such as 'cloud.github.com' require the client to support ;; the 'SERVER NAME' extension. However, 'set-session-server-name!' is @@ -261,7 +269,19 @@ host name without trailing dot." (lambda () (handshake session)) (lambda (key err proc . rest) - (cond ((eq? err error/warning-alert-received) + (cond ((and + (or (eq? err error/again) + (eq? err error/interrupted)) + (module-defined? (resolve-interface '(gnutls)) + 'record-get-direction)) ; Guile-GnuTLS >= 4.0.0 + (if (= 0 (record-get-direction session)) + ((current-read-waiter) port) + ((current-write-waiter) port)) + + ;; These errors are expected and just signal that + ;; GnuTLS was interrupted, so don't count the retry + (loop retries)) + ((eq? err error/warning-alert-received) ;; Like Wget, do no stop upon non-fatal alerts such as ;; 'alert-description/unrecognized-name'. (format (current-error-port) -- 2.41.0