Revert "use bigstring and map_file"

This reverts commit 3067120539.

src/Tiny_httpd.ml

@@ -107,7 +107,6 @@ module Byte_stream = struct
         | None -> Bytes.length s - i
       )
     in
-
     let i = ref i in
     { bs_fill_buf=(fun () -> s, !i, !len);
       bs_close=(fun () -> len := 0);
@@ -117,29 +116,6 @@ module Byte_stream = struct
   let of_string s : t =
     of_bytes (Bytes.unsafe_of_string s)
 
-  let of_big_string ?(buf_size=16 * 1024) ?(i=0) ?len s : t =
-    let len =
-      ref (
-        match len with
-        | Some n ->
-          if n > Bigstring.length s - i then invalid_arg "Byte_stream.of_bytes";
-          n
-        | None -> Bigstring.length s - i
-      )
-    in
-    let buf = Bytes.make buf_size ' ' in
-    let i = ref i in
-    let len_buf = ref 0 in
-    { bs_fill_buf=(fun () ->
-        if !i >= !len_buf then (
-          i := 0; len_buf := min buf_size !len;
-          Bigstring.blit_to_bytes s !i buf 0 !len_buf;
-        );
-      buf, !i,!len_buf - !i);
-      bs_consume=(fun n -> i := !i + n; len := !len - n);
-      bs_close=(fun () -> len_buf := 0)
-    }
-
   let with_file ?buf_size file f =
     let ic = open_in file in
     try
@@ -615,9 +591,7 @@ end
 *)
 
 module Response = struct
-  type body =
+  type body = [`String of string | `Stream of byte_stream | `Void]
-    | String of string | BigString of Bigstring.t
-    | Stream of byte_stream | Void
   type t = {
     code: Response_code.t;
     headers: Headers.t;
@@ -635,22 +609,15 @@ module Response = struct
     let headers =
       Headers.set "Content-Length" (string_of_int (String.length body)) headers
     in
-    { code; headers; body=String body; }
+    { code; headers; body=`String body; }
-
-  let make_raw_big ?(headers=[]) ~code body : t =
-    (* add content length to response *)
-    let headers =
-      Headers.set "Content-Length" (string_of_int (Bigstring.length body)) headers
-    in
-    { code; headers; body=BigString body; }
 
   let make_raw_stream ?(headers=[]) ~code body : t =
     (* add content length to response *)
     let headers = Headers.set "Transfer-Encoding" "chunked" headers in
-    { code; headers; body=Stream body; }
+    { code; headers; body=`Stream body; }
 
   let make_void ?(headers=[]) ~code () : t =
-    { code; headers; body=Void; }
+    { code; headers; body=`Void; }
 
   let make_string ?headers r = match r with
     | Ok body -> make_raw ?headers ~code:200 body
@@ -661,10 +628,9 @@ module Response = struct
     | Error (code,msg) -> make_raw ?headers ~code msg
 
   let make ?headers r : t = match r with
-    | Ok (String body) -> make_raw ?headers ~code:200 body
+    | Ok (`String body) -> make_raw ?headers ~code:200 body
-    | Ok (BigString body) -> make_raw_big ?headers ~code:200 body
+    | Ok (`Stream body) -> make_raw_stream ?headers ~code:200 body
-    | Ok (Stream body) -> make_raw_stream ?headers ~code:200 body
+    | Ok `Void -> make_void ?headers ~code:200 ()
-    | Ok Void -> make_void ?headers ~code:200 ()
     | Error (code,msg) -> make_raw ?headers ~code msg
 
   let fail ?headers ~code fmt =
@@ -674,10 +640,9 @@ module Response = struct
 
   let pp out self : unit =
     let pp_body out = function
-      | String s -> Format.fprintf out "%S" s
+      | `String s -> Format.fprintf out "%S" s
-      | BigString _ -> Format.pp_print_string out "<bigstring>"
+      | `Stream _ -> Format.pp_print_string out "<stream>"
-      | Stream _ -> Format.pp_print_string out "<stream>"
+      | `Void -> ()
-      | Void -> ()
     in
     Format.fprintf out "{@[code=%d;@ headers=[@[%a@]];@ body=%a@]}"
       self.code Headers.pp self.headers pp_body self.body
@@ -701,16 +666,12 @@ module Response = struct
   let output_ (oc:out_channel) (self:t) : unit =
     Printf.fprintf oc "HTTP/1.1 %d %s\r\n" self.code (Response_code.descr self.code);
     let body, is_chunked = match self.body with
-      | String s when String.length s > 1024 * 500 ->
+      | `String s when String.length s > 1024 * 500 ->
         (* chunk-encode large bodies *)
-        Stream (Byte_stream.of_string s), true
+        `Stream (Byte_stream.of_string s), true
-      | BigString s when Bigstring.length s > 1024 * 500 ->
+      | `String _ as b -> b, false
-        (* chunk-encode large bodies *)
+      | `Stream _ as b -> b, true
-        Stream (Byte_stream.of_big_string s), true
+      | `Void as b -> b, false
-      | String _ as b -> b, false
-      | BigString _ as b -> b, false
-      | Stream _ as b -> b, true
-      | Void as b -> b, false
     in
     let headers =
       if is_chunked then (
@@ -721,15 +682,13 @@ module Response = struct
     in
     let self = {self with headers; body} in
     _debug (fun k->k "output response: %s"
-               (Format.asprintf "%a" pp {self with body=String "<…>"}));
+               (Format.asprintf "%a" pp {self with body=`String "<…>"}));
     List.iter (fun (k,v) -> Printf.fprintf oc "%s: %s\r\n" k v) headers;
     output_string oc "\r\n";
     begin match body with
-      | String "" | Void -> ()
+      | `String "" | `Void -> ()
-      | String s -> output_string oc s;
+      | `String s -> output_string oc s;
-      | BigString s -> Format.fprintf (Format.formatter_of_out_channel oc)
+      | `Stream str -> output_stream_chunked_ oc str;
-                         "%a%!" Bigstring.print s
-      | Stream str -> output_stream_chunked_ oc str;
     end;
     flush oc
 end

src/Tiny_httpd.mli

@@ -141,9 +141,6 @@ module Byte_stream : sig
 
   val of_string : string -> t
 
-  val of_big_string : ?buf_size:int -> ?i:int -> ?len:int -> Bigstring.t -> t
-  (** Make a buffered stream from the given big string. *)
-
   val iter : (bytes -> int -> int -> unit) -> t -> unit
   (** Iterate on the chunks of the stream
       @since 0.3 *)
@@ -334,9 +331,7 @@ end
     the client to answer a {!Request.t}*)
 
 module Response : sig
-  type body =
+  type body = [`String of string | `Stream of byte_stream | `Void]
-    | String of string | BigString of Bigstring.t
-    | Stream of byte_stream | Void
   (** Body of a response, either as a simple string,
       or a stream of bytes, or nothing (for server-sent events). *)
 
@@ -375,14 +370,6 @@ module Response : sig
   (** Make a response from its raw components, with a string body.
       Use [""] to not send a body at all. *)
 
-  val make_raw_big :
-    ?headers:Headers.t ->
-    code:Response_code.t ->
-    Bigstring.t ->
-    t
-  (** Make a response from its raw components, with a big string body.
-      Use [""] to not send a body at all. *)
-
   val make_raw_stream :
     ?headers:Headers.t ->
     code:Response_code.t ->

src/Tiny_httpd_dir.ml

@@ -7,6 +7,7 @@ type dir_behavior =
 
 type config = {
   mutable download: bool;
+  mutable mem_cache: bool;
   mutable dir_behavior: dir_behavior;
   mutable delete: bool;
   mutable upload: bool;
@@ -15,6 +16,7 @@ type config = {
 
 let default_config () : config =
   { download=true
+  ; mem_cache=false
   ; dir_behavior=Forbidden
   ; delete=false
   ; upload=false
@@ -41,7 +43,7 @@ let header_html = "Content-Type", "text/html"
 let (//) = Filename.concat
 
 let encode_path s = U.percent_encode ~skip:(function '/' -> true|_->false) s
-let _decode_path s = match U.percent_decode s with Some s->s | None -> s
+let decode_path s = match U.percent_decode s with Some s->s | None -> s
 
 let is_hidden s = String.length s>0 && s.[0] = '.'
 
@@ -162,24 +164,30 @@ let add_dir_path ~config ~dir ~prefix server =
            (fun _ _  -> S.Response.make_raw ~code:405 "upload not allowed");
   );
 
+  let cache = Hashtbl.create 101 in
+
   if config.download then (
     S.add_route_handler server ~meth:`GET
       S.Route.(exact_path prefix (rest_of_path_urlencoded))
       (fun path req ->
         let full_path = dir // path in
-        let stat =
+        let mtime = lazy (
-          try Unix.stat full_path
+                        try Printf.sprintf "mtime: %f" (Unix.stat full_path).Unix.st_mtime
                         with _ -> S.Response.fail_raise ~code:403 "Cannot access file"
-        in
+                      ) in
-        let mtime = stat.Unix.st_mtime in
+        try
-        let mtime_str = Printf.sprintf "mtime: %f" mtime in
+          if not config.mem_cache then raise Not_found;
+          let (ans, mtime0) = Hashtbl.find cache path in
+          if mtime <> mtime0 then raise Not_found;
+          ans
+        with Not_found ->
+        let ans =
         if contains_dot_dot full_path then (
           S.Response.fail ~code:403 "Path is forbidden";
         ) else if not (Sys.file_exists full_path) then (
           S.Response.fail ~code:404 "File not found";
-        ) else
+        ) else if S.Request.get_header req "If-None-Match" = Some (Lazy.force mtime) then (
-          if S.Request.get_header req "If-None-Match" = Some mtime_str then (
+          S._debug (fun k->k "cached object %S (etag: %S)" path (Lazy.force mtime));
-          S._debug (fun k->k "cached object %S (etag: %S)" path mtime_str);
           S.Response.make_raw ~code:304 ""
         ) else if Sys.is_directory full_path then (
           S._debug (fun k->k "list dir %S (topdir %S)"  full_path dir);
@@ -198,15 +206,13 @@ let add_dir_path ~config ~dir ~prefix server =
           | Lists ->
              let body = html_list_dir ~top:dir path ~parent in
              S.Response.make_string
-               ~headers:[header_html; "ETag", mtime_str]
+               ~headers:[header_html; "ETag", Lazy.force mtime]
                (Ok body)
           | Forbidden ->
              S.Response.make_raw ~code:405 "listing dir not allowed"
         ) else (
           try
-            let bs = Bigstring_unix.with_map_file ~flags:[Open_rdonly] full_path
+            let ic = open_in full_path in
-                       (fun s -> s)
-            in
             let mime_type =
               if Filename.extension full_path = ".css" then (
                 ["Content-Type", "text/css"]
@@ -220,11 +226,14 @@ let add_dir_path ~config ~dir ~prefix server =
                         with _ -> [])
                   with _ -> []
             in
-            S.Response.make_raw_big
+            S.Response.make_raw_stream
-              ~headers:(mime_type@["Etag", mtime_str])
+              ~headers:(mime_type@["Etag", Lazy.force mtime])
-              ~code:200 bs
+              ~code:200 (S.Byte_stream.of_chan ic)
           with e ->
             S.Response.fail ~code:500 "error while reading file: %s" (Printexc.to_string e))
+        in
+        Hashtbl.replace cache path (ans,mtime);
+        ans
       )
   ) else (
     S.add_route_handler server ~meth:`GET

src/Tiny_httpd_dir.mli

@@ -4,6 +4,7 @@ type dir_behavior =
 
 type config = {
   mutable download: bool;
+  mutable mem_cache: bool;
   mutable dir_behavior: dir_behavior;
   mutable delete: bool;
   mutable upload: bool;

src/camlzip/Tiny_httpd_camlzip.ml

@@ -178,7 +178,7 @@ let compress_resp_stream_
 
   if accept_deflate req then (
     match resp.body with
-    | String s when String.length s > compress_above ->
+    | `String s when String.length s > compress_above ->
       (* big string, we compress *)
       S._debug
         (fun k->k "encode str response with deflate (size %d, threshold %d)"
@@ -188,27 +188,15 @@ let compress_resp_stream_
       in
       resp
       |> S.Response.update_headers update_headers
-      |> S.Response.set_body (Stream body)
+      |> S.Response.set_body (`Stream body)
 
-    | BigString s when Bigstring.length s > compress_above ->
+    | `Stream str ->
-      (* big string, we compress *)
-      S._debug
-        (fun k->k "encode str response with deflate (size %d, threshold %d)"
-             (Bigstring.length s) compress_above);
-      let body =
-        encode_deflate_stream_ ~buf_size @@ S.Byte_stream.of_big_string s
-      in
-      resp
-      |> S.Response.update_headers update_headers
-      |> S.Response.set_body (Stream body)
-
-    | Stream str ->
       S._debug (fun k->k "encode stream response with deflate");
       resp
       |> S.Response.update_headers update_headers
-      |> S.Response.set_body (Stream (encode_deflate_stream_ ~buf_size str))
+      |> S.Response.set_body (`Stream (encode_deflate_stream_ ~buf_size str))
 
-    | String _ | BigString _ | Void -> resp
+    | `String _ | `Void -> resp
   ) else resp
 
 let middleware
@@ -227,3 +215,4 @@ let setup
   let m = middleware ?compress_above ?buf_size () in
   S._debug (fun k->k "setup gzip support");
   S.add_middleware ~stage:`Encoding server m
+

src/dune

@@ -2,6 +2,6 @@
 (library
   (name tiny_httpd)
   (public_name tiny_httpd)
-  (libraries threads bigstring bigstring-unix)
+  (libraries threads)
   (flags :standard -safe-string -warn-error -a+8)
   (wrapped false))

tests/download_chunked.sh

@@ -7,15 +7,6 @@ PID=$!
 
 sleep 0.1
 
-echo download1 1>&2
-curl -N "http://localhost:${PORT}/foo_50" -o data2 \
-  -H 'Tranfer-encoding: chunked'
-
-echo download2 1>&2
-curl -N "http://localhost:${PORT}/foo_50" -o data2 \
-  -H 'Tranfer-encoding: chunked'
-
-echo download3 1>&2
 curl -N "http://localhost:${PORT}/foo_50" -o data2 \
   -H 'Tranfer-encoding: chunked'