1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

Use custom binary output ports for make-chunked-output-port

* module/web/http.scm (make-chunked-output-port): Use custom binary
output ports.
This commit is contained in:
Andy Wingo 2023-05-26 14:07:09 +02:00
parent 0e305e6bfd
commit bf4e8f911e

View file

@ -1,6 +1,6 @@
;;; HTTP messages ;;; HTTP messages
;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Copyright (C) 2010-2017, 2023 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
@ -34,7 +34,6 @@
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 q)
#:use-module (ice-9 binary-ports) #:use-module (ice-9 binary-ports)
#:use-module (ice-9 textual-ports) #:use-module (ice-9 textual-ports)
#:use-module (ice-9 exceptions) #:use-module (ice-9 exceptions)
@ -2033,34 +2032,23 @@ BUFFERING bytes, which defaults to 1200. Take care to close the port
when done, as it will output the remaining data, and encode the final when done, as it will output the remaining data, and encode the final
zero chunk. When the port is closed it will also close PORT, unless zero chunk. When the port is closed it will also close PORT, unless
KEEP-ALIVE? is true." KEEP-ALIVE? is true."
(define (q-for-each f q) (define (write! bv start count)
(while (not (q-empty? q)) (put-string port (number->string count 16))
(f (deq! q)))) (put-string port "\r\n")
(define queue (make-q)) (put-bytevector port bv start count)
(define (%put-char c) (put-string port "\r\n")
(enq! queue c)) (force-output port)
(define (%put-string s) count)
(string-for-each (lambda (c) (enq! queue c))
s))
(define (flush)
;; It is important that we do _not_ write a chunk if the queue is
;; empty, since it will be treated as the final chunk.
(unless (q-empty? queue)
(let ((len (q-length queue)))
(put-string port (number->string len 16))
(put-string port "\r\n")
(q-for-each (lambda (elem) (put-char port elem))
queue)
(put-string port "\r\n"))))
(define (close) (define (close)
(flush)
(put-string port "0\r\n\r\n") (put-string port "0\r\n\r\n")
(force-output port) (force-output port)
(unless keep-alive? (unless keep-alive?
(close-port port))) (close-port port)))
(let ((ret (make-soft-port (vector %put-char %put-string flush #f close) "w"))) (define ret
(setvbuf ret 'block buffering) (make-custom-binary-output-port "chunked http" write! #f #f close))
ret)) (set-port-encoding! port "UTF-8")
(setvbuf ret 'block buffering)
ret)
(define %http-proxy-port? (make-object-property)) (define %http-proxy-port? (make-object-property))
(define (http-proxy-port? port) (%http-proxy-port? port)) (define (http-proxy-port? port) (%http-proxy-port? port))