Changeset 16149 in project


Ignore:
Timestamp:
10/07/09 23:14:27 (10 years ago)
Author:
sjamaan
Message:

Add some digest auth code. Not finished yet

Location:
release/4/http-client/trunk
Files:
2 edited

Legend:

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

    r15092 r16149  
    11((egg "http-client.egg")
    22 (synopsis "High-level HTTP client library")
    3  (depends intarweb openssl (uri-common 0.7))
     3 (depends intarweb openssl (uri-common 0.7) md5)
    44 (author "Peter Bex")
    55 (category net)
  • release/4/http-client/trunk/http-client.scm

    r15931 r16149  
    4040(use srfi-1 srfi-13 srfi-18 srfi-69
    4141     ports extras tcp data-structures
    42      openssl intarweb uri-common)
     42     openssl intarweb uri-common md5)
    4343
    4444;; TODO: Add cookie management API to export list
     
    334334                 ;; TODO: Maybe we should implement a way to make it ask
    335335                 ;; the question only once. This would be faster, but
    336                  ;; maybe less secure.
     336                 ;; maybe less secure. (we should at least use domain info)
    337337                 (case authtype
    338338                   ((basic)
     
    346346                                                 (password . ,password)))))
    347347                                     (request-headers req)))))
    348                    #;((digest)
    349                     (let* ((params (header-params 'www-authenticate
    350                                                   (response-headers response)))
    351                            (qops (alist-ref 'qop header-params eq? '()))
     348                   ((digest)
     349                    (let* ((hashconc (lambda args
     350                                       (md5-digest (string-join
     351                                                    (map ->string args) ":"))))
     352                           ;; TODO: domain handling
     353                           (h (response-headers response))
     354                           (realm (header-param 'realm 'www-authenticate h))
     355                           (nonce (header-param 'nonce 'www-authenticate h))
     356                           (opaque (header-param 'opaque 'www-authenticate h))
     357                           (stale (header-param 'stale 'www-authenticate h))
     358                           (algorithm (header-param 'algorithm 'www-authenticate h))
     359                           (qops (header-param 'qop 'www-authenticate h '()))
    352360                           (qop (cond
    353361                                 ((member 'auth-int qops) 'auth-int)
    354362                                 ((member 'auth qops) 'auth)
    355363                                 (else #f)))
    356                            (cnonce (and qop "client-nonce-TODO"))
    357                            (nonce (header-param 'nonce header-params))
     364                           (cnonce (and qop (hashconc (current-seconds) realm)))
    358365                           (nc (and qop 1)) ;; TODO
    359                            (hashconc (lambda args
    360                                        (md5 (string-join
    361                                              (map ->string args) ":"))))
    362                            (realm (alist-ref 'realm header-params))
    363                            (method (alist-ref 'method header-params))
    364366                           (h1 (hashconc username realm password))
    365367                           (h2 (if (eq? qop 'auth-int)
    366                                    (hashconc method
    367                                              (uri->string
    368                                               (request-uri req)
    369                                               (constantly ""))
     368                                   (hashconc (request-method req)
     369                                             (uri->string (request-uri req)
     370                                                          (constantly ""))
    370371                                             "message-body") ; TODO
    371                                    (hashconc method (uri->string
    372                                                      (request-uri req)
    373                                                      (constantly "")))))
     372                                   (hashconc (request-method req)
     373                                             (uri->string (request-uri req)
     374                                                          (constantly "")))))
    374375                           (response-digest
    375376                            (case qop
    376                               ((auth-int) #f ; TODO
    377                                )
    378                               ((auth) #f ; TODO
    379                                )
     377                              ((auth-int auth)
     378                               (hashconc h1 nc cnonce qop h2))
    380379                              (else
    381                                (conc h1 nonce h2)))))
     380                               (hashconc h1 nonce h2)))))
     381                      (print (header-params 'www-authenticate h))
     382                      (print `#(digest
     383                                ((username . ,username)
     384                                 (uri . ,(request-uri req))
     385                                 (realm . ,realm)
     386                                 (nonce . ,nonce)
     387                                 (cnonce . ,cnonce)
     388                                 (nc . ,nc)
     389                                 (response . ,response-digest)
     390                                 (opaque . ,opaque))))
    382391                      (loop (add1 attempts)
    383392                            redirects
     
    390399                                   ((username . ,username)
    391400                                    (uri . ,(request-uri req))
    392                                     (realm . ,(alist-ref params 'realm))
    393                                     (nonce . ,(alist-ref params 'nonce))
     401                                    (realm . ,realm)
     402                                    (nonce . ,nonce)
    394403                                    (cnonce . ,cnonce)
    395404                                    (nc . ,nc)
    396405                                    (response . ,response-digest)
    397                                     (opaque . ,(alist-ref params 'opaque))))))
     406                                    (opaque . ,opaque)))))
    398407                              (request-headers req))))))
    399408                   (else (error "Should never get here"))))
Note: See TracChangeset for help on using the changeset viewer.