added a header callback for improve compatibility with xenmgr/http

diff --git a/libs/http/http.ml b/libs/http/http.ml
index 5528a10b9e583bf07aa71236112fa97b53e705ec..c1ecad4f99e5568546496f106e5d0d1565bfa5c3 100644 (file)
--- a/libs/http/http.ml
+++ b/libs/http/http.ml
@@ -997,11 +997,14 @@ module Request = struct
                | In_payload of Payload.state
                | Done
 
+       type header_callback = Request_header.t -> Request_header.t
+
        type state =
        {
                mutable cursor: cursor;
                mutable s_request: Request_header.t option;
-               mutable num_bytes_parsed: int64
+               mutable num_bytes_parsed: int64;
+               header_callback: header_callback option;
        }
 
        type error =
@@ -1015,11 +1018,12 @@ module Request = struct
 
        let raise_error err = raise (Http_error err)
 
-       let init_state () =
+       let init_state ?header_callback () =
        {
                cursor = In_request_header (Request_header.init_state ());
                s_request = None;
-               num_bytes_parsed = 0L
+               num_bytes_parsed = 0L;
+               header_callback = header_callback
        }
 
        let num_bytes_parsed s =
@@ -1044,6 +1048,10 @@ module Request = struct
                | In_request_header rs ->
                        (match Request_header.parse_substring rs str ofs len with
                         | Request_header.Result (v, consumed) ->
+                               let v = (match state.header_callback with
+                                        | None -> v
+                                        | Some f -> f v 
+                                       ) in
                                state.s_request <- Some v;
                                state.num_bytes_parsed <- Int64.of_int (Request_header.num_bytes_parsed rs);
                                (match Payload.init_from_request v with
@@ -1097,11 +1105,14 @@ module Response = struct
                | In_payload of Payload.state
                | Done
 
+       type header_callback = Response_header.t -> Response_header.t
+
        type state =
        {
                mutable cursor: cursor;
                mutable s_response: Response_header.t option;
-               mutable num_bytes_parsed: int64
+               mutable num_bytes_parsed: int64;
+               header_callback: header_callback option;
        }
 
        type error =
@@ -1115,11 +1126,12 @@ module Response = struct
 
        let raise_error err = raise (Http_error err)
 
-       let init_state () =
+       let init_state ?header_callback () =
        {
                cursor = In_response_header (Response_header.init_state ());
                s_response = None;
-               num_bytes_parsed = 0L
+               num_bytes_parsed = 0L;
+               header_callback = header_callback;
        }
 
        let num_bytes_parsed s =
@@ -1144,6 +1156,10 @@ module Response = struct
                | In_response_header rs ->
                        (match Response_header.parse rs str with
                         | Response_header.Result (v, consumed) ->
+                               let v = (match state.header_callback with
+                                        | None -> v
+                                        | Some f -> f v 
+                                       ) in
                                state.s_response <- Some v;
                                state.num_bytes_parsed <- Int64.of_int (Response_header.num_bytes_parsed rs);
                                (match Payload.init_from_response v with

diff --git a/libs/http/http.mli b/libs/http/http.mli
index 4ffdf564e0ab812af8a7977351d607a03f8090a3..4c0f3e9cfd03beaa59fc8e85099ce26a52b465b2 100644 (file)
--- a/libs/http/http.mli
+++ b/libs/http/http.mli
@@ -112,7 +112,9 @@ end
 
 module Request : sig
        type state
-       val init_state : unit -> state
+       type header_callback = Request_header.t -> Request_header.t
+
+       val init_state : ?header_callback:header_callback -> unit -> state
        val num_bytes_parsed : state -> int64
 
        type error
@@ -138,7 +140,9 @@ end
 
 module Response : sig
        type state
-       val init_state : unit -> state
+       type header_callback = Response_header.t -> Response_header.t
+
+       val init_state : ?header_callback:header_callback -> unit -> state
        val num_bytes_parsed : state -> int64
 
        type error = Internal_error of string