Changeset 15567 in project


Ignore:
Timestamp:
08/25/09 18:25:26 (10 years ago)
Author:
sjamaan
Message:

Add content-type if the writer is an alist

File:
1 edited

Legend:

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

    r15565 r15567  
    347347                                                 (password . ,password)))))
    348348                                     (request-headers req)))))
     349                   #;((digest)
     350                    (let* ((params (header-params 'www-authenticate
     351                                                  (response-headers response)))
     352                           (qops (alist-ref 'qop header-params eq? '()))
     353                           (qop (cond
     354                                 ((member 'auth-int qops) 'auth-int)
     355                                 ((member 'auth qops) 'auth)
     356                                 (else #f)))
     357                           (cnonce (and qop "client-nonce-TODO"))
     358                           (nonce (header-param 'nonce header-params))
     359                           (nc (and qop 1)) ;; TODO
     360                           (hashconc (lambda args
     361                                       (md5 (string-join
     362                                             (map ->string args) ":"))))
     363                           (realm (alist-ref 'realm header-params))
     364                           (method (alist-ref 'method header-params))
     365                           (h1 (hashconc username realm password))
     366                           (h2 (if (eq? qop 'auth-int)
     367                                   (hashconc method
     368                                             (uri->string
     369                                              (request-uri req)
     370                                              (constantly ""))
     371                                             "message-body") ; TODO
     372                                   (hashconc method (uri->string
     373                                                     (request-uri req)
     374                                                     (constantly "")))))
     375                           (response-digest
     376                            (case qop
     377                              ((auth-int) #f ; TODO
     378                               )
     379                              ((auth) #f ; TODO
     380                               )
     381                              (else
     382                               (conc h1 nonce h2)))))
     383                      (loop (add1 attempts)
     384                            redirects
     385                            (update-request
     386                             req
     387                             headers:
     388                             (headers
     389                              `((authorization
     390                                 #(digest
     391                                   ((username . ,username)
     392                                    (uri . ,(request-uri req))
     393                                    (realm . ,(alist-ref params 'realm))
     394                                    (nonce . ,(alist-ref params 'nonce))
     395                                    (cnonce . ,cnonce)
     396                                    (nc . ,nc)
     397                                    (response . ,response-digest)
     398                                    (opaque . ,(alist-ref params 'opaque))))))
     399                              (request-headers req))))))
    349400                   (else (error "Should never get here"))))
    350401               ;; pass it on, we can't throw an error here
     
    374425                       (and (list? writer)
    375426                            (form-urlencode writer separator: "&"))))
    376          (writer (if writer
    377                      (if postdata
    378                          (lambda (p)
    379                            (display postdata p)
    380                            (close-output-port p))
    381                          writer)
    382                      (lambda x (void))))
     427         (write-data! (if writer
     428                          (if postdata
     429                              (lambda (p)
     430                                (display postdata p)
     431                                (close-output-port p))
     432                              writer)
     433                          (lambda x (void))))
    383434         (uri (cond ((uri? uri-or-request) uri-or-request)
    384435                    ((string? uri-or-request) (uri-reference uri-or-request))
     
    391442                   req
    392443                   headers: (headers
    393                              `((content-length ,(string-length postdata)))
     444                             `((content-length ,(string-length postdata))
     445                               ,@(if (list? writer)
     446                                     `((content-type
     447                                        application/x-www-form-urlencoded))
     448                                     `()))
    394449                             (request-headers req)))
    395450                  req)))
     
    398453     (lambda (request)
    399454       (let ((port (request-port request)))
    400          (writer port)))
     455         (write-data! port)))
    401456     (lambda (response)
    402457       (let ((port (make-delimited-input-port
Note: See TracChangeset for help on using the changeset viewer.