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:
parent
0e305e6bfd
commit
bf4e8f911e
1 changed files with 13 additions and 25 deletions
|
@ -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))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue