Changeset 33921 in project


Ignore:
Timestamp:
04/02/17 14:10:39 (7 weeks ago)
Author:
sjamaan
Message:

http-client: Improve handling of HTTP/1.0 requests with message body, ensure content-encoding for HTTP/1.1 requests with custom writer procedure

Location:
release/4/http-client/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/http-client/trunk/http-client.meta

    r33898 r33921  
    22
    33((synopsis "High-level HTTP client library")
    4  (depends (intarweb "1.6") (uri-common "0.7") (message-digest "3.0.0")
     4 (depends (intarweb "1.6.1") (uri-common "0.7") (message-digest "3.0.0")
    55          (md5 "3.0.0") string-utils (sendfile "1.7.4"))
    66 (test-depends test)
  • release/4/http-client/trunk/http-client.scm

    r33917 r33921  
    609609                 ;; TODO: Should we avoid calling "writer" if
    610610                 ;; request-has-message-body? returns false?
    611                  (_ (begin (writer request) (flush-output (request-port req))))
     611                 (_ (begin (writer request)
     612                           (flush-output (request-port req))
     613                           ;; Signal end of file when we can.
     614                           (unless (keep-alive? request)
     615                             (close-output-port
     616                              (http-connection-outport con)))))
    612617                 (response (read-response (http-connection-inport con)))
    613618                 (cleanup!
     
    821826                                    'form-data writer)))))
    822827                  (else #f)))
    823          (size-headers (cond
    824                         (chunks
    825                          (let ((size (calculate-chunk-size chunks)))
    826                            (if size
    827                                `((content-length ,size))
    828                                `((transfer-encoding chunked)))))
    829                         ;; We can't calculate the size except by
    830                         ;; calling the procedure, but that's wasteful.
    831                         ;; If the size is known, the user can supply a
    832                         ;; content-length header to avoid chunking.
    833                         ((and (procedure? writer)
    834                               (not (header-value
    835                                     'content-length
    836                                     (request-headers req))))
    837                          `((transfer-encoding chunked)))
    838                         (else '())))
     828         ;; If the size is known, the user can supply a content-length
     829         ;; header to avoid chunking.  For HTTP/1.0 we never chunk.
     830         (need-chunked-encoding?
     831          (and (= 1 (request-major req)) (= 1 (request-minor req))
     832               (not (header-value 'content-length (request-headers req)))))
     833         (size-headers
     834          (cond
     835           (chunks
     836            (let ((size (calculate-chunk-size chunks)))
     837              (cond
     838               (size `((content-length ,size)))
     839               (need-chunked-encoding? `((transfer-encoding chunked)))
     840               (else '()))))
     841           ;; We can't calculate the size except by
     842           ;; calling the procedure, but that's wasteful.
     843           ((and need-chunked-encoding? (procedure? writer))
     844            `((transfer-encoding chunked)))
     845           (else '())))
    839846         (req (update-request
    840847               req headers: (headers `(,@size-headers ,@type-headers)
     
    866873                         ((500) "Server error: ~A ~A")
    867874                         (else "Unexpected server response: ~A ~A"))
    868                        (response-code response) (response-reason response))
     875                (response-code response) (response-reason response))
    869876              ;; arguments
    870877              (list (uri->string uri))
  • release/4/http-client/trunk/tests/run.scm

    r33917 r33921  
    103103            (header-value 'content-type (request-headers req)))
    104104      (test "Content-length is string length"
     105            7 (header-value 'content-length (request-headers req)))
     106      (test "String was sent as body" "testing" (log-body log))))
     107
     108  (test-group "string body using HTTP/1.0"
     109    (let* ((log (with-server-response
     110                 (lambda ()
     111                   (let* ((uri (uri-reference "http://example.com"))
     112                          (req (make-request uri: uri method: 'LALA
     113                                             major: 1 minor: 0)))
     114                     (test "Response is read back"
     115                           "Your response, sir"
     116                           (with-input-from-request
     117                            req "testing" read-string))))
     118                 "HTTP/1.0 200 OK\r\n\r\nYour response, sir"))
     119           (req (log-request log)))
     120
     121      (test "Request method is custom" 'LALA (request-method req))
     122      (test "Version is correct"
     123            '(1 . 0)
     124            (cons (request-major req) (request-minor req)))
     125      (test "Content type is not set"
     126            #f
     127            (header-value 'content-type (request-headers req)))
     128      (test "Content-length is set"
    105129            7 (header-value 'content-length (request-headers req)))
    106130      (test "String was sent as body" "testing" (log-body log))))
     
    163187      (test "Content-length was not set"
    164188            #f (header-value 'content-length h))
     189      (test "Version is the default HTTP version of 1.1"
     190            '(1 . 1)
     191            (cons (request-major req) (request-minor req)))
     192      (test "Transfer encoding is chunked"
     193            'chunked
     194            (header-value 'transfer-encoding (request-headers req)))
     195      (test "Body contains the file and other data, delimited by the boundary"
     196            expected-data (log-body log))))
     197
     198  (test-group "alist form data body with file port using HTTP/1.0"
     199    (let* ((string-port (open-input-string "the file's contents"))
     200           (uri (uri-reference "http://example.com"))
     201           (req (make-request uri: uri method: 'POST
     202                              major: 1 minor: 0))
     203           (log (with-server-response
     204                 (lambda ()
     205                   (with-input-from-request
     206                    req
     207                    `((lala . "testing")
     208                      (the-file file: ,string-port
     209                                filename: "str")
     210                      ("more" . stuff))
     211                    read-string))
     212                 "HTTP/1.0 200 OK\r\n\r\n"))
     213           (req (log-request log))
     214           (h (request-headers req))
     215           (boundary (header-param 'boundary 'content-type h))
     216           (expected-data
     217            (conc
     218             "--" boundary "\r\n"
     219             "Content-Disposition: form-data; name=\"lala\"\r\n\r\n"
     220             "testing\r\n"
     221             "--" boundary "\r\n"
     222             "Content-Disposition: form-data; name=\"the-file\"; "
     223             "filename=\"str\"\r\n"
     224             "Content-Type: application/octet-stream\r\n\r\n"
     225             "the file's contents\r\n"
     226             "--" boundary "\r\n"
     227             "Content-Disposition: form-data; name=\"more\"\r\n\r\n"
     228             "stuff\r\n"
     229             "--" boundary "--\r\n")))
     230
     231      (test "Request method" 'POST (request-method req))
     232      (test "Content type is multipart"
     233            'multipart/form-data
     234            (header-value 'content-type h))
     235      (test "Content-length was not set"
     236            #f (header-value 'content-length h))
     237      (test "Version is correct"
     238            '(1 . 0)
     239            (cons (request-major req) (request-minor req)))
     240      (test "Transfer encoding is not set"
     241            #f
     242            (header-value 'transfer-encoding (request-headers req)))
    165243      (test "Body contains the file and other data, delimited by the boundary"
    166244            expected-data (log-body log))))
     
    233311            "test, test, 123" (log-body log))))
    234312
    235     (test-group "custom writer procedure with content-length header"
    236       (let* ((req (make-request uri: (uri-reference "http://example.com")
    237                                 headers: (headers `((content-length 15)))
    238                                 method: 'POST))
    239              (log (with-server-response
     313  (test-group "custom writer procedure with content-length header"
     314    (let* ((req (make-request uri: (uri-reference "http://example.com")
     315                              headers: (headers `((content-length 15)))
     316                              method: 'POST))
     317           (log (with-server-response
    240318                 (lambda ()
    241319                   (test "Response is read back"
     
    259337      (test "Content-length is taken from user-supplied header"
    260338            15 (header-value 'content-length (request-headers req)))
     339      (test "All writes were received"
     340            "test, test, 123" (log-body log))))
     341
     342  (test-group "custom writer procedure with http/1.0 and no content-length"
     343    (let* ((req (make-request uri: (uri-reference "http://example.com")
     344                              method: 'POST major: 1 minor: 0))
     345           (log (with-server-response
     346                 (lambda ()
     347                   (test "Response is read back"
     348                         "Your response, sir"
     349                         (with-input-from-request
     350                          req
     351                          (lambda ()
     352                            (display "test, ")
     353                            (display "test, 123"))
     354                          read-string)))
     355                 "HTTP/1.0 200 OK\r\n\r\nYour response, sir"))
     356           (req (log-request log)))
     357
     358      (test "Request method" 'POST (request-method req))
     359      (test "Content type is not set"
     360            #f
     361            (header-value 'content-type (request-headers req)))
     362      (test "Transfer encoding is not set"
     363            #f
     364            (header-value 'transfer-encoding (request-headers req)))
     365      (test "Content-length is not set"
     366            #f (header-value 'content-length (request-headers req)))
     367      ;; We could set connection: close, but for HTTP/1.0 that doesn't
     368      ;; really exist
     369      (test "Connection is not set"
     370            #f (header-value 'connection (request-headers req)))
    261371      (test "All writes were received"
    262372            "test, test, 123" (log-body log)))))
Note: See TracChangeset for help on using the changeset viewer.