# HG changeset patch
# User Jonathan Ludlam <Jonathan.Ludlam@xxxxxxxxxxxxx>
# 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 <Jonathan.Ludlam@xxxxxxxxxxxxx>

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!";