Changeset 18094 in project


Ignore:
Timestamp:
05/16/10 14:08:41 (9 years ago)
Author:
sjamaan
Message:

Don't try to authenticate when no username & password are supplied

File:
1 edited

Legend:

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

    r16936 r18094  
    308308      ((determine-username/password)
    309309       (request-uri request) realm)
    310       ;; TODO: Maybe we should implement a way to make it ask
    311       ;; the question only once. This would be faster, but
    312       ;; maybe less secure. (we should at least use domain info)
    313       (case authtype
    314         ((basic)
    315          (update-request
    316           request
    317           headers: (headers
    318                     `((authorization
    319                        #(basic ((username . ,username)
    320                                 (password . ,password)))))
    321                     (request-headers request))))
    322         ((digest)
    323          (let* ((hashconc
    324                  (lambda args
    325                    (md5-digest (string-join (map ->string args) ":"))))
    326                 (authless-uri (update-uri (request-uri request)
    327                                           username: #f password: #f))
    328                 ;; TODO: domain handling
    329                 (h (response-headers response))
    330                 (nonce (header-param 'nonce 'www-authenticate h))
    331                 (opaque (header-param 'opaque 'www-authenticate h))
    332                 (stale (header-param 'stale 'www-authenticate h))
    333                 ;; TODO: "md5-sess" algorithm handling
    334                 (algorithm (header-param 'algorithm 'www-authenticate h))
    335                 (qops (header-param 'qop 'www-authenticate h '()))
    336                 (qop (cond ; Pick the strongest of the offered options
    337                       ((member 'auth-int qops) 'auth-int)
    338                       ((member 'auth qops) 'auth)
    339                       (else #f)))
    340                 (cnonce (and qop (hashconc (current-seconds) realm)))
    341                 (nc (and qop 1)) ;; TODO
    342                 (ha1 (hashconc username realm password))
    343                 (ha2 (if (eq? qop 'auth-int)
    344                          (hashconc (request-method request)
    345                                    (uri->string authless-uri)
    346                                    ;; Generate digest from writer's output
    347                                    (call-with-output-digest
    348                                     (md5-primitive)
    349                                     (lambda (p)
    350                                       (writer
    351                                        (update-request request port: p)))))
    352                          (hashconc (request-method request)
    353                                    (uri->string authless-uri))))
    354                 (digest
    355                  (case qop
    356                    ((auth-int auth)
    357                     (let ((hex-nc (string-pad (number->string nc 16) 8 #\0)))
    358                       (hashconc ha1 nonce hex-nc cnonce qop ha2)))
    359                    (else
    360                     (hashconc ha1 nonce ha2)))))
    361            (update-request
    362             request headers: (headers
    363                               `((authorization #(digest ((username . ,username)
    364                                                          (uri . ,authless-uri)
    365                                                          (realm . ,realm)
    366                                                          (nonce . ,nonce)
    367                                                          (cnonce . ,cnonce)
    368                                                          (qop . ,qop)
    369                                                          (nc . ,nc)
    370                                                          (response . ,digest)
    371                                                          (opaque . ,opaque)))))
    372                               (request-headers request)))))
    373         (else (http-client-error 'authenticate-request
    374                                  "Unknown authentication type"
    375                                  'unknown-authtype 'authtype authtype))))))
     310      (and username password
     311           ;; TODO: Maybe we should implement a way to make it ask
     312           ;; the question only once. This would be faster, but
     313           ;; maybe less secure. (we should at least use domain info)
     314           (case authtype
     315             ((basic)
     316              (update-request
     317               request
     318               headers: (headers
     319                         `((authorization
     320                            #(basic ((username . ,username)
     321                                     (password . ,password)))))
     322                         (request-headers request))))
     323             ((digest)
     324              (let* ((hashconc
     325                      (lambda args
     326                        (md5-digest (string-join (map ->string args) ":"))))
     327                     (authless-uri (update-uri (request-uri request)
     328                                               username: #f password: #f))
     329                     ;; TODO: domain handling
     330                     (h (response-headers response))
     331                     (nonce (header-param 'nonce 'www-authenticate h))
     332                     (opaque (header-param 'opaque 'www-authenticate h))
     333                     (stale (header-param 'stale 'www-authenticate h))
     334                     ;; TODO: "md5-sess" algorithm handling
     335                     (algorithm (header-param 'algorithm 'www-authenticate h))
     336                     (qops (header-param 'qop 'www-authenticate h '()))
     337                     (qop (cond ; Pick the strongest of the offered options
     338                           ((member 'auth-int qops) 'auth-int)
     339                           ((member 'auth qops) 'auth)
     340                           (else #f)))
     341                     (cnonce (and qop (hashconc (current-seconds) realm)))
     342                     (nc (and qop 1)) ;; TODO
     343                     (ha1 (hashconc username realm password))
     344                     (ha2 (if (eq? qop 'auth-int)
     345                              (hashconc (request-method request)
     346                                        (uri->string authless-uri)
     347                                        ;; Generate digest from writer's output
     348                                        (call-with-output-digest
     349                                         (md5-primitive)
     350                                         (lambda (p)
     351                                           (writer
     352                                            (update-request request port: p)))))
     353                              (hashconc (request-method request)
     354                                        (uri->string authless-uri))))
     355                     (digest
     356                      (case qop
     357                        ((auth-int auth)
     358                         (let ((hex-nc (string-pad (number->string nc 16) 8 #\0)))
     359                           (hashconc ha1 nonce hex-nc cnonce qop ha2)))
     360                        (else
     361                         (hashconc ha1 nonce ha2)))))
     362                (update-request request
     363                                headers: (headers
     364                                          `((authorization
     365                                             #(digest ((username . ,username)
     366                                                       (uri . ,authless-uri)
     367                                                       (realm . ,realm)
     368                                                       (nonce . ,nonce)
     369                                                       (cnonce . ,cnonce)
     370                                                       (qop . ,qop)
     371                                                       (nc . ,nc)
     372                                                       (response . ,digest)
     373                                                       (opaque . ,opaque)))))
     374                                          (request-headers request)))))
     375             (else (http-client-error 'authenticate-request
     376                                      "Unknown authentication type"
     377                                      'unknown-authtype 'authtype authtype)))))))
    376378
    377379(define (call-with-response req writer reader)
     
    428430           (read-response-data response)
    429431           (cleanup!)
    430            (if (or (not (max-retry-attempts)) ; unlimited?
    431                    (<= attempts (max-retry-attempts)))
    432                (loop (add1 attempts) redirects
    433                      (authenticate-request req response writer))
     432           (or (and-let* (((or (not (max-retry-attempts)) ; unlimited?
     433                               (<= attempts (max-retry-attempts))))
     434                          (new-req (authenticate-request req response writer)))
     435                 (loop (add1 attempts) redirects new-req))
    434436               ;; pass it on, we can't throw an error here
    435437               (let ((data (reader response)))
Note: See TracChangeset for help on using the changeset viewer.