simon/tiny_httpd
1
0
Fork 0
mirror of https://github.com/c-cube/tiny_httpd.git synced 2025-12-06 11:15:35 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

fix(camlzip): proper handling of transfer-encoding for deflate

Browse source
This commit is contained in:
Simon Cruanes 2020-03-25 22:03:33 -04:00
parent 2435e33df4
commit 9d6f4d25cf
2 changed files with 25 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
src/camlzip/Tiny_httpd_camlzip.ml
View file

@ -2,9 +2,9 @@
module S = Tiny_httpd module S = Tiny_httpd
module BS = Tiny_httpd.Byte_stream module BS = Tiny_httpd.Byte_stream
let mk_decode_deflate_stream_ () (is:S.byte_stream) : S.byte_stream = let mk_decode_deflate_stream_ ~buf_size () (is:S.byte_stream) : S.byte_stream =
S._debug (fun k->k "wrap stream with inflate.decode"); S._debug (fun k->k "wrap stream with inflate.decode");
let buf = Bytes.make 4096 ' ' in let buf = Bytes.make buf_size ' ' in
let buf_len = ref 0 in let buf_len = ref 0 in
let write_offset = ref 0 in let write_offset = ref 0 in
let zlib_str = Zlib.inflate_init false in let zlib_str = Zlib.inflate_init false in
@ -48,14 +48,15 @@ let mk_decode_deflate_stream_ () (is:S.byte_stream) : S.byte_stream =
in in
{S.bs_fill_buf; bs_consume; bs_close} {S.bs_fill_buf; bs_consume; bs_close}
let encode_deflate_stream_ (is:S.byte_stream) : S.byte_stream = let encode_deflate_stream_ ~buf_size (is:S.byte_stream) : S.byte_stream =
S._debug (fun k->k "wrap stream with deflate.encode"); S._debug (fun k->k "wrap stream with deflate.encode");
let refill = ref true in let refill = ref true in
let buf = Bytes.make 4096 ' ' in let buf = Bytes.make buf_size ' ' in
let buf_len = ref 0 in let buf_len = ref 0 in
let write_offset = ref 0 in let write_offset = ref 0 in
let zlib_str = Zlib.deflate_init 4 false in let zlib_str = Zlib.deflate_init 4 false in
let bs_close () = let bs_close () =
S._debug (fun k->k "deflate: close");
Zlib.deflate_end zlib_str; Zlib.deflate_end zlib_str;
BS.close is BS.close is
in in
@ -84,7 +85,10 @@ let encode_deflate_stream_ (is:S.byte_stream) : S.byte_stream =
S._debug S._debug
(fun k->k "encode %d bytes as %d bytes using deflate (finished: %b)" (fun k->k "encode %d bytes as %d bytes using deflate (finished: %b)"
used_in used_out finished); used_in used_out finished);
if finished then refill := false; if finished then (
S._debug (fun k->k "deflate: finished");
refill := false;
);
with Zlib.Error (e1,e2) -> with Zlib.Error (e1,e2) ->
S.Response.fail_raise ~code:400 S.Response.fail_raise ~code:400
"deflate: error during compression:\n%s %s" e1 e2 "deflate: error during compression:\n%s %s" e1 e2
@ -120,7 +124,7 @@ let has_deflate s =
try Scanf.sscanf s "deflate; %s" (fun _ -> true) try Scanf.sscanf s "deflate; %s" (fun _ -> true)
with _ -> false with _ -> false
let cb_decode_compressed_stream (req:unit S.Request.t) : _ option = let cb_decode_compressed_stream ~buf_size (req:unit S.Request.t) : _ option =
match S.Request.get_header ~f:String.trim req "Transfer-Encoding" with match S.Request.get_header ~f:String.trim req "Transfer-Encoding" with
(* TODO (* TODO
| Some "gzip" -> | Some "gzip" ->
@ -128,15 +132,16 @@ let cb_decode_compressed_stream (req:unit S.Request.t) : _ option =
Some (req', decode_gzip_stream_) Some (req', decode_gzip_stream_)
*) *)
| Some s when has_deflate s -> | Some s when has_deflate s ->
begin match Scanf.sscanf s "deflate; %s" (fun s -> s) with begin match Scanf.sscanf s "deflate, %s" (fun s -> s) with
| tr' -> | tr' ->
let req' = S.Request.set_header req "Transfer-Encoding" tr' in let req' = S.Request.set_header req "Transfer-Encoding" tr' in
Some (req', mk_decode_deflate_stream_ ()) Some (req', mk_decode_deflate_stream_ ~buf_size ())
| exception _ -> None | exception _ -> None
end end
| _ -> None | _ -> None
let cb_encode_compressed_stream (req:_ S.Request.t) (resp:S.Response.t) : _ option = let cb_encode_compressed_stream
~buf_size (req:_ S.Request.t) (resp:S.Response.t) : _ option =
if accept_deflate req then ( if accept_deflate req then (
match resp.body with match resp.body with
| `String _ -> None | `String _ -> None
@ -147,14 +152,15 @@ let cb_encode_compressed_stream (req:_ S.Request.t) (resp:S.Response.t) : _ opti
headers= headers=
(resp.headers (resp.headers
|> S.Headers.remove "Content-Length" |> S.Headers.remove "Content-Length"
|> S.Headers.set "Transfer-Coding" "deflate; chunked"); |> S.Headers.set "Transfer-Encoding" "deflate, chunked");
body=`Stream (encode_deflate_stream_ str); body=`Stream (encode_deflate_stream_ ~buf_size str);
} }
) else None ) else None
let setup (server:S.t) : unit = let setup ?(buf_size=48 * 1_024) (server:S.t) : unit =
S._debug (fun k->k "setup gzip support"); let buf_size = max buf_size 1_024 in
S.add_decode_request_cb server cb_decode_compressed_stream; S._debug (fun k->k "setup gzip support (buf-size %d)" buf_size);
S.add_encode_response_cb server cb_encode_compressed_stream; S.add_decode_request_cb server (cb_decode_compressed_stream ~buf_size);
S.add_encode_response_cb server (cb_encode_compressed_stream ~buf_size);
() ()

6
src/camlzip/Tiny_httpd_camlzip.mli
View file

@ -1,3 +1,5 @@
val setup : Tiny_httpd.t -> unit val setup : ?buf_size:int -> Tiny_httpd.t -> unit
(** Install callbacks for tiny_httpd to be able to encode/decode compressed streams *) (** Install callbacks for tiny_httpd to be able to encode/decode
compressed streams
@param buf_size size of the underlying buffer for compression/decompression *)