Changeset 33917 in project


Ignore:
Timestamp:
04/02/17 13:36:00 (4 months ago)
Author:
sjamaan
Message:

http-client: Fix handling of custom writer procedure: use chunked encoding

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

Legend:

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

    r33904 r33917  
    821821                                    'form-data writer)))))
    822822                  (else #f)))
    823          (size-headers (if chunks
    824                            (let ((size (calculate-chunk-size chunks)))
    825                              (if size
    826                                  `((content-length ,size))
    827                                  `((transfer-encoding chunked))))
    828                            '()))
     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 '())))
    829839         (req (update-request
    830840               req headers: (headers `(,@size-headers ,@type-headers)
  • release/4/http-client/trunk/tests/run.scm

    r33904 r33917  
     1;; This can be dropped later
     2(use setup-api)
     3(when (version>=? (chicken-version) "4.6.0")
     4  (register-feature! 'has-port-closed))
     5
    16(use extras)
     7
     8(include "../http-client.scm")
     9(import http-client)
    210
    311(include "testlib.scm")
     
    156164            #f (header-value 'content-length h))
    157165      (test "Body contains the file and other data, delimited by the boundary"
    158             expected-data (log-body log)))))
     166            expected-data (log-body log))))
     167
     168  (test-group "alist form data body with filename"
     169    (let* ((tmpfile (create-temporary-file))
     170           (log (with-server-response
     171                 (lambda ()
     172                   (with-output-to-file tmpfile
     173                     (lambda () (display "the file's contents")))
     174                   (with-input-from-request
     175                    "http://example.com"
     176                    `((lala . "testing")
     177                      (the-file file: ,tmpfile filename: "tmpfile")
     178                      ("more" . stuff))
     179                    read-string))
     180                 "HTTP/1.0 200 OK\r\n\r\n"))
     181           (req (log-request log))
     182           (h (request-headers req))
     183           (boundary (header-param 'boundary 'content-type h))
     184           (expected-data
     185            (conc
     186             "--" boundary "\r\n"
     187             "Content-Disposition: form-data; name=\"lala\"\r\n\r\n"
     188             "testing\r\n"
     189             "--" boundary "\r\n"
     190             "Content-Disposition: form-data; name=\"the-file\"; "
     191             "filename=\"tmpfile\"\r\n"
     192             "Content-Type: application/octet-stream\r\n\r\n"
     193             "the file's contents\r\n"
     194             "--" boundary "\r\n"
     195             "Content-Disposition: form-data; name=\"more\"\r\n\r\n"
     196             "stuff\r\n"
     197             "--" boundary "--\r\n")))
     198
     199      (test "Request method" 'POST (request-method req))
     200      (test "Content type is multipart"
     201            'multipart/form-data
     202            (header-value 'content-type h))
     203      (test "Content-length was set to the entire body size"
     204            (string-length expected-data)
     205            (header-value 'content-length h))
     206      (test "Body contains the file and other data, delimited by the boundary"
     207            expected-data (log-body log))))
     208
     209  (test-group "custom writer procedure"
     210    (let* ((log (with-server-response
     211                 (lambda ()
     212                   (test "Response is read back"
     213                         "Your response, sir"
     214                         (with-input-from-request
     215                          "http://example.com"
     216                          (lambda ()
     217                            (display "test, ")
     218                            (display "test, 123"))
     219                          read-string)))
     220                 "HTTP/1.0 200 OK\r\n\r\nYour response, sir"))
     221           (req (log-request log)))
     222
     223      (test "Request method" 'POST (request-method req))
     224      (test "Content type is not set"
     225            #f
     226            (header-value 'content-type (request-headers req)))
     227      (test "Transfer encoding is chunked"
     228            'chunked
     229            (header-value 'transfer-encoding (request-headers req)))
     230      (test "Content-length is not set"
     231            #f (header-value 'content-length (request-headers req)))
     232      (test "All writes were received"
     233            "test, test, 123" (log-body log))))
     234
     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
     240                 (lambda ()
     241                   (test "Response is read back"
     242                         "Your response, sir"
     243                         (with-input-from-request
     244                          req
     245                          (lambda ()
     246                            (display "test, ")
     247                            (display "test, 123"))
     248                          read-string)))
     249                 "HTTP/1.0 200 OK\r\n\r\nYour response, sir"))
     250           (req (log-request log)))
     251
     252      (test "Request method" 'POST (request-method req))
     253      (test "Content type is not set"
     254            #f
     255            (header-value 'content-type (request-headers req)))
     256      (test "Transfer encoding is not set"
     257            #f
     258            (header-value 'transfer-encoding (request-headers req)))
     259      (test "Content-length is taken from user-supplied header"
     260            15 (header-value 'content-length (request-headers req)))
     261      (test "All writes were received"
     262            "test, test, 123" (log-body log)))))
    159263
    160264(test-group "Redirects"
  • release/4/http-client/trunk/tests/testlib.scm

    r33903 r33917  
    44;; TODO: Test HTTPS somehow?
    55
    6 (use test http-client uri-common intarweb
    7      srfi-1 srfi-18 tcp posix)
     6(use test uri-common intarweb srfi-1 srfi-18 tcp posix)
    87
    98;; From intarweb
Note: See TracChangeset for help on using the changeset viewer.