mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

web: 'tls-wrap' avoids intermediate buffer.

Browse source 
This mirrors Guix commit 279d932b1ca7bfbb8657c41a84616dd0dfc6e0a8.

* module/web/client.scm (tls-wrap)[read!]:  Read straight into BV
instead of calling 'get-bytevector-some' and 'unget-bytevector'.
This commit is contained in:
Ludovic Courtès 2021-03-19 14:08:58 +01:00
parent ef7952984c
commit e4f54d4b32
1 changed files with 7 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

17
module/web/client.scm
View file

@ -1,6 +1,6 @@
;;; Web client ;;; Web client
;; Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2020 Free Software Foundation, Inc. ;; Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2020, 2021 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -244,10 +244,10 @@ host name without trailing dot."
;; underlying socket. ;; underlying socket.
(let ((record (session-record-port session))) (let ((record (session-record-port session)))
(define (read! bv start count) (define (read! bv start count)
(define read-bv (define read
(catch 'gnutls-error (catch 'gnutls-error
(lambda () (lambda ()
(get-bytevector-some record)) (get-bytevector-n! record bv start count))
(lambda (key err proc . rest) (lambda (key err proc . rest)
;; When responding to "Connection: close" requests, some ;; When responding to "Connection: close" requests, some
;; servers close the connection abruptly after sending the ;; servers close the connection abruptly after sending the
@ -256,13 +256,10 @@ host name without trailing dot."
(if (eq? err error/premature-termination) (if (eq? err error/premature-termination)
the-eof-object the-eof-object
(apply throw key err proc rest))))) (apply throw key err proc rest)))))
(if (eof-object? read-bv)
0 ; read! returns 0 on eof-object (if (eof-object? read)
(let ((read-bv-len (bytevector-length read-bv))) 0
(bytevector-copy! read-bv 0 bv start (min read-bv-len count)) read))
(when (< count read-bv-len)
(unget-bytevector record bv count (- read-bv-len count)))
read-bv-len)))
(define (write! bv start count) (define (write! bv start count)
(put-bytevector record bv start count) (put-bytevector record bv start count)
(force-output record) (force-output record)