Changeset 32633 in project


Ignore:
Timestamp:
08/01/15 14:24:38 (5 years ago)
Author:
sjamaan
Message:

Summary: http-client: Add support for custom connection-making procedures via a parameter. Fixes #1210 (thanks to Ryan Senior)

File:
1 edited

Legend:

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

    r32596 r32633  
    4242   basic-authenticator digest-authenticator
    4343   determine-username/password determine-proxy
    44    determine-proxy-from-environment determine-proxy-username/password)
     44   determine-proxy-from-environment determine-proxy-username/password
     45   server-connector default-server-connector)
    4546
    4647(import chicken scheme lolevel)
     
    184185  (dynamic-import 'openssl 'ssl-connect (lambda (h p) (values #f #f))))
    185186
     187(define (default-server-connector uri proxy)
     188  (let ((remote-end (or proxy uri)))
     189    (case (uri-scheme remote-end)
     190      ((#f http) (tcp-connect (uri-host remote-end) (uri-port remote-end)))
     191      ((https) (receive (in out)
     192                   (ssl-connect (uri-host remote-end)
     193                                (uri-port remote-end))
     194                 (if (and in out)       ; Ugly, but necessary
     195                     (values in out)
     196                     (http-client-error
     197                      'ssl-connect
     198                      (conc "Unable to connect over HTTPS. To fix this, "
     199                            "install the openssl egg and try again")
     200                      (list (uri->string uri))
     201                      'missing-openssl-egg
     202                      'request-uri uri 'proxy proxy))))
     203      (else (http-client-error 'ensure-connection!
     204                               "Unknown URI scheme"
     205                               (list (uri-scheme remote-end))
     206                               'unsupported-uri-scheme
     207                               'uri-scheme (uri-scheme remote-end)
     208                               'request-uri uri 'proxy proxy)))))
     209
     210(define server-connector (make-parameter default-server-connector))
     211
    186212(define (ensure-connection! uri)
    187213  (or (get-connection uri)
    188       (let* ((proxy ((determine-proxy) uri))
    189              (remote-end (or proxy uri)))
    190        (receive (in out)
    191          (case (uri-scheme remote-end)
    192            ((#f http) (tcp-connect (uri-host remote-end) (uri-port remote-end)))
    193            ((https) (receive (in out)
    194                         (ssl-connect (uri-host remote-end)
    195                                      (uri-port remote-end))
    196                       (if (and in out)  ; Ugly, but necessary
    197                           (values in out)
    198                           (http-client-error
    199                            'ssl-connect
    200                            (conc "Unable to connect over HTTPS. To fix this, "
    201                                  "install the openssl egg and try again")
    202                            (list (uri->string uri))
    203                            'missing-openssl-egg
    204                            'request-uri uri 'proxy proxy))))
    205            (else (http-client-error 'ensure-connection!
    206                                     "Unknown URI scheme"
    207                                     (list (uri-scheme remote-end))
    208                                     'unsupported-uri-scheme
    209                                     'uri-scheme (uri-scheme remote-end)
    210                                     'request-uri uri 'proxy proxy)))
    211          (let ((con (make-http-connection uri in out proxy)))
    212            (add-connection! uri con)
    213            con)))))
     214      (let ((proxy ((determine-proxy) uri)))
     215        (receive (in out) ((server-connector) uri proxy)
     216          (let ((con (make-http-connection uri in out proxy)))
     217            (add-connection! uri con)
     218            con)))))
    214219
    215220(define (make-delimited-input-port port len)
Note: See TracChangeset for help on using the changeset viewer.