mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

web: 'tls-wrap' returns an unbuffered custom port.

Browse source 
This mirrors Guix commit b168acae2a01fd84075cc134a6140594a978fde5.

* module/web/client.scm (tls-wrap)[unbuffered]: New procedure.
Pass the result of 'make-custom-binary-input/output-port' to
'unbuffered'.
This commit is contained in:
Ludovic Courtès 2021-03-19 14:13:31 +01:00
parent e4f54d4b32
commit c92f2c7df0
1 changed files with 10 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

13
module/web/client.scm
View file

@ -274,17 +274,24 @@ host name without trailing dot."
(unless (port-closed? record) (unless (port-closed? record)
(close-port record))) (close-port record)))
(define (unbuffered port)
(setvbuf port 'none)
port)
(setvbuf record 'block) (setvbuf record 'block)
;; Return a port that wraps RECORD to ensure that closing it also ;; Return a port that wraps RECORD to ensure that closing it also
;; closes PORT, the actual socket port, and its file descriptor. ;; 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 ;; XXX: This wrapper would be unnecessary if GnuTLS could
;; automatically close SESSION's file descriptor when RECORD is ;; automatically close SESSION's file descriptor when RECORD is
;; closed, but that doesn't seem to be possible currently (as of ;; closed, but that doesn't seem to be possible currently (as of
;; 3.6.9). ;; 3.6.9).
(make-custom-binary-input/output-port "gnutls wrapped port" read! write! (unbuffered
get-position set-position! (make-custom-binary-input/output-port "gnutls wrapped port" read! write!
close)))) get-position set-position!
close)))))
(define (ensure-uri-reference uri-or-string) (define (ensure-uri-reference uri-or-string)
(cond (cond