diff options
Diffstat (limited to 'module/web/client.scm')
-rw-r--r-- | module/web/client.scm | 32 |
1 files changed, 17 insertions, 15 deletions
diff --git a/module/web/client.scm b/module/web/client.scm index 24132c674..3f6c45bfe 100644 --- a/module/web/client.scm +++ b/module/web/client.scm @@ -41,6 +41,8 @@ #:use-module (web uri) #:use-module (web http) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) #:export (current-http-proxy open-socket-for-uri http-get @@ -103,11 +105,9 @@ (loop (cdr addresses)))))))) (define (extend-request r k v . additional) - (let ((r (build-request (request-uri r) #:version (request-version r) - #:headers - (assoc-set! (copy-tree (request-headers r)) - k v) - #:port (request-port r)))) + (let ((r (set-field r (request-headers) + (assoc-set! (copy-tree (request-headers r)) + k v)))) (if (null? additional) r (apply extend-request r additional)))) @@ -136,6 +136,9 @@ as is the case by default with a request returned by `build-request'." ((not body) (let ((length (request-content-length request))) (if length + ;; FIXME make this stricter: content-length header should be + ;; prohibited if there's no body, even if the content-length + ;; is 0. (unless (zero? length) (error "content-length, but no body")) (when (assq 'transfer-encoding (request-headers request)) @@ -171,7 +174,6 @@ as is the case by default with a request returned by `build-request'." (rlen (if (= rlen blen) request (error "bad content-length" rlen blen))) - ((zero? blen) request) (else (extend-request request 'content-length blen)))) body)))) @@ -204,7 +206,7 @@ as is the case by default with a request returned by `build-request'." (define* (request uri #:key (body #f) (port (open-socket-for-uri uri)) - (method "GET") + (method 'GET) (version '(1 . 1)) (keep-alive? #f) (headers '()) @@ -227,7 +229,7 @@ as is the case by default with a request returned by `build-request'." (force-output (request-port request)) (let ((response (read-response port))) (cond - ((equal? (request-method request) "HEAD") + ((eq? (request-method request) 'HEAD) (unless keep-alive? (close-port port)) (values response #f)) @@ -282,7 +284,7 @@ true)." (issue-deprecation-warning "The #:extra-headers argument to http-get has been renamed to #:headers. " "Please update your code.")) - (request uri #:method "GET" #:body body + (request uri #:method 'GET #:body body #:port port #:version version #:keep-alive? keep-alive? #:headers headers #:decode-body? decode-body? #:streaming? streaming?)) @@ -319,7 +321,7 @@ true)." #:streaming? streaming?))) (define-http-verb http-head - "HEAD" + 'HEAD "Fetch message headers for the given URI using the HTTP \"HEAD\" method. @@ -332,7 +334,7 @@ requests do not have a body. The second value is only returned so that other procedures can treat all of the http-foo verbs identically.") (define-http-verb http-post - "POST" + 'POST "Post data to the given URI using the HTTP \"POST\" method. This function is similar to ‘http-get’, except it uses the \"POST\" @@ -342,7 +344,7 @@ arguments that are accepted by this function. Returns two values: the resulting response, and the response body.") (define-http-verb http-put - "PUT" + 'PUT "Put data at the given URI using the HTTP \"PUT\" method. This function is similar to ‘http-get’, except it uses the \"PUT\" @@ -352,7 +354,7 @@ arguments that are accepted by this function. Returns two values: the resulting response, and the response body.") (define-http-verb http-delete - "DELETE" + 'DELETE "Delete data at the given URI using the HTTP \"DELETE\" method. This function is similar to ‘http-get’, except it uses the \"DELETE\" @@ -362,7 +364,7 @@ arguments that are accepted by this function. Returns two values: the resulting response, and the response body.") (define-http-verb http-trace - "TRACE" + 'TRACE "Send an HTTP \"TRACE\" request. This function is similar to ‘http-get’, except it uses the \"TRACE\" @@ -372,7 +374,7 @@ arguments that are accepted by this function. Returns two values: the resulting response, and the response body.") (define-http-verb http-options - "OPTIONS" + 'OPTIONS "Query characteristics of an HTTP resource using the HTTP \"OPTIONS\" method. |