From: Jon Ludlam Date: Fri, 18 Jun 2010 13:13:26 +0000 (+0100) Subject: Change the 'close' field in the request record to be mutable rather than a reference X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=508bd6dd8e2c034288bdb9b54a1d545afd44642f;p=xcp%2Fxen-api-libs.git Change the 'close' field in the request record to be mutable rather than a reference Signed-off-by: Jon Ludlam diff -r d8eb3fec758c http-svr/Makefile--- a/http-svr/Makefile Mon Mar 15 11:57:11 2010 +0000 +++ b/http-svr/Makefile Mon Mar 15 12:01:14 2010 +0000 @@ -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 --git a/http-svr/http.ml b/http-svr/http.ml index 38592f9..16a1753 100644 --- a/http-svr/http.ml +++ b/http-svr/http.ml @@ -98,16 +98,12 @@ let strip_cr r = 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 @@ type request = { m: method_t; 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 @@ let nullreq = { m=Unknown ""; 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 request_of_string x = 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 --git a/http-svr/http.mli b/http-svr/http.mli index ff8d800..12b2642 100644 --- a/http-svr/http.mli +++ b/http-svr/http.mli @@ -38,9 +38,12 @@ type request = { 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 --git a/http-svr/http_svr.ml b/http-svr/http_svr.ml index 4d187fc..e643a56 100644 --- a/http-svr/http_svr.ml +++ b/http-svr/http_svr.ml @@ -87,7 +87,7 @@ let get_return_version req = 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 @@ let response_file ?(hdrs=[]) ~mime_content_type s file = (** 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 @@ let handle_connection _ ss = (* 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 @@ let handle_connection _ ss = 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 @@ let handle_connection _ ss = 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!";