added chunked encoding
This commit is contained in:
54
request.zp
54
request.zp
@@ -22,7 +22,7 @@
|
|||||||
(set-follow-redirects (lambda (flag)
|
(set-follow-redirects (lambda (flag)
|
||||||
(set! FOLLOW-REDIRECTS flag)))
|
(set! FOLLOW-REDIRECTS flag)))
|
||||||
|
|
||||||
(parse-request (lambda (req scheme path req-headers)
|
(parse-request (lambda (req scheme path req-headers complete)
|
||||||
(let* ((split (string:split req "\r\n\r\n"))
|
(let* ((split (string:split req "\r\n\r\n"))
|
||||||
(headers (if (> (length split) 1) (string:split (car split) "\r\n") []))
|
(headers (if (> (length split) 1) (string:split (car split) "\r\n") []))
|
||||||
(body (if (truthy? headers) (string:join (cdr split) #\newline) (car split)))
|
(body (if (truthy? headers) (string:join (cdr split) #\newline) (car split)))
|
||||||
@@ -38,10 +38,35 @@
|
|||||||
:http http-version
|
:http http-version
|
||||||
:path path
|
:path path
|
||||||
:status-message message)))
|
:status-message message)))
|
||||||
(if (and (eq? (res :status) 302) FOLLOW-REDIRECTS)
|
(if (and (eq? (res :status) 302) FOLLOW-REDIRECTS complete)
|
||||||
(request scheme ((res :headers) "Location") req-headers)
|
(request scheme ((res :headers) "Location") req-headers)
|
||||||
res))))
|
res))))
|
||||||
|
|
||||||
|
(chunked (lambda (bytes sock scheme path req-headers req)
|
||||||
|
(let* ((body (req :body))
|
||||||
|
(split (string:split body "\r\n"))
|
||||||
|
(num (car split))
|
||||||
|
(size (string->number (++ "#x" num)))
|
||||||
|
(diff (- size (- (length body) (+ (length num) 4)))))
|
||||||
|
(let loop ((acc (string:join (cdr split) #\newline))
|
||||||
|
(cur (byte-vector->string (net:recv sock (make-small diff))))
|
||||||
|
(size diff))
|
||||||
|
(if (>= (length cur) size)
|
||||||
|
(let* ((chunk (substring cur 0 size))
|
||||||
|
(trail (substring cur size (length cur)))
|
||||||
|
(next (++ trail (byte-vector->string (net:recv sock BSIZE))))
|
||||||
|
(split (string:split next "\r\n"))
|
||||||
|
(num (car split))
|
||||||
|
(next (substring next (+ (length num) 2) (length next)))
|
||||||
|
(split (string:split next "\r\n"))
|
||||||
|
(size (+ (string->number (++ "#x" num)) 2)))
|
||||||
|
(if (eq? size 2)
|
||||||
|
(hash:set req :body (++ acc chunk))
|
||||||
|
(loop (++ acc chunk) next size)))
|
||||||
|
(loop acc
|
||||||
|
(++ cur (byte-vector->string (net:recv sock (make-small (- size (length cur))))))
|
||||||
|
size))))))
|
||||||
|
|
||||||
(request (lambda (scheme path . req-headers)
|
(request (lambda (scheme path . req-headers)
|
||||||
(let* ((path (if (string:starts-with path "http://") (substring path 7 (length path)) path))
|
(let* ((path (if (string:starts-with path "http://") (substring path 7 (length path)) path))
|
||||||
(path (if (string:starts-with path "https://") (substring path 8 (length path)) path))
|
(path (if (string:starts-with path "https://") (substring path 8 (length path)) path))
|
||||||
@@ -62,12 +87,25 @@
|
|||||||
(net:connect sock (net:get-addr-info host port))
|
(net:connect sock (net:get-addr-info host port))
|
||||||
(net:send sock (string->byte-vector text))
|
(net:send sock (string->byte-vector text))
|
||||||
(let loop ((recvd (net:recv sock BSIZE))
|
(let loop ((recvd (net:recv sock BSIZE))
|
||||||
(bytes b{}))
|
(bytes b{})
|
||||||
(if (or (falsy? (length recvd)) (string:ends-with (byte-vector->string recvd) "\r\n"))
|
(cur 0)
|
||||||
(begin
|
(len 0))
|
||||||
(net:close-socket sock)
|
(if (eq? len 0)
|
||||||
(parse-request (byte-vector->string (++ bytes recvd)) scheme path req-headers))
|
(let* ((nrecvd (++ bytes recvd))
|
||||||
(loop (net:recv sock BSIZE) (++ bytes recvd))))))))
|
(req (parse-request (byte-vector->string nrecvd) scheme path req-headers #f))
|
||||||
|
(headers (get-from req :headers #{}))
|
||||||
|
(l (get-from headers "Content-Length" "0")))
|
||||||
|
(if (and (eq? l "0") (not (eq? headers #{})))
|
||||||
|
(if (in? (headers "Transfer-Encoding") "chunked")
|
||||||
|
(chunked nrecvd sock scheme path req-headers req)
|
||||||
|
(loop (net:recv sock BSIZE) nrecvd (length nrecvd) 0))
|
||||||
|
(loop recvd bytes (length recvd) (string->number l))))
|
||||||
|
(let ((ncur (+ cur (length recvd))))
|
||||||
|
(if (>= ncur len)
|
||||||
|
(begin
|
||||||
|
(net:close-socket sock)
|
||||||
|
(parse-request (byte-vector->string (++ bytes recvd)) scheme path req-headers #t))
|
||||||
|
(loop (net:recv sock (min BSIZE (- len cur))) (++ bytes recvd) ncur len)))))))))
|
||||||
|
|
||||||
(get (lambda (path . headers)
|
(get (lambda (path . headers)
|
||||||
(request "GET" path (get-from headers 0 DFLT-HEADERS))))
|
(request "GET" path (get-from headers 0 DFLT-HEADERS))))
|
||||||
|
Reference in New Issue
Block a user