Changeset 29924 in project


Ignore:
Timestamp:
10/13/13 21:21:36 (8 years ago)
Author:
sjamaan
Message:

http-client: Allow retrying when the connection has been prematurely closed by the server, as per RFC 2616, 8.2.4 (but don't implement the silly algorithm, which a client MAY implement)

File:
1 edited

Legend:

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

    r29920 r29924  
    489489             (req req))
    490490    (condition-case
    491       (let* ((con (ensure-connection! (request-uri req)))
    492              (req (add-headers (update-request
    493                                 req port: (http-connection-outport con))))
    494              ;; No outgoing URIs should ever contain credentials or fragments
    495              (req-uri (update-uri (request-uri req)
    496                                   fragment: #f username: #f password: #f))
    497              ;; RFC1945, 5.1.2: "The absoluteURI form is only allowed
    498              ;; when the request is being made to a proxy."
    499              ;; RFC2616 is a little more regular (hosts MUST accept
    500              ;; absoluteURI), but it says "HTTP/1.1 clients will only
    501              ;; generate them in requests to proxies." (also 5.1.2)
    502              (req-uri (if (http-connection-proxy con)
    503                           req-uri
    504                           (update-uri req-uri host: #f port: #f scheme: #f
    505                                       path: (or (uri-path req-uri) '(/ "")))))
    506              (request (write-request (update-request req uri: req-uri)))
    507              ;; Writer should be prepared to be called several times
    508              ;; Maybe try and figure out a good way to use the
    509              ;; "Expect: 100-continue" header to prevent too much writing?
    510              ;; Unfortunately RFC2616 says it's unreliable (8.2.3)...
    511              (_ (begin (writer request) (flush-output (request-port req))))
    512              (response (read-response (http-connection-inport con)))
    513              (cleanup! (lambda (clear-response-data?)
    514                          (when clear-response-data?
    515                            (discard-remaining-data! response
    516                                                     (response-port response)))
    517                          (unless (and (keep-alive? request)
    518                                       (keep-alive? response))
    519                            (close-connection! con)))))
    520         (when response (process-set-cookie! con (request-uri req) response))
    521         (case (and response (response-code response))
    522           ((#f)
    523            (http-client-error 'send-request
    524                               "Server closed connection before sending response"
    525                               (list (uri->string (request-uri req)))
    526                               'premature-disconnection
    527                               'uri (request-uri req) 'request req))
    528           ;; TODO: According to spec, we should provide the user with a choice
    529           ;; when it's not a GET or HEAD request...
    530           ((301 302 303 307)
    531            (cleanup! #t)
    532            ;; Maybe we should switch to GET on 302 too?  It's not compliant,
    533            ;; but very widespread and there's enough software that depends
    534            ;; on that behaviour, which might break horribly otherwise...
    535            (when (= (response-code response) 303)
    536              (request-method-set! req 'GET)) ; Switch to GET
    537            (let* ((loc-uri (header-value 'location (response-headers response)))
    538                   (new-uri (uri-relative-to loc-uri (request-uri req))))
    539              (if (or (not (max-redirect-depth)) ; unlimited?
    540                      (< redirects (max-redirect-depth)))
    541                  (loop attempts
    542                        (add1 redirects)
    543                        (update-request req uri: new-uri))
     491        (let* ((con (ensure-connection! (request-uri req)))
     492               (req (add-headers (update-request
     493                                  req port: (http-connection-outport con))))
     494               ;; No outgoing URIs should ever contain credentials or fragments
     495               (req-uri (update-uri (request-uri req)
     496                                    fragment: #f username: #f password: #f))
     497               ;; RFC1945, 5.1.2: "The absoluteURI form is only allowed
     498               ;; when the request is being made to a proxy."
     499               ;; RFC2616 is a little more regular (hosts MUST accept
     500               ;; absoluteURI), but it says "HTTP/1.1 clients will only
     501               ;; generate them in requests to proxies." (also 5.1.2)
     502               (req-uri (if (http-connection-proxy con)
     503                            req-uri
     504                            (update-uri req-uri host: #f port: #f scheme: #f
     505                                        path: (or (uri-path req-uri) '(/ "")))))
     506               (request (write-request (update-request req uri: req-uri)))
     507               ;; Writer should be prepared to be called several times
     508               ;; Maybe try and figure out a good way to use the
     509               ;; "Expect: 100-continue" header to prevent too much writing?
     510               ;; Unfortunately RFC2616 says it's unreliable (8.2.3)...
     511               (_ (begin (writer request) (flush-output (request-port req))))
     512               (response (read-response (http-connection-inport con)))
     513               (cleanup! (lambda (clear-response-data?)
     514                           (when clear-response-data?
     515                             (discard-remaining-data! response
     516                                                      (response-port response)))
     517                           (unless (and (keep-alive? request)
     518                                        (keep-alive? response))
     519                             (close-connection! con)))))
     520          (when response (process-set-cookie! con (request-uri req) response))
     521          (case (and response (response-code response))
     522            ((#f)
     523             ;; If the connection is closed prematurely, we SHOULD
     524             ;; retry, according to RFC2616, section 8.2.4.  Currently
     525             ;; don't do "binary exponential backoff", which we MAY do.
     526             (if (or (not (max-retry-attempts)) ; unlimited?
     527                     (<= attempts (max-retry-attempts)))
     528                 (loop (add1 attempts) redirects req)
    544529                 (http-client-error 'send-request
    545                                     "Maximum number of redirects exceeded"
    546                                     (list (uri->string (request-uri request)))
    547                                     'redirect-depth-exceeded
    548                                     'uri (request-uri req)
    549                                     'new-uri new-uri 'request req))))
    550           ;; TODO: Test this
    551           ((305)                        ; Use proxy (for this request only)
    552            (cleanup! #t)
    553            (let ((old-determine-proxy (determine-proxy))
    554                  (proxy-uri (header-value 'location (response-headers response))))
    555              (parameterize ((determine-proxy
    556                              (lambda _
    557                                ;; Reset determine-proxy so the proxy is really
    558                                ;; used for only this one request.
    559                                ;; Yes, this is a bit of a hack :)
    560                                (determine-proxy old-determine-proxy)
    561                                proxy-uri)))
    562                (loop attempts redirects req))))
    563           ((401 407)          ; Unauthorized, Proxy Authentication Required
    564            (cond ((and (or (not (max-retry-attempts)) ; unlimited?
    565                            (<= attempts (max-retry-attempts)))
    566                        (authenticate-request req response writer
    567                                              (http-connection-proxy con)))
    568                   => (lambda (new-req)
    569                        (cleanup! #t)
    570                        (loop (add1 attempts) redirects new-req)))
    571                  (else ;; pass it on, we can't throw an error here
    572                   (let ((data (reader response)))
    573                     (values data (request-uri request) response)))))
    574           (else (let ((data (reader response)))
    575                   (cleanup! #f)
    576                   (values data (request-uri req) response)))))
    577         (exn (exn i/o net)
    578              (close-connection! (request-uri req))
    579              (if (and (or (not (max-retry-attempts)) ; unlimited?
    580                           (<= attempts (max-retry-attempts)))
    581                       ((retry-request?) req))
    582                  (loop (add1 attempts) redirects req)
    583                  (raise exn)))
    584         (exn ()
    585              ;; Never leave the port in an unknown/inconsistent state
    586              ;; (the error could have occurred while reading, so there
    587              ;;  might be data left in the buffer)
    588              (close-connection! (request-uri req))
    589              (raise exn)))))
     530                                    "Server closed connection before sending response"
     531                                    (list (uri->string (request-uri req)))
     532                                    'premature-disconnection
     533                                    'uri (request-uri req) 'request req)))
     534            ;; TODO: According to spec, we should provide the user
     535            ;; with a choice when it's not a GET or HEAD request...
     536            ((301 302 303 307)
     537             (cleanup! #t)
     538             ;; Maybe we should switch to GET on 302 too?  It's not compliant,
     539             ;; but very widespread and there's enough software that depends
     540             ;; on that behaviour, which might break horribly otherwise...
     541             (when (= (response-code response) 303)
     542               (request-method-set! req 'GET)) ; Switch to GET
     543             (let* ((loc-uri (header-value 'location
     544                                           (response-headers response)))
     545                    (new-uri (uri-relative-to loc-uri (request-uri req))))
     546               (if (or (not (max-redirect-depth)) ; unlimited?
     547                       (< redirects (max-redirect-depth)))
     548                   (loop attempts
     549                         (add1 redirects)
     550                         (update-request req uri: new-uri))
     551                   (http-client-error 'send-request
     552                                      "Maximum number of redirects exceeded"
     553                                      (list (uri->string (request-uri request)))
     554                                      'redirect-depth-exceeded
     555                                      'uri (request-uri req)
     556                                      'new-uri new-uri 'request req))))
     557            ;; TODO: Test this
     558            ((305)                 ; Use proxy (for this request only)
     559             (cleanup! #t)
     560             (let ((old-determine-proxy (determine-proxy))
     561                   (proxy-uri (header-value 'location (response-headers response))))
     562               (parameterize ((determine-proxy
     563                               (lambda _
     564                                 ;; Reset determine-proxy so the proxy is really
     565                                 ;; used for only this one request.
     566                                 ;; Yes, this is a bit of a hack :)
     567                                 (determine-proxy old-determine-proxy)
     568                                 proxy-uri)))
     569                 (loop attempts redirects req))))
     570            ((401 407)   ; Unauthorized, Proxy Authentication Required
     571             (cond ((and (or (not (max-retry-attempts)) ; unlimited?
     572                             (<= attempts (max-retry-attempts)))
     573                         (authenticate-request req response writer
     574                                               (http-connection-proxy con)))
     575                    => (lambda (new-req)
     576                         (cleanup! #t)
     577                         (loop (add1 attempts) redirects new-req)))
     578                   (else ;; pass it on, we can't throw an error here
     579                    (let ((data (reader response)))
     580                      (values data (request-uri request) response)))))
     581            (else (let ((data (reader response)))
     582                    (cleanup! #f)
     583                    (values data (request-uri req) response)))))
     584      (exn (exn i/o net)
     585           (close-connection! (request-uri req))
     586           (if (and (or (not (max-retry-attempts)) ; unlimited?
     587                        (<= attempts (max-retry-attempts)))
     588                    ((retry-request?) req))
     589               (loop (add1 attempts) redirects req)
     590               (raise exn)))
     591      (exn ()
     592           ;; Never leave the port in an unknown/inconsistent state
     593           ;; (the error could have occurred while reading, so there
     594           ;;  might be data left in the buffer)
     595           (close-connection! (request-uri req))
     596           (raise exn)))))
    590597
    591598(define (kv-ref l k #!optional default)
Note: See TracChangeset for help on using the changeset viewer.