diff options
author | Andy Wingo <wingo@pobox.com> | 2011-07-25 18:26:37 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-07-25 18:26:37 +0200 |
commit | ab4bc85398a14b62b58694bab83c63be286b2fd5 (patch) | |
tree | 84bfe7b0b6064016bcfadb76ec95d07410654fe8 /module/web/request.scm | |
parent | f29c300507da21a667f5b82e75300f8009eab9cc (diff) | |
parent | f4b7d918eff9770f09893b023fd834f5c0bc33d1 (diff) | |
download | guile-ab4bc85398a14b62b58694bab83c63be286b2fd5.tar.gz |
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts:
GUILE-VERSION
test-suite/tests/srfi-4.test
Diffstat (limited to 'module/web/request.scm')
-rw-r--r-- | module/web/request.scm | 40 |
1 files changed, 25 insertions, 15 deletions
diff --git a/module/web/request.scm b/module/web/request.scm index 84119205f..c9204a4bf 100644 --- a/module/web/request.scm +++ b/module/web/request.scm @@ -151,21 +151,31 @@ (validate-headers? #t)) "Construct an HTTP request object. If @var{validate-headers?} is true, the headers are each run through their respective validators." - (cond - ((not (and (pair? version) - (non-negative-integer? (car version)) - (non-negative-integer? (cdr version)))) - (bad-request "Bad version: ~a" version)) - ((not (uri? uri)) - (bad-request "Bad uri: ~a" uri)) - ((and (not port) (memq method '(POST PUT))) - (bad-request "Missing port for message ~a" method)) - ((not (list? meta)) - (bad-request "Bad metadata alist" meta)) - (else - (if validate-headers? - (validate-headers headers)))) - (make-request method uri version headers meta port)) + (let ((needs-host? (and (equal? version '(1 . 1)) + (not (assq-ref headers 'host))))) + (cond + ((not (and (pair? version) + (non-negative-integer? (car version)) + (non-negative-integer? (cdr version)))) + (bad-request "Bad version: ~a" version)) + ((not (uri? uri)) + (bad-request "Bad uri: ~a" uri)) + ((and (not port) (memq method '(POST PUT))) + (bad-request "Missing port for message ~a" method)) + ((not (list? meta)) + (bad-request "Bad metadata alist" meta)) + ((and needs-host? (not (uri-host uri))) + (bad-request "HTTP/1.1 request without Host header and no host in URI: ~a" + uri)) + (else + (if validate-headers? + (validate-headers headers)))) + (make-request method uri version + (if needs-host? + (acons 'host (cons (uri-host uri) (uri-port uri)) + headers) + headers) + meta port))) (define* (read-request port #:optional (meta '())) "Read an HTTP request from @var{port}, optionally attaching the given |