summaryrefslogtreecommitdiff
path: root/tests/run.scm
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2024-06-28 09:04:48 +0200
committerPeter Bex <peter@more-magic.net>2024-06-28 09:04:48 +0200
commit8f92a6c32da01150400261515d3a4aa8a6ac4470 (patch)
treeed2e095add50cef405a84aff31a079d0dd3a720b /tests/run.scm
parent64563b82ae1ddc87900aebad34529516f34657f7 (diff)
downloadhttp-client-8f92a6c32da01150400261515d3a4aa8a6ac4470.tar.gz
Check for closed ports when writing chunks and give a hint to the user1.2.2
This makes it a bit more obvious what happened in cases like #1838, reported by Woodrow E Douglass. While at it, add some more test cases for this particular case, but also for retry-attempts, as this is also affected when retry is allowed for non-idempotent requests (which is pretty uncommon, but possible)
Diffstat (limited to 'tests/run.scm')
-rw-r--r--tests/run.scm140
1 files changed, 88 insertions, 52 deletions
diff --git a/tests/run.scm b/tests/run.scm
index 7d0653b..7759b24 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -192,50 +192,6 @@
(test "Body contains the file and other data, delimited by the boundary"
expected-data (log-body log))))
- (test-group "alist form data body with string data"
- (let* ((log (with-server-response
- (lambda ()
- (with-input-from-request
- "http://example.com"
- `((lala . "testing")
- (the-data data: "the data's contents"
- filename: "str")
- ("more" . stuff))
- read-string))
- "HTTP/1.0 200 OK\r\n\r\n"))
- (req (log-request log))
- (h (request-headers req))
- (boundary (header-param 'boundary 'content-type h))
- (expected-data
- (conc
- "--" boundary "\r\n"
- "Content-Disposition: form-data; name=\"lala\"\r\n\r\n"
- "testing\r\n"
- "--" boundary "\r\n"
- "Content-Disposition: form-data; name=\"the-data\"; "
- "filename=\"str\"\r\n"
- "Content-Type: application/octet-stream\r\n\r\n"
- "the data's contents\r\n"
- "--" boundary "\r\n"
- "Content-Disposition: form-data; name=\"more\"\r\n\r\n"
- "stuff\r\n"
- "--" boundary "--\r\n")))
-
- (test "Request method" 'POST (request-method req))
- (test "Content type is multipart"
- 'multipart/form-data
- (header-value 'content-type h))
- (test "Content-length was set"
- (string-length expected-data) (header-value 'content-length h))
- (test "Version is the default HTTP version of 1.1"
- '(1 . 1)
- (cons (request-major req) (request-minor req)))
- (test "Transfer encoding is not set"
- #f
- (header-value 'transfer-encoding (request-headers req)))
- (test "Body contains the file and other data, delimited by the boundary"
- expected-data (log-body log))))
-
(test-group "alist form data body with string port using HTTP/1.0"
(let* ((string-port (open-input-string "the file's contents"))
(uri (uri-reference "http://example.com"))
@@ -284,14 +240,29 @@
(test "Body contains the file and other data, delimited by the boundary"
expected-data (log-body log))))
- (test-group "alist form data body with string data using HTTP/1.0"
- (let* ((uri (uri-reference "http://example.com"))
- (req (make-request uri: uri method: 'POST
- major: 1 minor: 0))
- (log (with-server-response
+ (test-group "alist form data body with string port with redirect"
+ (test-error* "results in a port already consumed error"
+ (exn http port-already-consumed)
+ (let ((string-port (open-input-string "the file's contents")))
+ (with-server-responses
+ (lambda ()
+ (with-input-from-request
+ "http://example.com"
+ `((lala . "testing")
+ (the-file file: ,string-port
+ filename: "str")
+ ("more" . stuff))
+ read-string))
+ (conc "HTTP/1.0 301 Moved Permanently\r\n"
+ "Location: http://example.org/different/path\r\n"
+ "Content-Length: 8\r\n\r\nIgnored!")
+ "HTTP/1.0 200 OK\r\n\r\n"))))
+
+ (test-group "alist form data body with string data"
+ (let* ((log (with-server-response
(lambda ()
(with-input-from-request
- req
+ "http://example.com"
`((lala . "testing")
(the-data data: "the data's contents"
filename: "str")
@@ -322,8 +293,8 @@
(header-value 'content-type h))
(test "Content-length was set"
(string-length expected-data) (header-value 'content-length h))
- (test "Version is correct"
- '(1 . 0)
+ (test "Version is the default HTTP version of 1.1"
+ '(1 . 1)
(cons (request-major req) (request-minor req)))
(test "Transfer encoding is not set"
#f
@@ -420,6 +391,8 @@
(test "Version is correct"
'(1 . 0)
(cons (request-major req) (request-minor req)))
+ ;; This is the important part - no chunking! And also, connection is closed,
+ ;; but we can't test for that here unless we expose the idle-connections pool.
(test "Transfer encoding is not set"
#f
(header-value 'transfer-encoding (request-headers req)))
@@ -708,6 +681,69 @@
'(1 1) (list (request-major req) (request-minor req)))
(test "No body got sent (GET)" #f (log-body (last logs))))))
+ (test-group "with POST and default value for 'retry-request?'"
+ (test-error* "results in a premature disconnection error due to retries not allowed for non-idempotent requests"
+ (exn http premature-disconnection)
+ (parameterize ((max-retry-attempts 3))
+ (with-server-responses
+ (lambda ()
+ (with-input-from-request
+ "http://example.com/blah"
+ `((lala . "testing")
+ (another . "thing"))
+ read-string))
+ ""
+ (conc "HTTP/1.0 200 OK\r\n"
+ "Content-Length: 63\r\n\r\n"
+ "It would've worked on the second attempt, but we never get here")))))
+
+ (test-group "with POST and allowing retries for non-idempotent connections"
+ (parameterize ((retry-request? (constantly #t))
+ (max-retry-attempts 3))
+ (let* ((logs (with-server-responses
+ (lambda ()
+ (with-input-from-request
+ "http://example.com/blah"
+ `((lala . "testing")
+ ("more" . stuff))
+ read-string))
+ ""
+ (conc "HTTP/1.0 200 OK\r\n"
+ "Content-Length: 63\r\n\r\n"
+ "It would've worked on the second attempt, but we never get here")))
+ (req (log-request (last logs))))
+
+ ;; Just a few random checks
+ (test "URI is still OK"
+ "/blah" (uri->string (request-uri req)))
+ (test "host header is also OK"
+ '("example.com" . #f)
+ (header-value 'host (request-headers req)))
+ (test "HTTP request is version 1.1"
+ '(1 1) (list (request-major req) (request-minor req)))
+ (test "Body got sent again"
+ "lala=testing&more=stuff" (log-body (last logs))))))
+
+ (test-group "with port in data and allowing retries for non-idempotent connections"
+ (let ((string-port (open-input-string "the file's contents")))
+ (test-error* "results in a port already consumed error"
+ (exn http port-already-consumed)
+ (parameterize ((retry-request? (constantly #t))
+ (max-retry-attempts 3))
+ (with-server-responses
+ (lambda ()
+ (with-input-from-request
+ "http://example.com/blah"
+ `((lala . "testing")
+ (the-file file: ,string-port
+ filename: "str")
+ (another . "thing"))
+ read-string))
+ ""
+ (conc "HTTP/1.0 200 OK\r\n"
+ "Content-Length: 63\r\n\r\n"
+ "It would've worked on the second attempt, but we never get here"))))))
+
(test-group "exceeding maximum retries"
(parameterize ((max-retry-attempts 3))
(test-error* "results in a premature disconnection error"