From: Jonathan Ludlam <Jonathan.Ludlam@eu.citrix.com>
Date: Tue, 12 Oct 2010 11:10:35 +0000 (+0100)
Subject: CA-44731: Evolve HTTP code a little: (1) http_200_ok{,_with_content_length} now use... 
X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=88e4f16e48d846e66ec990b95f15636c7366c9ea;p=xcp%2Fxen-api-libs.git

CA-44731: Evolve HTTP code a little: (1) http_200_ok{,_with_content_length} now use the same convention for their version parameters; (2) add http_request_request (temporary name) which creates an HTTP request type rather than pre-flattening it to a string list.

Signed-of-by: David Scott <dave.scott@eu.citrix.com>
---

diff --git a/http-svr/http.ml b/http-svr/http.ml
index d698482..20e7bd5 100644
--- a/http-svr/http.ml
+++ b/http-svr/http.ml
@@ -34,8 +34,8 @@ let http_200_ok ?(version="1.1") ?(keep_alive=true) () =
       "Connection: " ^ (if keep_alive then "keep-alive" else "close");
       "Cache-Control: no-cache, no-store" ]
 
-let http_200_ok_with_content length ?(version="HTTP/1.1") ?(keep_alive=true) () =
-    [ version^" 200 OK";
+let http_200_ok_with_content length ?(version="1.1") ?(keep_alive=true) () =
+    [ Printf.sprintf "HTTP/%s 200 OK" version;
       "Connection: " ^ (if keep_alive then "keep-alive" else "close");
       "Content-Length: "^(Int64.to_string length);
       "Cache-Control: no-cache, no-store" ]
@@ -240,6 +240,18 @@ let pretty_string_of_request x =
     (default "" x.content_type)
     (default "" x.user_agent)
 
+let http_request_request ?(version="1.0") ?(keep_alive=false) ?cookie ?length ~user_agent meth host path = 
+{ nullreq with
+  version = version;
+  close = not keep_alive;
+  cookie = Opt.default [] cookie;
+  content_length = length;
+  user_agent = Some user_agent;
+  m = meth;
+  uri = path;
+  headers = [ Printf.sprintf "Host: %s" host ];
+}
+
 let http_request ?(version="1.0") ?(keep_alive=false) ?cookie ?length ~user_agent meth host path = 
   let cookie = default [] (may (fun x -> [ "Cookie: " ^ (print_keyvalpairs x) ]) cookie) in
   let content_length = default [] (may (fun l -> [ "Content-Length: "^(Int64.to_string l)]) length) in
diff --git a/http-svr/http.mli b/http-svr/http.mli
index 0666596..bfd8c70 100644
--- a/http-svr/http.mli
+++ b/http-svr/http.mli
@@ -66,6 +66,8 @@ val string_list_of_request : request -> string list
 
 val http_request : ?version:string -> ?keep_alive:bool -> ?cookie:((string*string) list) -> ?length:(int64) -> user_agent:(string) -> method_t -> string -> string -> string list
 
+val http_request_request : ?version:string -> ?keep_alive:bool -> ?cookie:((string*string) list) -> ?length:(int64) -> user_agent:(string) -> method_t -> string -> string -> request
+
 val http_403_forbidden : string list
 val http_200_ok : ?version:string -> ?keep_alive:bool -> unit -> string list
 
diff --git a/http-svr/http_svr.ml b/http-svr/http_svr.ml
index e643a56..8051ecf 100644
--- a/http-svr/http_svr.ml
+++ b/http-svr/http_svr.ml
@@ -81,9 +81,9 @@ let get_return_version req =
   try
     let (maj,min) = Scanf.sscanf req.version "HTTP/%d.%d" (fun a b -> (a,b)) in
     match (maj,min) with
-	(1,0) -> "HTTP/1.0"
-      | _ -> "HTTP/1.1"
-  with _ -> "HTTP/1.1"
+	(1,0) -> "1.0"
+      | _ -> "1.1"
+  with _ -> "1.1"
     
 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
@@ -124,7 +124,7 @@ let response_file ?(hdrs=[]) ~mime_content_type s file =
     | None    -> []
     | Some ty -> [ "Content-Type: " ^ ty ]
     in
-  headers s (http_200_ok_with_content size ~version:"HTTP/1.1" ~keep_alive:true ()
+  headers s (http_200_ok_with_content size ~version:"1.1" ~keep_alive:true ()
             @ mime_header);
   let buffer = String.make 65536 '\000' in
   let ic = open_in file in