diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml index 817a5785..dcc8c203 100644 --- a/src/Tiny_httpd.ml +++ b/src/Tiny_httpd.ml @@ -28,6 +28,7 @@ module Buf_ = struct { bytes=Bytes.make size ' '; i=0 } let size self = self.i + let bytes_slice self = self.bytes let clear self : unit = if Bytes.length self.bytes > 4_096 * 1_024 then ( self.bytes <- Bytes.make 4096 ' '; (* free big buffer *) diff --git a/src/Tiny_httpd.mli b/src/Tiny_httpd.mli index 00d07730..28689917 100644 --- a/src/Tiny_httpd.mli +++ b/src/Tiny_httpd.mli @@ -79,6 +79,18 @@ module Buf_ : sig val clear : t -> unit val create : ?size:int -> unit -> t val contents : t -> string + + val bytes_slice : t -> bytes + (** Access underlying slice of bytes. + @since NEXT_RELEASE *) + + val contents_and_clear : t -> string + (** Get contents of the buffer and clear it. + @since NEXT_RELEASE *) + + val add_bytes : t -> bytes -> int -> int -> unit + (** Append given bytes slice to the buffer. + @since NEXT_RELEASE *) end (** {2 Generic stream of data} diff --git a/src/examples/dune b/src/examples/dune index b7cfcbf7..fe122085 100644 --- a/src/examples/dune +++ b/src/examples/dune @@ -1,4 +1,4 @@ (executables (names echo) - (libraries tiny_httpd)) + (libraries tiny_httpd tiny_httpd_zlib)) diff --git a/src/examples/echo.ml b/src/examples/echo.ml index 9d1025c1..3f531685 100644 --- a/src/examples/echo.ml +++ b/src/examples/echo.ml @@ -11,6 +11,7 @@ let () = "-j", Arg.Set_int j, " maximum number of connections"; ]) (fun _ -> raise (Arg.Bad "")) "echo [option]*"; let server = S.create ~port:!port_ ~max_connections:!j () in + Tiny_httpd_zlib.setup server; (* say hello *) S.add_path_handler ~meth:`GET server "/hello/%s@/" (fun name _req -> S.Response.make_string (Ok ("hello " ^name ^"!\n"))); diff --git a/src/zlib/Tiny_httpd_zlib.ml b/src/zlib/Tiny_httpd_zlib.ml new file mode 100644 index 00000000..bc59a1fd --- /dev/null +++ b/src/zlib/Tiny_httpd_zlib.ml @@ -0,0 +1,80 @@ + +module S = Tiny_httpd +module BS = Tiny_httpd.Byte_stream + +let mk_decode_deflate_stream_ () (is:S.byte_stream) : S.byte_stream = + S._debug (fun k->k "wrap stream with inflate.decode"); + let buf = Bytes.make 4096 ' ' in + let write_offset = ref 0 in + let buf_len = ref 0 in + let zlib_str = Zlib.inflate_init false in + let is_done = ref false in + let bs_close () = + Zlib.inflate_end zlib_str; + BS.close is + in + let bs_consume len : unit = + if len > !buf_len then ( + S.Response.fail_raise ~code:400 + "inflate: error during decompression: invalid consume len %d (max %d)" + len !buf_len + ); + write_offset := !write_offset + len; + buf_len := !buf_len - len; + in + let bs_fill_buf () : _*_*_ = + (* refill [buf] if needed *) + if !buf_len = 0 && not !is_done then ( + let ib, ioff, ilen = is.S.bs_fill_buf () in + begin + try + let finished, used_in, used_out = + Zlib.inflate zlib_str + buf 0 (Bytes.length buf) + ib ioff ilen Zlib.Z_SYNC_FLUSH + in + is.S.bs_consume used_in; + write_offset := 0; + buf_len := used_out; + if finished then is_done := true; + S._debug (fun k->k "decode %d bytes as %d bytes from inflate (finished: %b)" + used_in used_out finished); + with Zlib.Error (e1,e2) -> + S.Response.fail_raise ~code:400 + "inflate: error during decompression:\n%s %s" e1 e2 + end; + S._debug (fun k->k "inflate: refill %d bytes into internal buf" !buf_len); + ); + buf, !write_offset, !buf_len + in + {S.bs_fill_buf; bs_consume; bs_close} + +let has_deflate s = + try Scanf.sscanf s "deflate; %s" (fun _ -> true) + with _ -> false + +let cb_decode_compressed_stream (req:unit S.Request.t) : _ option = + match S.Request.get_header ~f:String.trim req "Transfer-Encoding" with + (* TODO + | Some "gzip" -> + let req' = S.Request.set_header req "Transfer-Encoding" "chunked" in + Some (req', decode_gzip_stream_) + *) + | Some "deflate" -> + let req' = S.Request.set_header req "Transfer-Encoding" "chunked" in + Some (req', mk_decode_deflate_stream_ ()) + | Some s when has_deflate s -> + begin match Scanf.sscanf s "deflate; %s" (fun s -> s) with + | tr' -> + let req' = S.Request.set_header req "Transfer-Encoding" tr' in + Some (req', mk_decode_deflate_stream_ ()) + | exception _ -> None + end + | _ -> None + +let setup (server:S.t) : unit = + S._debug (fun k->k "setup gzip support"); + S.add_decode_request_cb server cb_decode_compressed_stream; + (* S.add_encode_response_cb server (assert false); *) + () + diff --git a/src/zlib/Tiny_httpd_zlib.mli b/src/zlib/Tiny_httpd_zlib.mli new file mode 100644 index 00000000..9e651107 --- /dev/null +++ b/src/zlib/Tiny_httpd_zlib.mli @@ -0,0 +1,3 @@ + +val setup : Tiny_httpd.t -> unit +(** Install callbacks for tiny_httpd to be able to encode/decode compressed streams *) diff --git a/src/zlib/dune b/src/zlib/dune new file mode 100644 index 00000000..17dc9301 --- /dev/null +++ b/src/zlib/dune @@ -0,0 +1,7 @@ + +(library + (name tiny_httpd_zlib) + (public_name tiny_httpd_zlib) + (synopsis "A wrapper around zlib to bring compression to Tiny_httpd") + (flags :standard -safe-string -warn-error -a) + (libraries tiny_httpd camlzip)) diff --git a/tiny_httpd_zlib.opam b/tiny_httpd_zlib.opam new file mode 100644 index 00000000..7ee23dd6 --- /dev/null +++ b/tiny_httpd_zlib.opam @@ -0,0 +1,23 @@ +opam-version: "2.0" +version: "0.1" +authors: ["Simon Cruanes"] +maintainer: "simon.cruanes.2007@m4x.org" +license: "MIT" +description: "Interface to gzip for tiny_httpd" +build: [ + ["dune" "build" "@install" "-p" name "-j" jobs] + ["dune" "build" "@doc" "-p" name] {with-doc} + ["dune" "runtest" "-p" name] {with-test} +] +depends: [ + "dune" { >= "1.1" } + "decompress" + "tiny_httpd" { = version } + "ocaml" { >= "4.03.0" } + "odoc" {with-doc} +] +tags: [ "http" "thread" "server" "gzip" "decompress" ] +homepage: "https://github.com/c-cube/tiny_httpd/" +doc: "https://c-cube.github.io/tiny_httpd/" +bug-reports: "https://github.com/c-cube/tiny_httpd/issues" +dev-repo: "git+https://github.com/c-cube/tiny_httpd.git"