diff --git a/src/Tiny_httpd_server.ml b/src/Tiny_httpd_server.ml index 4094fba5..0ab23d7d 100644 --- a/src/Tiny_httpd_server.ml +++ b/src/Tiny_httpd_server.ml @@ -453,7 +453,8 @@ module Response = struct in let self = { self with headers; body } in Log.debug (fun k -> - k "output response: %s" + k "t[%d]: output response: %s" + (Thread.id @@ Thread.self ()) (Format.asprintf "%a" pp { self with body = `String "<...>" })); (* write headers, using [buf] to batch writes *) @@ -478,15 +479,21 @@ module Response = struct IO.Writer.write oc' w; IO.Output.close oc' with e -> + let bt = Printexc.get_raw_backtrace () in IO.Output.close oc'; - raise e) + IO.Output.flush oc; + Printexc.raise_with_backtrace e bt) | `Stream str -> - (try - Byte_stream.output_chunked' ~buf oc str; - Byte_stream.close str - with e -> - Byte_stream.close str; - raise e)); + (match Byte_stream.output_chunked' ~buf oc str with + | () -> + Log.debug (fun k -> + k "t[%d]: done outputing stream" (Thread.id @@ Thread.self ())); + Byte_stream.close str + | exception e -> + let bt = Printexc.get_raw_backtrace () in + IO.Output.flush oc; + Byte_stream.close str; + Printexc.raise_with_backtrace e bt)); IO.Output.flush oc end @@ -907,6 +914,11 @@ module Unix_tcp_server_ = struct mutable running: bool; (* TODO: use an atomic? *) } + let shutdown_silent_ fd = + try Unix.shutdown fd Unix.SHUTDOWN_ALL with _ -> () + + let close_silent_ fd = try Unix.close fd with _ -> () + let to_tcp_server (self : t) : IO.TCP_server.builder = { IO.TCP_server.serve = @@ -961,25 +973,19 @@ module Unix_tcp_server_ = struct Log.info (fun k -> k "serving new client on %s" (Tiny_httpd_util.show_sockaddr client_addr)); + (* + if self.masksigpipe then + ignore (Unix.sigprocmask Unix.SIG_BLOCK [ Sys.sigpipe ] : _ list); + *) + Unix.setsockopt client_sock Unix.TCP_NODELAY true; Unix.(setsockopt_float client_sock SO_RCVTIMEO self.timeout); Unix.(setsockopt_float client_sock SO_SNDTIMEO self.timeout); let oc = - IO.Output.of_out_channel @@ Unix.out_channel_of_descr client_sock + IO.Output.of_out_channel ~close_noerr:true + @@ Unix.out_channel_of_descr client_sock in - let ic = IO.Input.of_unix_fd client_sock in - handle.handle ~client_addr ic oc; - Log.info (fun k -> - k "done with client on %s, exiting" - @@ Tiny_httpd_util.show_sockaddr client_addr); - (try - Unix.shutdown client_sock Unix.SHUTDOWN_ALL; - Unix.close client_sock - with e -> - Log.error (fun k -> - k "error when closing sock for client %s: %s" - (Tiny_httpd_util.show_sockaddr client_addr) - (Printexc.to_string e))); - () + let ic = IO.Input.of_unix_fd ~close_noerr:true client_sock in + handle.handle ~client_addr ic oc in Unix.set_nonblock sock; @@ -988,18 +994,23 @@ module Unix_tcp_server_ = struct | client_sock, client_addr -> (* limit concurrency *) Sem_.acquire 1 self.sem_max_connections; - (* Block INT/HUP while cloning to avoid children handling them. When thread gets them, our Unix.accept raises neatly. *) ignore Unix.(sigprocmask SIG_BLOCK Sys.[ sigint; sighup ]); self.new_thread (fun () -> try - Unix.setsockopt client_sock Unix.TCP_NODELAY true; handle_client_unix_ client_sock client_addr; + Log.info (fun k -> + k "t[%d]: done with client on %s, exiting" + (Thread.id @@ Thread.self ()) + @@ Tiny_httpd_util.show_sockaddr client_addr); + shutdown_silent_ client_sock; + close_silent_ client_sock; Sem_.release 1 self.sem_max_connections with e -> let bt = Printexc.get_raw_backtrace () in - (try Unix.close client_sock with _ -> ()); + shutdown_silent_ client_sock; + close_silent_ client_sock; Sem_.release 1 self.sem_max_connections; Log.error (fun k -> k @@ -1015,8 +1026,8 @@ module Unix_tcp_server_ = struct ignore (Unix.select [ sock ] [] [ sock ] 1.0 : _ * _ * _) | exception e -> Log.error (fun k -> - k "Unix.accept or Thread.create raised an exception: %s" - (Printexc.to_string e)) + k "Unix.accept raised an exception: %s" (Printexc.to_string e)); + Thread.delay 0.01 done; (* Wait for all threads to be done: this only works if all threads are done. *) @@ -1102,24 +1113,29 @@ let client_handle_for (self : t) ~client_addr ic oc : unit = ) in + let log_exn msg bt = + Log.error (fun k -> + k "error while processing response for %s msg=%s@.%s" + (Tiny_httpd_util.show_sockaddr client_addr) + msg + (Printexc.raw_backtrace_to_string bt)) + in + (* handle generic exception *) - let handle_exn e = - let resp = - Response.fail ~code:500 "server error: %s" (Printexc.to_string e) - in - if not Log.dummy then - Log.error (fun k -> - k "response to %s code=%d" - (Tiny_httpd_util.show_sockaddr client_addr) - resp.code); + let handle_exn e bt : unit = + let msg = Printexc.to_string e in + let resp = Response.fail ~code:500 "server error: %s" msg in + if not Log.dummy then log_exn msg bt; Response.output_ ~buf:buf_res oc resp in - let handle_bad_req req e = - let resp = - Response.fail ~code:500 "server error: %s" (Printexc.to_string e) - in - log_response req resp; + let handle_bad_req req e bt = + let msg = Printexc.to_string e in + let resp = Response.fail ~code:500 "server error: %s" msg in + if not Log.dummy then ( + log_exn msg bt; + log_response req resp + ); Response.output_ ~buf:buf_res oc resp in @@ -1165,7 +1181,9 @@ let client_handle_for (self : t) ~client_addr ic oc : unit = in UP.handle_connection client_addr handshake_st ic oc - with e -> handle_bad_req req e + with e -> + let bt = Printexc.get_raw_backtrace () in + handle_bad_req req e bt in let continue = ref true in @@ -1182,7 +1200,9 @@ let client_handle_for (self : t) ~client_addr ic oc : unit = continue := false | Ok (Some req) -> Log.debug (fun k -> - k "parsed request: %s" (Format.asprintf "@[%a@]" Request.pp_ req)); + k "t[%d]: parsed request: %s" + (Thread.id @@ Thread.self ()) + (Format.asprintf "@[%a@]" Request.pp_ req)); if Request.close_after_req req then continue := false; @@ -1225,15 +1245,22 @@ let client_handle_for (self : t) ~client_addr ic oc : unit = continue := false; log_response req r; Response.output_ ~buf:buf_res oc r - with Sys_error _ -> continue := false + with Sys_error e -> + Log.debug (fun k -> + k "error when writing response: %s@.connection broken" e); + continue := false in (* call handler *) - try handler oc req ~resp with Sys_error _ -> continue := false + try handler oc req ~resp + with Sys_error e -> + Log.debug (fun k -> + k "error while handling request: %s@.connection broken" e); + continue := false with - | Sys_error _ -> + | Sys_error e -> (* connection broken somehow *) - Log.debug (fun k -> k "connection broken"); + Log.debug (fun k -> k "error: %s@. connection broken" e); continue := false | Bad_req (code, s) -> continue := false; @@ -1241,12 +1268,15 @@ let client_handle_for (self : t) ~client_addr ic oc : unit = log_response req resp; Response.output_ ~buf:buf_res oc resp | Upgrade _ as e -> raise e - | e -> handle_bad_req req e) + | e -> + let bt = Printexc.get_raw_backtrace () in + handle_bad_req req e bt) in try while !continue && running self do - Log.debug (fun k -> k "read next request"); + Log.debug (fun k -> + k "t[%d]: read next request" (Thread.id @@ Thread.self ())); handle_one_req () done with @@ -1254,7 +1284,9 @@ let client_handle_for (self : t) ~client_addr ic oc : unit = (* upgrades take over the whole connection, we won't process any further request *) handle_upgrade req up - | e -> handle_exn e + | e -> + let bt = Printexc.get_raw_backtrace () in + handle_exn e bt let client_handler (self : t) : IO.TCP_server.conn_handler = { IO.TCP_server.handle = client_handle_for self }