http_of_dir: ability to setup socket timeout

This commit is contained in:
Simon Cruanes 2024-02-21 22:09:18 -05:00
parent 353f0925b4
commit d56ffb3a08
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4

View file

@ -4,8 +4,8 @@ module D = Tiny_httpd_dir
module Pf = Printf module Pf = Printf
module Log = Tiny_httpd.Log module Log = Tiny_httpd.Log
let serve ~config (dir : string) addr port j : _ result = let serve ~config ~timeout (dir : string) addr port j : _ result =
let server = S.create ~max_connections:j ~addr ~port () in let server = S.create ~max_connections:j ~addr ~port ~timeout () in
let after_init () = let after_init () =
Printf.printf "serve directory %s on http://%(%s%):%d\n%!" dir Printf.printf "serve directory %s on http://%(%s%):%d\n%!" dir
(if S.is_ipv6 server then (if S.is_ipv6 server then
@ -31,6 +31,7 @@ let main () =
let dir_ = ref "." in let dir_ = ref "." in
let addr = ref "127.0.0.1" in let addr = ref "127.0.0.1" in
let port = ref 8080 in let port = ref 8080 in
let timeout = ref 30. in
let j = ref 32 in let j = ref 32 in
Arg.parse Arg.parse
(Arg.align (Arg.align
@ -41,6 +42,7 @@ let main () =
"-p", Set_int port, " alias to --port"; "-p", Set_int port, " alias to --port";
"--dir", Set_string dir_, " directory to serve (default: \".\")"; "--dir", Set_string dir_, " directory to serve (default: \".\")";
"--debug", Unit (Log.setup ~debug:true), " debug mode"; "--debug", Unit (Log.setup ~debug:true), " debug mode";
"--timeout", Arg.Set_float timeout, " TCP timeout on sockets";
( "--upload", ( "--upload",
Unit (fun () -> config.upload <- true), Unit (fun () -> config.upload <- true),
" enable file uploading" ); " enable file uploading" );
@ -75,7 +77,7 @@ let main () =
]) ])
(fun s -> dir_ := s) (fun s -> dir_ := s)
"http_of_dir [options] [dir]"; "http_of_dir [options] [dir]";
match serve ~config !dir_ !addr !port !j with match serve ~config ~timeout:!timeout !dir_ !addr !port !j with
| Ok () -> () | Ok () -> ()
| Error e -> raise e | Error e -> raise e