mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-28 16:00:22 +02:00
fix read-{request,response}-body/latin-1
* module/web/request.scm (read-response-body/latin-1): * module/web/response.scm (read-response-body/latin-1): Avoid the craziness of the read-delimited! interface and hand-roll our own. Fixes errors if read-delimited returns #f or EOF.
This commit is contained in:
parent
e7fb779fb0
commit
e46f69e25c
2 changed files with 37 additions and 17 deletions
|
@ -192,15 +192,25 @@
|
|||
;; Probably not what you want to use "in production". Relies on one byte
|
||||
;; per char because we are in latin-1 encoding.
|
||||
;;
|
||||
(define (read-request-body/latin-1 r)
|
||||
(let ((nbytes (request-content-length r)))
|
||||
(and nbytes
|
||||
(let* ((buf (make-string nbytes))
|
||||
(n (read-delimited! "" buf (request-port r))))
|
||||
(if (= n nbytes)
|
||||
buf
|
||||
(bad-request "EOF while reading request body: ~a bytes of ~a"
|
||||
n nbytes))))))
|
||||
(define (read-response-body/latin-1 r)
|
||||
(cond
|
||||
((request-content-length r) =>
|
||||
(lambda (nbytes)
|
||||
(let ((buf (make-string nbytes))
|
||||
(port (request-port r)))
|
||||
(let lp ((i 0))
|
||||
(cond
|
||||
((< i nbytes)
|
||||
(let ((c (read-char port)))
|
||||
(cond
|
||||
((eof-object? c)
|
||||
(bad-request "EOF while reading request body: ~a bytes of ~a"
|
||||
i nbytes))
|
||||
(else
|
||||
(string-set! buf i c)
|
||||
(lp (1+ i))))))
|
||||
(else buf))))))
|
||||
(else #f)))
|
||||
|
||||
;; Likewise, assumes that body can be written in the latin-1 encoding,
|
||||
;; and that the latin-1 encoding is what is expected by the server.
|
||||
|
|
|
@ -185,14 +185,24 @@
|
|||
;; per char because we are in latin-1 encoding.
|
||||
;;
|
||||
(define (read-response-body/latin-1 r)
|
||||
(let ((nbytes (response-content-length r)))
|
||||
(and nbytes
|
||||
(let* ((buf (make-string nbytes))
|
||||
(n (read-delimited! "" buf (response-port r))))
|
||||
(if (= n nbytes)
|
||||
buf
|
||||
(bad-response "EOF while reading response body: ~a bytes of ~a"
|
||||
n nbytes))))))
|
||||
(cond
|
||||
((response-content-length r) =>
|
||||
(lambda (nbytes)
|
||||
(let ((buf (make-string nbytes))
|
||||
(port (response-port r)))
|
||||
(let lp ((i 0))
|
||||
(cond
|
||||
((< i nbytes)
|
||||
(let ((c (read-char port)))
|
||||
(cond
|
||||
((eof-object? c)
|
||||
(bad-response "EOF while reading response body: ~a bytes of ~a"
|
||||
i nbytes))
|
||||
(else
|
||||
(string-set! buf i c)
|
||||
(lp (1+ i))))))
|
||||
(else buf))))))
|
||||
(else #f)))
|
||||
|
||||
;; Likewise, assumes that body can be written in the latin-1 encoding,
|
||||
;; and that the latin-1 encoding is what is expected by the server.
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue