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

wip: try to make non-block read, block write work

Browse source
This commit is contained in:
Simon Cruanes 2021-12-11 09:29:41 -05:00
parent 6536bfeeb3
commit 4bdca82fce
No known key found for this signature in database
GPG key ID: 4AC01D0849AA62B6
2 changed files with 22 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
src/Tiny_httpd.ml
View file

@ -66,41 +66,27 @@ module Byte_stream = struct
bs_close=(fun () -> ());
}
let of_chan_ ~close ic : t =
let i = ref 0 in
let len = ref 0 in
let buf = Bytes.make 4096 ' ' in
{ bs_fill_buf=(fun () ->
if !i >= !len then (
i := 0;
len := input ic buf 0 (Bytes.length buf);
);
buf, !i,!len - !i);
bs_consume=(fun n -> i := !i + n);
bs_close=(fun () -> close ic)
}
let of_chan = of_chan_ ~close:close_in
let of_chan_close_noerr = of_chan_ ~close:close_in_noerr
exception Timeout
let of_descr_ ?(timeout=(-1.0)) ~close ic : t =
let of_descr_ ?(timeout=(-1.0)) ~close fd : t =
let i = ref 0 in
let len = ref 0 in
let buf = Bytes.make 4096 ' ' in
Unix.set_nonblock fd;
{ bs_fill_buf=(fun () ->
if !i >= !len then (
i := 0;
let rec wait() =
let to_read,_,_ = Unix.select [ic] [] [] timeout in
let to_read,_,_ = Unix.select [fd] [] [] timeout in
if to_read = [] then raise Timeout;
read()
and read() =
try len := Unix.read ic buf 0 (Bytes.length buf)
try len := Unix.read fd buf 0 (Bytes.length buf)
with
| Unix.Unix_error (EAGAIN, _, _) -> read()
| Sys_blocked_io
| Unix.Unix_error (EWOULDBLOCK, _, _) ->
(* FIXME: we should decrease the timeout by however long was spent in [select] *)
wait()
@ -109,10 +95,18 @@ module Byte_stream = struct
);
buf, !i,!len - !i);
bs_consume=(fun n -> i := !i + n);
bs_close=(fun () -> close ic)
bs_close=close
}
let of_descr = of_descr_ ~close:Unix.close
let of_descr ?timeout fd = of_descr_ ?timeout ~close:(fun() -> Unix.close fd) fd
let of_chan ic =
let fd = Unix.descr_of_in_channel ic in
of_descr_ ~timeout:(-1.0) ~close:(fun() -> close_in ic) fd
let of_chan_close_noerr ic =
let fd = Unix.descr_of_in_channel ic in
of_descr_ ~timeout:(-1.0) ~close:(fun() -> close_in_noerr ic) fd
let rec iter f (self:t) : unit =
let s, i, len = self.bs_fill_buf () in

7
src/bin/http_of_dir.ml
View file

@ -6,6 +6,7 @@ type config = {
mutable addr: string;
mutable port: int;
mutable upload: bool;
mutable max_keep_alive: float; (* per connection timeout *)
mutable max_upload_size: int;
mutable auto_index_html: bool;
mutable delete: bool;
@ -17,6 +18,7 @@ let default_config () : config = {
port=8080;
delete=false;
upload=false;
max_keep_alive=10.;
max_upload_size = 10 * 1024 * 1024;
auto_index_html=true;
j=32;
@ -111,7 +113,10 @@ let date_of_time (f:float) : string =
*)
let serve ~config (dir:string) : _ result =
let server = S.create ~max_connections:config.j ~addr:config.addr ~port:config.port () in
let server =
S.create ~max_connections:config.j
~max_keep_alive:config.max_keep_alive
~addr:config.addr ~port:config.port () in
Printf.printf "serve directory %s on http://%(%s%):%d\n%!"
dir (if S.is_ipv6 server then "[%s]" else "%s") config.addr config.port;
if config.delete then (