summaryrefslogtreecommitdiff
path: root/module/web/request.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-07-15 13:08:45 +0200
committerAndy Wingo <wingo@pobox.com>2011-07-15 13:36:52 +0200
commit037a68032165a2f1e4c0311baa9f69e2a05c3326 (patch)
treeb8ee58f109b816cf5d5fd8be2f0b07cfb3171c5e /module/web/request.scm
parent680c8c5a99e6abe040752c3471cd42a9516842b6 (diff)
downloadguile-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.scm40
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