cleaned up request end

This commit is contained in:
hellerve
2016-03-02 17:47:38 +01:00
parent ff36a6c652
commit 1fbdca93f4

View File

@@ -22,7 +22,14 @@
(set-follow-redirects (lambda (flag)
(set! FOLLOW-REDIRECTS flag)))
(parse-request (lambda (req scheme path req-headers complete)
(end-request (lambda (res sock)
(begin
(net:close-socket sock)
(if (and (in? [302 301] (res :status)) FOLLOW-REDIRECTS)
(request ((res :request) :scheme) ((res :headers) "Location") ((res :request) :headers))
res))))
(parse-request (lambda (req scheme path req-headers complete sock)
(let* ((split (string:split req "\r\n\r\n"))
(headers (string:split (car split) "\r\n"))
(body (if (> (length split) 1) (string:join (cdr split) #\newline) ""))
@@ -37,9 +44,11 @@
:status (string->integer status)
:http http-version
:path path
:request (make-hash :scheme scheme
:headers req-headers)
:status-message message)))
(if (and (eq? (res :status) 302) FOLLOW-REDIRECTS complete)
(request scheme ((res :headers) "Location") req-headers)
(if complete
(end-request res sock)
res))))
(chunked (lambda (sock req)
@@ -48,25 +57,25 @@
(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)))
(size (+ (string->number (++ "#x" num)) 2)))
(if (eq? size 2)
(begin
(net:close-socket sock)
(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))))))
(if (eq? size 0)
(end-request req sock)
(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)))
(size (+ (string->number (++ "#x" num)) 2)))
(if (eq? size 2)
(end-request req sock)
(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))
@@ -93,7 +102,7 @@
(len -1))
(if (eq? len -1)
(let* ((nrecvd (++ bytes recvd))
(req (parse-request (byte-vector->string nrecvd) scheme path req-headers #f))
(req (parse-request (byte-vector->string nrecvd) scheme path req-headers #f sock))
(headers (get-from req :headers #{}))
(l (get-from headers "Content-Length")))
(if (and (eq? l (nil)) (not (eq? headers #{})))
@@ -103,9 +112,7 @@
(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))
(parse-request (byte-vector->string (++ bytes recvd)) scheme path req-headers #t sock)
(loop (net:recv sock (min BSIZE (- len cur))) (++ bytes recvd) ncur len)))))))))
(get (lambda (path . headers)