diff options
author | Andy Wingo <wingo@pobox.com> | 2011-07-15 13:08:45 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-07-15 13:36:52 +0200 |
commit | 037a68032165a2f1e4c0311baa9f69e2a05c3326 (patch) | |
tree | b8ee58f109b816cf5d5fd8be2f0b07cfb3171c5e /module/web/request.scm | |
parent | 680c8c5a99e6abe040752c3471cd42a9516842b6 (diff) | |
download | guile-037a68032165a2f1e4c0311baa9f69e2a05c3326.tar.gz |
ensure presence of Host header in HTTP/1.1 requests
* module/web/request.scm (build-request): Make sure that HTTP/1.1
requests have the Host header set, per RFC 2616 section 9.
* test-suite/tests/web-request.test ("example-1"): Add 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 |