I'm looking at this since it's used in (web response)
read-response-body.
* module/ice-9/suspendable-ports.scm (get-bytevector-all): New
procedure.
(port-bindings): Add it.
---
module/ice-9/suspendable-ports.scm | 36 ++++++++++++++++++++++++++++++
1 file changed, 36 insertions(+)
diff --git a/module/ice-9/suspendable-ports.scm
b/module/ice-9/suspendable-ports.scm
index 9fac1df62..e5b3de982 100644
--- a/module/ice-9/suspendable-ports.scm
+++ b/module/ice-9/suspendable-ports.scm
@@ -50,6 +50,7 @@
(define-module (ice-9 suspendable-ports)
#:use-module (rnrs bytevectors)
+ #:use-module (rnrs bytevectors gnu)
#:use-module (ice-9 ports internal)
#:use-module (ice-9 match)
#:export (current-read-waiter
@@ -342,6 +343,40 @@
(set-port-buffer-cur! buf (+ cur transfer-size))
transfer-size))))))
+(define (get-bytevector-all port)
+ (define %initial-length 4096)
+
+ (let read-loop ((total 0)
+ (result-length %initial-length)
+ (result (make-bytevector %initial-length)))
+ (call-with-values (lambda () (fill-input port 1 'binary))
+ (lambda (buf cur buffered)
+ (if (zero? buffered)
+ (begin
+ (set-port-buffer-has-eof?! buf #f)
+ (if (= total 0)
+ the-eof-object
+ (bytevector-slice result 0 total)))
+ (let* ((new-total (+ total buffered))
+ (new-result-length
+ (let loop ((new-result-length result-length))
+ (if (< new-total new-result-length)
+ new-result-length
+ (loop (* 2 new-result-length)))))
+ (new-result
+ (if (= new-result-length result-length)
+ result
+ (let ((new-result (make-bytevector new-result-length)))
+ (bytevector-copy! result 0 new-result 0 total)
+ new-result))))
+ (bytevector-copy! (port-buffer-bytevector buf) cur
+ new-result total
+ buffered)
+ (set-port-buffer-cur! buf (+ cur buffered))
+ (read-loop new-total
+ new-result-length
+ new-result)))))))
+
(define (put-u8 port byte)
(let* ((buf (port-write-buffer port))
(bv (port-buffer-bytevector buf))
@@ -754,6 +789,7 @@
((ice-9 binary-ports)
get-u8 lookahead-u8 get-bytevector-n get-bytevector-n!
get-bytevector-some get-bytevector-some!
+ get-bytevector-all
put-u8 put-bytevector)
((ice-9 textual-ports)
put-char put-string)
--
2.41.0
