Changeset 33747 in project


Ignore:
Timestamp:
11/19/16 14:51:31 (6 months ago)
Author:
sjamaan
Message:

http-client: Introduce max-idle-connections to avoid FD exhaustion.

This also changes the semantics of connections: The connections hash
table now stores a *list* of idle connections per host, which is
shared by all threads. Such a connection can be claimed by a thread,
making it active, which causes it to be removed from the idle list.

File:
1 edited

Legend:

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

    r33501 r33747  
    3434;
    3535(module http-client
    36   (max-retry-attempts max-redirect-depth retry-request? client-software
    37    close-connection! close-all-connections!
    38    call-with-input-request call-with-input-request*
    39    with-input-from-request call-with-response
    40    store-cookie! delete-cookie! get-cookies-for-uri
    41    http-authenticators get-username/password
    42    basic-authenticator digest-authenticator
    43    determine-username/password determine-proxy
    44    determine-proxy-from-environment determine-proxy-username/password
    45    server-connector default-server-connector)
     36    (max-retry-attempts max-redirect-depth max-idle-connections
     37     retry-request? client-software
     38     close-connection! close-idle-connections! close-all-connections!
     39     call-with-input-request call-with-input-request*
     40     with-input-from-request call-with-response
     41     store-cookie! delete-cookie! get-cookies-for-uri
     42     http-authenticators get-username/password
     43     basic-authenticator digest-authenticator
     44     determine-username/password determine-proxy
     45     determine-proxy-from-environment determine-proxy-username/password
     46     server-connector default-server-connector)
    4647
    4748(import chicken scheme lolevel)
     
    6869(define max-retry-attempts (make-parameter 1))
    6970(define max-redirect-depth (make-parameter 5))
     71;; Total idle connections.  Maybe later we'll add per-server limits.
     72(define max-idle-connections (make-parameter 32))
    7073
    7174(define retry-request? (make-parameter idempotent?))
     
    119122  (make-parameter (list (list "CHICKEN Scheme HTTP-client" "0.10" #f))))
    120123
    121 ;; TODO: find a smarter storage mechanism
    122 (define cookie-jar (list))
    123 
    124 (define connections
    125   (make-parameter (make-hash-table
    126                    (lambda (a b)
    127                      (and (equal? (uri-port a) (uri-port b))
    128                           (equal? (uri-host a) (uri-host b))))
    129                    (lambda (uri . maybe-bound)
    130                      (apply string-hash
    131                             (sprintf "~S ~S" (uri-host uri) (uri-port uri))
    132                             maybe-bound)))))
    133 
    134 (define connections-owner
    135   (make-parameter (current-thread)))
    136 
    137 (define (ensure-local-connections)
    138   (unless (eq? (connections-owner) (current-thread))
    139     (connections (make-hash-table equal?))
    140     (connections-owner (current-thread))))
     124
     125(define (with-mutex m thunk)
     126  (dynamic-wind
     127      (lambda () (mutex-lock! m))
     128      thunk
     129      (lambda () (mutex-unlock! m))))
     130
     131;; TODO: find a smarter storage mechanism.  Also, this implementation
     132;; means cookies are shared between threads, which might not (always)
     133;; be desirable.
     134(define *cookie-jar* (list))
     135
     136;; A hash table containing uri-host&port as keys.  Values are circular
     137;; lists of connections, pointing to the cons cell of the oldest one.
     138(define *idle-connections*
     139  (make-hash-table
     140   (lambda (a b)
     141     (and (equal? (uri-port a) (uri-port b))
     142          (equal? (uri-host a) (uri-host b))))
     143   (lambda (uri . maybe-bound)
     144     (apply string-hash
     145            (sprintf "~S ~S" (uri-host uri) (uri-port uri))
     146            maybe-bound))))
     147
     148;; This mutex also stores the connection count.  However, it should be
     149;; locked whenever *idle-connections* is accessed, because another
     150;; thread should not be able to claim a connection we consider using.
     151(define *idle-connections-mutex* (make-mutex '*idle-connections*))
     152(mutex-specific-set! *idle-connections-mutex* 0)
    141153
    142154(cond-expand
     
    156168        ((exn i/o net) #t))))
    157169
    158 (define (get-connection uri)
    159   (ensure-local-connections)
    160   (and-let* ((con (hash-table-ref/default (connections) uri #f)))
    161     (if (connection-dropped? con)
    162         (begin (close-connection! uri) #f)
    163         con)))
    164 
    165 (define (add-connection! uri con)
    166   (ensure-local-connections)
    167   (hash-table-set! (connections) uri con))
     170;; Remove the first (oldest) idle connection which is still alive from
     171;; the pool and return it.  Any dead connections are pruned.
     172(define (grab-idle-connection! uri)
     173  (with-mutex
     174   *idle-connections-mutex*
     175   (lambda ()
     176     (define (take-first-idle-connection!)
     177       ;; This picks the first idle connection, if any, and removes it
     178       ;; from the list.
     179       (and-let* ((head (hash-table-ref/default *idle-connections* uri #f))
     180                  (connection (car head))
     181                  (next (cdr head))
     182                  (count (mutex-specific *idle-connections-mutex*)))
     183         (if (eq? next head)
     184             (hash-table-delete! *idle-connections* uri)
     185             ;; Rip out the next entry and move its value forward
     186             (begin (set-car! head (car next))
     187                    (set-cdr! head (cdr next))))
     188         (mutex-specific-set! *idle-connections-mutex* (sub1 count))
     189         connection))
     190     
     191     (let lp ()
     192       (and-let* ((con (take-first-idle-connection!)))
     193         (cond ((connection-dropped? con)
     194                (close-connection! con)
     195                (lp))
     196               (else con)))))))
     197
     198;; If max-idle-connections is not yet reached, add it to the pool.  We
     199;; add it to the end because it is the freshest one.  This ensures
     200;; we'll re-use the oldest first, trying to keep them all alive.
     201(define (maybe-add-idle-connection! uri con)
     202  (with-mutex
     203   *idle-connections-mutex*
     204   (lambda ()
     205     (let ((count (mutex-specific *idle-connections-mutex*)))
     206       (when (< count (max-idle-connections))
     207         (cond ((hash-table-ref/default *idle-connections* uri #f) =>
     208                (lambda (oldest-con)
     209                  (let lp ((head (cdr oldest-con)))
     210                    (if (eq? (cdr head) oldest-con) ; last?
     211                        (set-cdr! head (cons con oldest-con))
     212                        (lp (cdr head))))))
     213               (else
     214                (let ((new-con (list con)))
     215                  (set-cdr! new-con new-con) ; (circular-list con)
     216                  (hash-table-set! *idle-connections* uri new-con))))
     217         (mutex-specific-set! *idle-connections-mutex* (add1 count)))))))
     218
    168219
    169220(define (close-connection! uri-or-con)
    170   (ensure-local-connections)
    171   (and-let* ((con (if (http-connection? uri-or-con)
    172                       uri-or-con
    173                       (hash-table-ref/default (connections) uri-or-con #f))))
    174     (close-input-port (http-connection-inport con))
    175     (close-output-port (http-connection-outport con))
    176     (hash-table-delete! (connections) (http-connection-base-uri con))))
    177 
    178 (define (close-all-connections!)
    179   (ensure-local-connections)
    180   (hash-table-walk
    181    (connections)
    182    (lambda (uri con)
    183      (hash-table-delete! (connections) uri)
    184      (close-input-port (http-connection-inport con))
    185      (close-output-port (http-connection-outport con)))))
     221  (cond ((http-connection? uri-or-con)
     222         (close-input-port (http-connection-inport uri-or-con))
     223         (close-output-port (http-connection-outport uri-or-con)))
     224        ((grab-idle-connection! uri-or-con) =>
     225         (lambda (con)
     226           (close-connection! con)            ; Close this one
     227           (close-connection! uri-or-con))))) ; Check for others
     228
     229
     230(define (close-idle-connections!)
     231  (with-mutex
     232   *idle-connections-mutex*
     233   (lambda ()
     234     (hash-table-walk
     235      *idle-connections*
     236      (lambda (uri conns)
     237        (for-each
     238         (lambda (con)
     239           (close-input-port (http-connection-inport con))
     240           (close-output-port (http-connection-outport con)))
     241         conns)
     242        (hash-table-delete! *idle-connections* uri)))
     243     (mutex-specific-set! *idle-connections-mutex* 0))))
     244
     245;; OBSOLETE (kept for compat, remove in CHICKEN 5 version)
     246(define close-all-connections! close-idle-connections!)
    186247
    187248;; Imports from the openssl egg, if available
     
    218279
    219280(define (ensure-connection! uri)
    220   (or (get-connection uri)
     281  (or (grab-idle-connection! uri)
    221282      (let ((proxy ((determine-proxy) uri)))
    222283        (receive (in out) ((server-connector) uri proxy)
    223           (let ((con (make-http-connection uri in out proxy)))
    224             (add-connection! uri con)
    225             con)))))
     284          (make-http-connection uri in out proxy)))))
    226285
    227286(define (make-delimited-input-port port len)
     
    298357(define (store-cookie! cookie-info set-cookie)
    299358  (let loop ((cookie (set-cookie->cookie set-cookie))
    300              (jar cookie-jar))
     359             (jar *cookie-jar*))
    301360    (cond
    302361     ((null? jar)
    303       (set! cookie-jar (cons (cons cookie-info cookie) cookie-jar))
    304       cookie-jar)
     362      (set! *cookie-jar* (cons (cons cookie-info cookie) *cookie-jar*))
     363      *cookie-jar*)
    305364     ((cookie-eq? (car (get-value set-cookie)) cookie-info
    306365                  (car (get-value (cdar jar))) (caar jar))
    307366      (set-car! jar (cons cookie-info cookie))
    308       cookie-jar)
     367      *cookie-jar*)
    309368     (else (loop cookie (cdr jar))))))
    310369
    311370(define (delete-cookie! cookie-name cookie-info)
    312   (set! cookie-jar (remove! (lambda (c)
    313                               (cookie-eq? (car (get-value (cdr c))) (car c)
    314                                           cookie-name cookie-info))
    315                             cookie-jar)))
     371  (set! *cookie-jar*
     372    (remove! (lambda (c)
     373               (cookie-eq? (car (get-value (cdr c))) (car c)
     374                           cookie-name cookie-info))
     375             *cookie-jar*)))
    316376
    317377(define (domain-match? uri pattern)
     
    354414                              (member (uri-scheme uri) '(https shttp))
    355415                              #t))))
    356                   cookie-jar)
     416                  *cookie-jar*)
    357417          (lambda (a b)
    358418            (< (length (uri-path (alist-ref 'path (car a))))
     
    522582             (redirects 0)
    523583             (req req))
    524     (condition-case
    525         (let* ((con (ensure-connection! (request-uri req)))
    526                (req (add-headers (update-request
    527                                   req port: (http-connection-outport con))))
    528                ;; No outgoing URIs should ever contain credentials or fragments
    529                (req-uri (update-uri (request-uri req)
    530                                     fragment: #f username: #f password: #f))
    531                ;; RFC1945, 5.1.2: "The absoluteURI form is only allowed
    532                ;; when the request is being made to a proxy."
    533                ;; RFC2616 is a little more regular (hosts MUST accept
    534                ;; absoluteURI), but it says "HTTP/1.1 clients will only
    535                ;; generate them in requests to proxies." (also 5.1.2)
    536                (req-uri (if (http-connection-proxy con)
    537                             req-uri
    538                             (update-uri req-uri host: #f port: #f scheme: #f
    539                                         path: (or (uri-path req-uri) '(/ "")))))
    540                (request (write-request (update-request req uri: req-uri)))
    541                ;; Writer should be prepared to be called several times
    542                ;; Maybe try and figure out a good way to use the
    543                ;; "Expect: 100-continue" header to prevent too much writing?
    544                ;; Unfortunately RFC2616 says it's unreliable (8.2.3)...
    545                (_ (begin (writer request) (flush-output (request-port req))))
    546                (response (read-response (http-connection-inport con)))
    547                (cleanup! (lambda (clear-response-data?)
    548                            (when clear-response-data?
    549                              (discard-remaining-data! response
    550                                                       (response-port response)))
    551                            (unless (and (keep-alive? request)
    552                                         (keep-alive? response))
    553                              (close-connection! con)))))
    554           (when response (process-set-cookie! con (request-uri req) response))
    555           (case (and response (response-code response))
    556             ((#f)
    557              ;; If the connection is closed prematurely, we SHOULD
    558              ;; retry, according to RFC2616, section 8.2.4.  Currently
    559              ;; don't do "binary exponential backoff", which we MAY do.
    560              (if (or (not (max-retry-attempts)) ; unlimited?
    561                      (<= attempts (max-retry-attempts)))
     584    (let* ((uri (request-uri req))
     585           (con (ensure-connection! uri)))
     586      (condition-case
     587          (let* ((req (add-headers (update-request
     588                                    req port: (http-connection-outport con))))
     589                 ;; No outgoing URIs should ever contain credentials or fragments
     590                 (req-uri (update-uri uri fragment: #f username: #f password: #f))
     591                 ;; RFC1945, 5.1.2: "The absoluteURI form is only allowed
     592                 ;; when the request is being made to a proxy."
     593                 ;; RFC2616 is a little more regular (hosts MUST accept
     594                 ;; absoluteURI), but it says "HTTP/1.1 clients will only
     595                 ;; generate them in requests to proxies." (also 5.1.2)
     596                 (req-uri (if (http-connection-proxy con)
     597                              req-uri
     598                              (update-uri req-uri host: #f port: #f scheme: #f
     599                                          path: (or (uri-path req-uri) '(/ "")))))
     600                 (request (write-request (update-request req uri: req-uri)))
     601                 ;; Writer should be prepared to be called several times
     602                 ;; Maybe try and figure out a good way to use the
     603                 ;; "Expect: 100-continue" header to prevent too much writing?
     604                 ;; Unfortunately RFC2616 says it's unreliable (8.2.3)...
     605                 (_ (begin (writer request) (flush-output (request-port req))))
     606                 (response (read-response (http-connection-inport con)))
     607                 (cleanup!
     608                  (lambda (clear-response-data?)
     609                    (when clear-response-data?
     610                      (discard-remaining-data! response
     611                                               (response-port response)))
     612                    (if (and (keep-alive? request)
     613                             (keep-alive? response))
     614                        (maybe-add-idle-connection! uri con)
     615                        (close-connection! con)))))
     616            (when response (process-set-cookie! con uri response))
     617            (case (and response (response-code response))
     618              ((#f)
     619               ;; If the connection is closed prematurely, we SHOULD
     620               ;; retry, according to RFC2616, section 8.2.4.  Currently
     621               ;; don't do "binary exponential backoff", which we MAY do.
     622               (if (or (not (max-retry-attempts)) ; unlimited?
     623                       (<= attempts (max-retry-attempts)))
     624                   (loop (add1 attempts) redirects req)
     625                   (http-client-error 'send-request
     626                                      "Server closed connection before sending response"
     627                                      (list (uri->string uri))
     628                                      'premature-disconnection
     629                                      'uri uri 'request req)))
     630              ;; TODO: According to spec, we should provide the user
     631              ;; with a choice when it's not a GET or HEAD request...
     632              ((301 302 303 307)
     633               (cleanup! #t)
     634               ;; Maybe we should switch to GET on 302 too?  It's not compliant,
     635               ;; but very widespread and there's enough software that depends
     636               ;; on that behaviour, which might break horribly otherwise...
     637               (when (= (response-code response) 303)
     638                 (request-method-set! req 'GET)) ; Switch to GET
     639               (let* ((loc-uri (header-value 'location
     640                                             (response-headers response)))
     641                      (new-uri (uri-relative-to loc-uri uri)))
     642                 (if (or (not (max-redirect-depth)) ; unlimited?
     643                         (< redirects (max-redirect-depth)))
     644                     (loop attempts
     645                           (add1 redirects)
     646                           (update-request req uri: new-uri))
     647                     (http-client-error 'send-request
     648                                        "Maximum number of redirects exceeded"
     649                                        (list (uri->string uri))
     650                                        'redirect-depth-exceeded
     651                                        'uri uri 'new-uri new-uri
     652                                        'request req))))
     653              ;; TODO: Test this
     654              ((305)             ; Use proxy (for this request only)
     655               (cleanup! #t)
     656               (let ((old-determine-proxy (determine-proxy))
     657                     (proxy-uri (header-value 'location (response-headers response))))
     658                 (parameterize ((determine-proxy
     659                                 (lambda _
     660                                   ;; Reset determine-proxy so the proxy is really
     661                                   ;; used for only this one request.
     662                                   ;; Yes, this is a bit of a hack :)
     663                                   (determine-proxy old-determine-proxy)
     664                                   proxy-uri)))
     665                   (loop attempts redirects req))))
     666              ((401 407) ; Unauthorized, Proxy Authentication Required
     667               (cond ((and (or (not (max-retry-attempts)) ; unlimited?
     668                               (<= attempts (max-retry-attempts)))
     669                           (authenticate-request req response writer
     670                                                 (http-connection-proxy con)))
     671                      => (lambda (new-req)
     672                           (cleanup! #t)
     673                           (loop (add1 attempts) redirects new-req)))
     674                     (else ;; pass it on, we can't throw an error here
     675                      (let ((data (reader response)))
     676                        (values data uri response)))))
     677              (else (let ((data (reader response)))
     678                      (cleanup! #f)
     679                      (values data uri response)))))
     680        (exn (exn i/o net)
     681             ;; Try to recover from bad connections if we may retry.
     682             (close-connection! con)
     683             (if (and (or (not (max-retry-attempts)) ; unlimited?
     684                          (<= attempts (max-retry-attempts)))
     685                      ((retry-request?) req))
    562686                 (loop (add1 attempts) redirects req)
    563                  (http-client-error 'send-request
    564                                     "Server closed connection before sending response"
    565                                     (list (uri->string (request-uri req)))
    566                                     'premature-disconnection
    567                                     'uri (request-uri req) 'request req)))
    568             ;; TODO: According to spec, we should provide the user
    569             ;; with a choice when it's not a GET or HEAD request...
    570             ((301 302 303 307)
    571              (cleanup! #t)
    572              ;; Maybe we should switch to GET on 302 too?  It's not compliant,
    573              ;; but very widespread and there's enough software that depends
    574              ;; on that behaviour, which might break horribly otherwise...
    575              (when (= (response-code response) 303)
    576                (request-method-set! req 'GET)) ; Switch to GET
    577              (let* ((loc-uri (header-value 'location
    578                                            (response-headers response)))
    579                     (new-uri (uri-relative-to loc-uri (request-uri req))))
    580                (if (or (not (max-redirect-depth)) ; unlimited?
    581                        (< redirects (max-redirect-depth)))
    582                    (loop attempts
    583                          (add1 redirects)
    584                          (update-request req uri: new-uri))
    585                    (http-client-error 'send-request
    586                                       "Maximum number of redirects exceeded"
    587                                       (list (uri->string (request-uri request)))
    588                                       'redirect-depth-exceeded
    589                                       'uri (request-uri req)
    590                                       'new-uri new-uri 'request req))))
    591             ;; TODO: Test this
    592             ((305)                 ; Use proxy (for this request only)
    593              (cleanup! #t)
    594              (let ((old-determine-proxy (determine-proxy))
    595                    (proxy-uri (header-value 'location (response-headers response))))
    596                (parameterize ((determine-proxy
    597                                (lambda _
    598                                  ;; Reset determine-proxy so the proxy is really
    599                                  ;; used for only this one request.
    600                                  ;; Yes, this is a bit of a hack :)
    601                                  (determine-proxy old-determine-proxy)
    602                                  proxy-uri)))
    603                  (loop attempts redirects req))))
    604             ((401 407)   ; Unauthorized, Proxy Authentication Required
    605              (cond ((and (or (not (max-retry-attempts)) ; unlimited?
    606                              (<= attempts (max-retry-attempts)))
    607                          (authenticate-request req response writer
    608                                                (http-connection-proxy con)))
    609                     => (lambda (new-req)
    610                          (cleanup! #t)
    611                          (loop (add1 attempts) redirects new-req)))
    612                    (else ;; pass it on, we can't throw an error here
    613                     (let ((data (reader response)))
    614                       (values data (request-uri request) response)))))
    615             (else (let ((data (reader response)))
    616                     (cleanup! #f)
    617                     (values data (request-uri req) response)))))
    618       (exn (exn i/o net)
    619            (close-connection! (request-uri req))
    620            (if (and (or (not (max-retry-attempts)) ; unlimited?
    621                         (<= attempts (max-retry-attempts)))
    622                     ((retry-request?) req))
    623                (loop (add1 attempts) redirects req)
    624                (raise exn)))
    625       (exn ()
     687                 (raise exn)))
     688        (exn ()
    626689           ;; Never leave the port in an unknown/inconsistent state
    627690           ;; (the error could have occurred while reading, so there
    628691           ;;  might be data left in the buffer)
    629            (close-connection! (request-uri req))
    630            (raise exn)))))
     692           (close-connection! uri)
     693           (raise exn))))))
    631694
    632695(define (kv-ref l k #!optional default)
Note: See TracChangeset for help on using the changeset viewer.