Chunk flushing

This commit is contained in:
Tony Garnock-Jones 2012-04-29 08:37:34 -04:00
parent 2c234fe492
commit ca2376fab2
4 changed files with 16 additions and 14 deletions

View File

@ -86,13 +86,13 @@ and stream_of_html c =
Stringstream.make (fun () ->
match c with
| Tag (label, attrs, [], true) ->
Some (html_open_tag_string label attrs, Stringstream.empty)
Some (html_open_tag_string label attrs, false, Stringstream.empty)
| Tag (label, attrs, contents, _) ->
Some (html_open_tag_string label attrs,
Some (html_open_tag_string label attrs, false,
Stringstream.seq
(stream_of_html_contents contents) (Stringstream.const ("</"^label^">")))
| Text str ->
Some (str, Stringstream.empty))
Some (str, false, Stringstream.empty))
let stream_of_html_doc d =
Stringstream.seq (Stringstream.const "<!DOCTYPE html>") (stream_of_html (tag_of_document d))

View File

@ -144,13 +144,14 @@ let render_header cout (k, v) =
output_string cout v;
output_string cout "\r\n"
let render_chunk cout chunk =
let render_chunk cout (chunk, should_flush) =
match chunk with
| "" -> ()
| _ ->
output_string cout (Printf.sprintf "%x\r\n" (String.length chunk));
output_string cout chunk;
output_string cout "\r\n"
output_string cout "\r\n";
if should_flush then flush cout else ()
let render_fixed_content cout s headers_only =
render_header cout ("Content-Length", string_of_int (String.length s));
@ -246,7 +247,7 @@ let parse_chunks cin =
let buffer = String.make chunk_len '\000' in
really_input cin buffer 0 chunk_len;
(if input_crlf cin <> "" then http_error_html 400 "Invalid chunk boundary" [] else ());
if chunk_len = 0 then None else Some buffer
if chunk_len = 0 then None else Some (buffer, false)
let parse_body cin =
let headers = parse_headers cin in

View File

@ -56,7 +56,7 @@ let read_and_close_file handle =
with e -> (close_in handle; raise e))
in
if count > 0
then Some (String.sub buffer 0 count)
then Some (String.sub buffer 0 count, false)
else (close_in handle;
None)

View File

@ -15,26 +15,27 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Ocamlmsg. If not, see <http://www.gnu.org/licenses/>. *)
type t = Stream of (unit -> (string * t) option)
type t = Stream of (unit -> (string * bool * t) option)
let make f = Stream f
let run (Stream f) = f ()
let empty = Stream (fun () -> None)
let const v = Stream (fun () -> Some (v, empty))
let const v = Stream (fun () -> Some (v, false, empty))
let const_flush v = Stream (fun () -> Some (v, true, empty))
let rec seq s1 s2 =
Stream (fun () ->
match run s1 with
| None -> run s2
| Some (v, k) -> Some (v, seq k s2))
| Some (v, f, k) -> Some (v, f, seq k s2))
let rec from_list vs =
Stream (fun () ->
match vs with
| [] -> None
| v :: vs -> Some (v, (from_list vs)))
| v :: vs -> Some (v, false, (from_list vs)))
let rec map f vs =
Stream (fun () ->
@ -50,7 +51,7 @@ let rec from_iter f =
| None ->
let result =
(match f () with
| Some str -> Some (str, from_iter f)
| Some (str, should_flush) -> Some (str, should_flush, from_iter f)
| None -> None)
in
cache := Some result;
@ -59,12 +60,12 @@ let rec from_iter f =
let rec iter f (Stream s_f) =
match s_f () with
| None -> ()
| Some (v, k) -> (f v; iter f k)
| Some (v, flush, k) -> (f (v, flush); iter f k)
let rec to_list (Stream f) =
match f () with
| None -> []
| Some (v, k) -> v :: to_list k
| Some (v, _, k) -> v :: to_list k
let rec to_string s =
String.concat "" (to_list s)