Changeset 20759 in project


Ignore:
Timestamp:
10/10/10 14:57:32 (11 years ago)
Author:
sjamaan
Message:

http-client: Implement proxy authentication

File:
1 edited

Legend:

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

    r20750 r20759  
    5252;;    repeatedly. This client doesn't do request pipelining so we don't
    5353;;    generate requests with the same nonce if the server doesn't)
    54 ;; * Implement authorization support for proxies
    5554;; * Find a way to do automated testing to increase robustness & reliability
    5655;; * Test and document SSL support
     
    9190
    9291(define determine-proxy (make-parameter determine-proxy-from-environment))
     92
     93(define determine-proxy-username/password
     94  (make-parameter (lambda (uri realm)
     95                    (values (uri-username uri) (uri-password uri)))))
    9396
    9497;; Maybe only pass uri and realm to this?
     
    338341        (byte-string->hexadecimal result)))))
    339342
    340 (define (authenticate-request request response writer)
    341   (let ((authtype (header-value 'www-authenticate
    342                                 (response-headers response)))
    343         (realm (header-param 'realm 'www-authenticate
    344                              (response-headers response))))
     343(define (authenticate-request request response writer proxy-uri)
     344  (and-let* ((type (if (= (response-code response) 401) 'auth 'proxy))
     345             (resp-header (if (eq? type 'auth)
     346                              'www-authenticate
     347                              'proxy-authenticate))
     348             (req-header (if (eq? type 'auth)
     349                             'authorization
     350                             'proxy-authorization))
     351             (authenticate (if (eq? type 'auth)
     352                               (determine-username/password)
     353                               (determine-proxy-username/password)))
     354             (authtype (header-value resp-header (response-headers response)))
     355             (realm (header-param 'realm resp-header (response-headers response)))
     356             (auth-uri (if (eq? type 'auth) (request-uri request) proxy-uri)))
    345357    (receive (username password)
    346       ((determine-username/password)
    347        (request-uri request) realm)
     358      (authenticate auth-uri realm)
    348359      (and username password
    349360           ;; TODO: Maybe we should implement a way to make it ask
     
    355366               request
    356367               headers: (headers
    357                          `((authorization
     368                         `((,req-header
    358369                            #(basic ((username . ,username)
    359370                                     (password . ,password)))))
     
    367378                     ;; TODO: domain handling
    368379                     (h (response-headers response))
    369                      (nonce (header-param 'nonce 'www-authenticate h))
    370                      (opaque (header-param 'opaque 'www-authenticate h))
    371                      (stale (header-param 'stale 'www-authenticate h))
     380                     (nonce (header-param 'nonce resp-header h))
     381                     (opaque (header-param 'opaque resp-header h))
     382                     (stale (header-param 'stale resp-header h))
    372383                     ;; TODO: "md5-sess" algorithm handling
    373                      (algorithm (header-param 'algorithm 'www-authenticate h))
    374                      (qops (header-param 'qop 'www-authenticate h '()))
     384                     (algorithm (header-param 'algorithm resp-header h))
     385                     (qops (header-param 'qop resp-header h '()))
    375386                     (qop (cond ; Pick the strongest of the offered options
    376387                           ((member 'auth-int qops) 'auth-int)
     
    400411                (update-request request
    401412                                headers: (headers
    402                                           `((authorization
     413                                          `((,req-header
    403414                                             #(digest ((username . ,username)
    404415                                                       (uri . ,authless-uri)
     
    482493                               proxy-uri)))
    483494               (loop attempts redirects req))))
    484           ((401)                        ; Unauthorized
    485            (cleanup! #t)
     495          ((401 407)          ; Unauthorized, Proxy Authentication Required
    486496           (or (and-let* (((or (not (max-retry-attempts)) ; unlimited?
    487497                               (<= attempts (max-retry-attempts))))
    488                           (new-req (authenticate-request req response writer)))
     498                          (new-req (authenticate-request
     499                                    req response writer
     500                                    (http-connection-proxy con))))
     501                 (cleanup! #t)
    489502                 (loop (add1 attempts) redirects new-req))
    490503               ;; pass it on, we can't throw an error here
    491504               (let ((data (reader response)))
    492505                 (values data (request-uri request) response))))
    493           ;; TODO: Support for 407 Proxy Authentication Required
    494506          (else (let ((data (reader response)))
    495507                  (cleanup! #f)
Note: See TracChangeset for help on using the changeset viewer.