cleaned up request end
This commit is contained in:
59
request.zp
59
request.zp
@@ -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)
|
||||
|
Reference in New Issue
Block a user