From 75a78fb79598e8da789514c6f40365095213508a Mon Sep 17 00:00:00 2001
From: Prashanth Mundkur <prashanth.mundkur@citrix.com>
Date: Wed, 6 May 2009 15:01:30 -0700
Subject: [PATCH] add serialization api

---
 libs/http/http.ml  | 75 ++++++++++++++++++++++++++++++++++++++++++----
 libs/http/http.mli | 14 +++++++++
 2 files changed, 84 insertions(+), 5 deletions(-)

diff --git a/libs/http/http.ml b/libs/http/http.ml
index 17dc385..49eef14 100644
--- a/libs/http/http.ml
+++ b/libs/http/http.ml
@@ -16,9 +16,9 @@
 
 let verbose = ref false
 
-let dbg =
+let dbg fmt =
 	let logger s = if !verbose then Printf.printf "%s" s in
-	Printf.ksprintf logger
+	Printf.ksprintf logger fmt
 
 (* TODO: Put these functions in some libs *)
 
@@ -107,6 +107,11 @@ type version =
 	| HTTP10
 	| HTTP11
 
+let string_of_version = function
+	| HTTP09 -> ""
+	| HTTP10 -> "HTTP/1.0"
+	| HTTP11 -> "HTTP/1.1"
+
 (* TODO: impose a max length on field names and values *)
 
 module Headers = struct
@@ -222,6 +227,18 @@ module Headers = struct
 				)
 			)
 		| Done -> raise_error (Internal_error "parse called on finished request!")
+
+	let serialize buf hdrs =
+		let hdr (fn, fvl) =
+			List.iter (fun fv ->
+					Buffer.add_string buf fn;
+					Buffer.add_string buf ": ";
+					Buffer.add_string buf fv;
+					Buffer.add_string buf "\r\n")
+			  (List.rev fvl)
+		in
+		List.iter hdr (List.rev hdrs);
+		Buffer.add_string buf "\r\n"
 end
 
 
@@ -319,7 +336,6 @@ module Request_header = struct
 		num_bytes_parsed = 0
 	}
 
-	let is_done s = s.cursor = Done
 	let num_bytes_parsed state =
 		if state.cursor = Start then 0 else state.num_bytes_parsed
 
@@ -447,6 +463,17 @@ module Request_header = struct
 		match get_parse_result state with
 		| Some v -> Result (v, (String.sub str !i (len - !i)))
 		| None -> Parse_incomplete state
+
+	let serialize buf req =
+		Buffer.add_string buf (string_of_meth req.meth);
+		Buffer.add_string buf " ";
+		Buffer.add_string buf req.uri;
+		if req.version <> HTTP09 then begin
+			Buffer.add_string buf " ";
+			Buffer.add_string buf (string_of_version req.version);
+		end;
+		Buffer.add_string buf "\r\n";
+		Headers.serialize buf req.headers
 end
 
 
@@ -521,7 +548,6 @@ module Response_header = struct
 		num_bytes_parsed = 0
 	}
 
-	let is_done s = s.cursor = Done
 	let num_bytes_parsed state =
 		if state.cursor = Start then 0 else state.num_bytes_parsed
 
@@ -642,6 +668,15 @@ module Response_header = struct
 		match get_parse_result state with
 		| Some v -> Result (v, (String.sub str !i (len - !i)))
 		| None -> Parse_incomplete state
+
+	let serialize buf resp =
+		if resp.version <> HTTP09 then begin
+			Buffer.add_string buf (string_of_version resp.version);
+			Buffer.add_string buf (Printf.sprintf " %d " resp.status_code);
+			Buffer.add_string buf resp.reason_phrase;
+			Buffer.add_string buf "\r\n";
+			Headers.serialize buf resp.headers
+		end
 end
 
 
@@ -689,7 +724,6 @@ module Payload = struct
 		mutable num_bytes_parsed: int64
 	}
 
-	let is_done s = s.cursor = Done
 	let num_bytes_parsed state = state.num_bytes_parsed
 
 	type error =
@@ -926,6 +960,25 @@ module Payload = struct
 	let connection_closed state =
 		if state.content_length = Connection_close then
 			state.cursor <- Done
+
+	let serialize ~chunked buf payload =
+		if chunked then begin
+			let len = Buffer.length payload.content in
+			Buffer.add_string buf (Printf.sprintf "%dx\r\n" len);
+			Buffer.add_buffer buf payload.content;
+			Buffer.add_string buf "0\r\n";
+			Headers.serialize buf payload.trailers
+		end else begin
+			Buffer.add_buffer buf payload.content
+		end
+
+	let serialize_of_request req buf payload =
+		let chunked = transfer_encoding_uses_chunked req.Request_header.headers in
+		serialize ~chunked buf payload
+
+	let serialize_of_response resp buf payload =
+		let chunked = transfer_encoding_uses_chunked resp.Response_header.headers in
+		serialize ~chunked buf payload
 end
 
 
@@ -1016,6 +1069,12 @@ module Request = struct
 		| In_request_header _ -> ()
 		| In_payload ps       -> Payload.connection_closed ps
 		| Done                -> ()
+
+	let serialize buf req =
+		Request_header.serialize buf req.request;
+		match req.payload with
+		| Some p -> Payload.serialize_of_request req.request buf p
+		| None   -> ()
 end
 
 
@@ -1106,4 +1165,10 @@ module Response = struct
 		| In_response_header _ -> ()
 		| In_payload ps        -> Payload.connection_closed ps
 		| Done                 -> ()
+
+	let serialize buf resp =
+		Response_header.serialize buf resp.response;
+	  	match resp.payload with
+		| Some p -> Payload.serialize_of_response resp.response buf p
+		| None   -> ()
 end
diff --git a/libs/http/http.mli b/libs/http/http.mli
index a344391..14c3265 100644
--- a/libs/http/http.mli
+++ b/libs/http/http.mli
@@ -6,6 +6,8 @@ module Headers : sig
 	type error
 	exception Http_error of error
 	val string_of_error : error -> string
+
+	val serialize : Buffer.t -> header_fields -> unit
 end
 
 
@@ -41,6 +43,8 @@ module Request_header : sig
 	type error
 	exception Http_error of error
 	val string_of_error : error -> string
+
+	val serialize : Buffer.t -> t -> unit
 end
 
 module Response_header : sig
@@ -63,6 +67,8 @@ module Response_header : sig
 	type error
 	exception Http_error of error
 	val string_of_error : error -> string
+
+	val serialize : Buffer.t -> t -> unit
 end
 
 module Payload : sig
@@ -95,6 +101,10 @@ module Payload : sig
 	val get_parse_result : state -> t option
 
 	val connection_closed : state -> unit
+
+	(* Note: this is only recommended for small payloads! *)
+	val serialize_of_request : Request_header.t -> Buffer.t -> t -> unit
+	val serialize_of_response : Response_header.t -> Buffer.t -> t -> unit
 end
 
 module Request : sig
@@ -118,6 +128,8 @@ module Request : sig
 	val parse : state -> string -> parse_result
 
 	val connection_closed : state -> unit
+
+	val serialize : Buffer.t -> t -> unit
 end
 
 module Response : sig
@@ -141,4 +153,6 @@ module Response : sig
 	val parse : state -> string -> parse_result
 
 	val connection_closed : state -> unit
+
+	val serialize : Buffer.t -> t -> unit
   end
-- 
2.39.5