added chunked encoding

This commit is contained in:
hellerve
2016-02-24 14:32:43 +01:00
parent aada57a374
commit aa31eef508

View File

@@ -22,7 +22,7 @@
(set-follow-redirects (lambda (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"))
(headers (if (> (length split) 1) (string:split (car split) "\r\n") []))
(body (if (truthy? headers) (string:join (cdr split) #\newline) (car split)))
@@ -38,10 +38,35 @@
:http http-version
:path path
: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)
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)
(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))
@@ -62,12 +87,25 @@
(net:connect sock (net:get-addr-info host port))
(net:send sock (string->byte-vector text))
(let loop ((recvd (net:recv sock BSIZE))
(bytes b{}))
(if (or (falsy? (length recvd)) (string:ends-with (byte-vector->string recvd) "\r\n"))
(begin
(net:close-socket sock)
(parse-request (byte-vector->string (++ bytes recvd)) scheme path req-headers))
(loop (net:recv sock BSIZE) (++ bytes recvd))))))))
(bytes b{})
(cur 0)
(len 0))
(if (eq? len 0)
(let* ((nrecvd (++ 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)
(request "GET" path (get-from headers 0 DFLT-HEADERS))))