Change the 'close' field in the request record to be mutable rather than a reference

Signed-off-by: Jon Ludlam <Jonathan.Ludlam@eu.citrix.com>
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 38592f9bb21da9a23ae36eaffad8eea2c8db4476..16a1753731160bf456e8932bf33a6f23e7cda107 100644 (file)
--- 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 ff8d800be83a24f4e1e36c421330d112dd61a1de..12b264297145ea5c13ca09b240ef34b455fa2787 100644 (file)
--- 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 4d187fce4e56d8cc9c6a353f065d7a4c956ea029..e643a5691104f1be7582c2832f6c7b153a2f273b 100644 (file)
--- 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!";