diff --git a/scheme/httpd/core.scm b/scheme/httpd/core.scm index d942b35..b2d931d 100644 --- a/scheme/httpd/core.scm +++ b/scheme/httpd/core.scm @@ -167,10 +167,14 @@ (lambda () (let ((initial-req (parse-http-request sock options))) (let redirect-loop ((req initial-req)) - (let ((response ((httpd-options-request-handler options) - (http-url-path (request-url req)) - req))) + (let response-loop ((response ((httpd-options-request-handler options) + (http-url-path (request-url req)) + req))) (cond + ((input-response? response) + (response-loop + ((input-response-body-maker response) + (socket:inport sock)))) ((nph-response? response) (values req response)) ((eq? (response-code response) (status-code redirect)) diff --git a/scheme/httpd/response.scm b/scheme/httpd/response.scm index a06e192..a4b974d 100644 --- a/scheme/httpd/response.scm +++ b/scheme/httpd/response.scm @@ -24,6 +24,11 @@ nph-response? (body nph-response-body)) +(define-record-type http-input-response :http-input-response + (make-input-response body-maker) + input-response? + (body-maker input-response-body-maker)) + (define-record-type http-writer-body :http-writer-body (make-writer-body proc) writer-body? diff --git a/scheme/packages.scm b/scheme/packages.scm index 7db11fe..b87a6af 100644 --- a/scheme/packages.scm +++ b/scheme/packages.scm @@ -284,6 +284,9 @@ make-nph-response nph-response? nph-response-body + make-input-response input-response? + input-response-body-maker + make-writer-body writer-body? make-reader-writer-body reader-writer-body? make-redirect-body redirect-body? redirect-body-location