Chunk flushing
This commit is contained in:
parent
2c234fe492
commit
ca2376fab2
6
html.ml
6
html.ml
|
@ -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))
|
||||
|
|
7
httpd.ml
7
httpd.ml
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue