More GOOPS comments

[bpt/guile.git] / module / web / client.scm

diff --git a/module/web/client.scm b/module/web/client.scm
index 24132c6..11fee35 100644 (file)
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -1,6 +1,6 @@
 ;;; Web client
 
-;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
 
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -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
@@ -72,7 +74,8 @@
       (delete-duplicates
        (getaddrinfo (uri-host uri)
                     (cond (port => number->string)
-                          (else (symbol->string (uri-scheme uri))))
+                          ((uri-scheme uri) => symbol->string)
+                          (else (error "Not an absolute URI" uri)))
                     (if port
                         AI_NUMERICSERV
                         0))
@@ -90,8 +93,6 @@
 
           ;; Buffer input and output on this port.
           (setvbuf s _IOFBF)
-          ;; Enlarge the receive buffer.
-          (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024))
           ;; If we're using a proxy, make a note of that.
           (when http-proxy (set-http-proxy-port?! s #t))
           s)
@@ -103,11 +104,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 +135,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 +173,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 +205,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 +228,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 +283,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 +320,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 +333,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 +343,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 +353,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 +363,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 +373,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.