chicken-janitors
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Chicken-janitors] #1392: Ability to customise http-client headers for e


From: Chicken Trac
Subject: [Chicken-janitors] #1392: Ability to customise http-client headers for each request
Date: Tue, 22 Aug 2017 13:37:46 -0000

#1392: Ability to customise http-client headers for each request
-------------------------+--------------------------------
 Reporter:  caolan       |                 Owner:  sjamaan
     Type:  defect       |                Status:  new
 Priority:  major        |             Milestone:  someday
Component:  extensions   |               Version:  4.12.0
 Keywords:  http-client  |  Estimated difficulty:
-------------------------+--------------------------------
 I propose adding a (prepare-request) parameter to the http-client egg.
 This allows me to add etag and if-modified-since headers to all (even
 redirected) requests made by http-client, based on the current request
 URI.

 {{{#!diff
 Index: http-client.scm
 ===================================================================
 --- http-client.scm     (revision 34324)
 +++ http-client.scm     (working copy)
 @@ -43,7 +43,8 @@
       basic-authenticator digest-authenticator
       determine-username/password determine-proxy
       determine-proxy-from-environment determine-proxy-username/password
 -     server-connector default-server-connector)
 +     server-connector default-server-connector
 +     prepare-request default-prepare-request)

  (import chicken scheme lolevel)
  (use srfi-1 srfi-13 srfi-18 srfi-69
 @@ -333,12 +334,10 @@
              (when (> (read-string! (string-length buf) buf port) 0)
                (loop #f)))))))

 -(define (add-headers req)
 +(define (default-prepare-request req)
    (let* ((uri (request-uri req))
           (cookies (get-cookies-for-uri (request-uri req)))
           (h `(,@(if (not (null? cookies)) `((cookie . ,cookies)) '())
 -              (host ,(cons (uri-host uri) (and (not (uri-default-port?
 uri))
 -                                               (uri-port uri))))
                ,@(if (and (client-software) (not (null? (client-
 software))))
                      `((user-agent ,(client-software)))
                      '()))))
 @@ -345,6 +344,8 @@
      (update-request req
                      headers: (headers h (request-headers req)))))

 +(define prepare-request (make-parameter default-prepare-request))
 +
  (define (http-client-error loc msg args specific . rest)
    (raise (make-composite-condition
            (make-property-condition 'exn 'location loc 'message msg
 'arguments args)
 @@ -587,8 +588,15 @@
      (let* ((uri (request-uri req))
             (con (ensure-connection! uri)))
        (condition-case
 -          (let* ((req (add-headers (update-request
 -                                    req port: (http-connection-outport
 con))))
 +          (let* ((req ((prepare-request)
 +                       (update-request
 +                        req
 +                        headers: (headers
 +                                  `((host ,(cons (uri-host uri)
 +                                                 (and (not (uri-default-
 port? uri))
 +                                                      (uri-port uri)))))
 +                                  (request-headers req))
 +                        port: (http-connection-outport con))))
                   ;; No outgoing URIs should ever contain credentials or
 fragments
                   (req-uri (update-uri uri fragment: #f username: #f
 password: #f))
                   ;; RFC1945, 5.1.2: "The absoluteURI form is only allowed
 }}}

--
Ticket URL: <https://bugs.call-cc.org/ticket/1392>
CHICKEN Scheme <https://www.call-cc.org/>
CHICKEN Scheme is a compiler for the Scheme programming language.

reply via email to

[Prev in Thread] Current Thread [Next in Thread]