Signed-off-by: Jon Ludlam <[email protected]>
http-svr/Makefile | 8 +++++--- http-svr/http.ml | 22 ++++++++++++---------- http-svr/http.mli | 5 ++++- http-svr/http_svr.ml | 12 ++++++------ 4 files changed, 27 insertions(+), 20 deletions(-)
# HG changeset patch # User Jonathan Ludlam <[email protected]> # Date 1276865807 -3600 # Node ID f57a8764fc6fefe7a00ee747bc33a38c71ca051c # Parent 543ffb14b17334bc9f513f68d3e7fac5043c6c3b Change the 'close' field in the request record to be mutable rather than a reference Signed-off-by: Jon Ludlam <[email protected]> diff -r 543ffb14b173 -r f57a8764fc6f http-svr/Makefile --- a/http-svr/Makefile +++ b/http-svr/Makefile @@ -8,6 +8,8 @@ VERSION := $(shell hg parents --template "{rev}" 2>/dev/null || echo 0.0) OCAMLOPTFLAGS = -g -dtypes +PP = camlp4o -I ../rpc-light -I $(shell ocamlfind query type-conv) pa_type_conv.cmo pa_rpc.cma + OCAMLABI := $(shell ocamlc -version) OCAMLLIBDIR := $(shell ocamlc -where) OCAMLDESTDIR ?= $(OCAMLLIBDIR) @@ -31,13 +33,13 @@ $(OCAMLC) -a -o $@ $(foreach obj,$(OBJS),$(obj).cmo) %.cmo: %.ml %.cmi - $(OCAMLC) -c -thread -I ../stdext -I ../log -o $@ $< + $(OCAMLC) -c -pp '${PP}' -thread -I ../rpc-light -I ../stdext -I ../log -o $@ $< %.cmi: %.mli - $(OCAMLC) -c -thread -o $@ $< + $(OCAMLC) -c -I ../rpc-light -thread -o $@ $< %.cmx: %.ml %.cmi - $(OCAMLOPT) $(OCAMLOPTFLAGS) -c -thread -I ../stdext -I ../log -o $@ $< + $(OCAMLOPT) $(OCAMLOPTFLAGS) -pp '${PP}' -c -thread -I ../rpc-light -I ../stdext -I ../log -o $@ $< %.o: %.c $(CC) $(CFLAGS) -c -o $@ $< diff -r 543ffb14b173 -r f57a8764fc6f http-svr/http.ml --- a/http-svr/http.ml +++ b/http-svr/http.ml @@ -98,16 +98,12 @@ String.sub r 0 ((String.length r)-1) type method_t = Get | Post | Put | Connect | Unknown of string -let string_of_method_t = function - | Get -> "GET" | Post -> "POST" | Put -> "PUT" | Connect -> "CONNECT" | Unknown x -> "Unknown " ^ x -let method_t_of_string = function - | "GET" -> Get | "POST" -> Post | "PUT" -> Put | "CONNECT" -> Connect | x -> Unknown x -type authorization = +and authorization = | Basic of string * string | UnknownAuth of string -type request = { m: method_t; +and request = { m: method_t; uri: string; query: (string*string) list; version: string; @@ -119,8 +115,14 @@ subtask_of: string option; content_type: string option; user_agent: string option; - close: bool ref; - headers: string list;} + mutable close: bool; + headers: string list} with rpc + +let string_of_method_t = function + | Get -> "GET" | Post -> "POST" | Put -> "PUT" | Connect -> "CONNECT" | Unknown x -> "Unknown " ^ x +let method_t_of_string = function + | "GET" -> Get | "POST" -> Post | "PUT" -> Put | "CONNECT" -> Connect | x -> Unknown x + let nullreq = { m=Unknown ""; uri=""; @@ -134,7 +136,7 @@ subtask_of=None; content_type = None; user_agent = None; - close= ref true; + close= true; headers=[];} let authorization_of_string x = @@ -218,7 +220,7 @@ let uri, query = parse_uri uri in { m = method_t_of_string m; uri = uri; query = query; content_length = None; transfer_encoding = None; - version = version; cookie = []; auth = None; task = None; subtask_of = None; content_type = None; user_agent = None; close=ref false; headers=[] } + version = version; cookie = []; auth = None; task = None; subtask_of = None; content_type = None; user_agent = None; close=false; headers=[] } | _ -> raise Http_parse_failure let pretty_string_of_request x = diff -r 543ffb14b173 -r f57a8764fc6f http-svr/http.mli --- a/http-svr/http.mli +++ b/http-svr/http.mli @@ -38,9 +38,12 @@ subtask_of: string option; content_type: string option; user_agent: string option; - close: bool ref; + mutable close: bool; headers: string list; } + +val rpc_of_request : request -> Rpc.t +val request_of_rpc : Rpc.t -> request val nullreq : request val authorization_of_string : string -> authorization diff -r 543ffb14b173 -r f57a8764fc6f http-svr/http_svr.ml --- a/http-svr/http_svr.ml +++ b/http-svr/http_svr.ml @@ -87,7 +87,7 @@ let response_fct req ?(hdrs=[]) s (response_length: int64) (write_response_to_fd_fn: Unix.file_descr -> unit) = let version = get_return_version req in - let keep_alive = if !(req.close) then false else true in + let keep_alive = if req.close then false else true in headers s ((http_200_ok_with_content response_length ~version ~keep_alive ()) @ hdrs); write_response_to_fd_fn s @@ -142,7 +142,7 @@ (** If no handler matches the request then call this callback *) let default_callback req bio = response_forbidden (Buf_io.fd_of bio); - req.close := true + req.close <- true let write_error bio message = @@ -190,7 +190,7 @@ (* Default for HTTP/1.1 is persistent connections. Anything else closes *) (* the channel as soon as the request is processed *) - if req.version <> "HTTP/1.1" then req.close := true; + if req.version <> "HTTP/1.1" then req.close <- true; let rec read_rest_of_headers left = let cl_hdr = "content-length: " in @@ -229,8 +229,8 @@ begin let token = String.lowercase (end_of_string r (String.length connection_hdr)) in match token with - | "keep-alive" -> req.close := false - | "close" -> req.close := true + | "keep-alive" -> req.close <- false + | "close" -> req.close <- true | _ -> () end; if r <> "" then ( @@ -278,7 +278,7 @@ Buf_io.assert_buffer_empty ic; handlerfn req fd ); - finished := !(req.close) + finished := (req.close) with End_of_file -> DCritical.debug "Premature termination of connection!";
_______________________________________________ xen-api mailing list [email protected] http://lists.xensource.com/mailman/listinfo/xen-api
