From 53182375c0cdbdc1cfba515be27f336a5438a346 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Lavergne?= Date: Mon, 7 Aug 2023 16:52:32 -0400 Subject: [PATCH 1/3] Preserve client address down to Request.t Note that the argument is optional because of the Internal_ use case. --- src/Tiny_httpd_io.ml | 2 +- src/Tiny_httpd_server.ml | 16 +++++++++------- src/Tiny_httpd_server.mli | 1 + 3 files changed, 11 insertions(+), 8 deletions(-) diff --git a/src/Tiny_httpd_io.ml b/src/Tiny_httpd_io.ml index 815bd8de..1ff12c8e 100644 --- a/src/Tiny_httpd_io.ml +++ b/src/Tiny_httpd_io.ml @@ -187,7 +187,7 @@ end (** A TCP server abstraction. *) module TCP_server = struct type conn_handler = { - handle: In_channel.t -> Out_channel.t -> unit; + handle: ?client_addr:Unix.sockaddr -> In_channel.t -> Out_channel.t -> unit; (** Handle client connection *) } diff --git a/src/Tiny_httpd_server.ml b/src/Tiny_httpd_server.ml index f1879bde..f7fd1247 100644 --- a/src/Tiny_httpd_server.ml +++ b/src/Tiny_httpd_server.ml @@ -164,6 +164,7 @@ module Request = struct type 'body t = { meth: Meth.t; host: string; + client_addr: Unix.sockaddr option; headers: Headers.t; http_version: int * int; path: string; @@ -245,7 +246,7 @@ module Request = struct bad_reqf 400 "body is too short by %d bytes" size) (* parse request, but not body (yet) *) - let parse_req_start ~get_time_s ~buf (bs : byte_stream) : + let parse_req_start ?client_addr ~get_time_s ~buf (bs : byte_stream) : unit t option resp_result = try let line = Byte_stream.read_line ~buf bs in @@ -281,6 +282,7 @@ module Request = struct meth; query; host; + client_addr; path; path_components; headers; @@ -934,7 +936,7 @@ module Unix_tcp_server_ = struct after_init tcp_server; (* how to handle a single client *) - let handle_client_unix_ (client_sock : Unix.file_descr) : unit = + let handle_client_unix_ (client_sock : Unix.file_descr) (client_addr : Unix.sockaddr) : unit = Unix.(setsockopt_float client_sock SO_RCVTIMEO self.timeout); Unix.(setsockopt_float client_sock SO_SNDTIMEO self.timeout); let oc = @@ -942,7 +944,7 @@ module Unix_tcp_server_ = struct @@ Unix.out_channel_of_descr client_sock in let ic = IO.In_channel.of_unix_fd client_sock in - handle.handle ic oc; + handle.handle ~client_addr ic oc; _debug (fun k -> k "done with client, exiting"); (try Unix.close client_sock with e -> @@ -955,11 +957,11 @@ module Unix_tcp_server_ = struct (* limit concurrency *) Sem_.acquire 1 self.sem_max_connections; try - let client_sock, _ = Unix.accept sock in + let client_sock, client_addr = Unix.accept sock in Unix.setsockopt client_sock Unix.TCP_NODELAY true; self.new_thread (fun () -> try - handle_client_unix_ client_sock; + handle_client_unix_ client_sock client_addr; Sem_.release 1 self.sem_max_connections with e -> (try Unix.close client_sock with _ -> ()); @@ -1024,7 +1026,7 @@ let find_map f l = aux f l (* handle client on [ic] and [oc] *) -let client_handle_for (self : t) ic oc : unit = +let client_handle_for (self : t) ?client_addr ic oc : unit = Pool.with_resource self.buf_pool @@ fun buf -> Pool.with_resource self.buf_pool @@ fun buf_res -> let is = Byte_stream.of_input ~buf_size:self.buf_size ic in @@ -1032,7 +1034,7 @@ let client_handle_for (self : t) ic oc : unit = while !continue && running self do _debug (fun k -> k "read next request"); let (module B) = self.backend in - match Request.parse_req_start ~get_time_s:B.get_time_s ~buf is with + match Request.parse_req_start ?client_addr ~get_time_s:B.get_time_s ~buf is with | Ok None -> continue := false (* client is done *) | Error (c, s) -> (* connection error, close *) diff --git a/src/Tiny_httpd_server.mli b/src/Tiny_httpd_server.mli index ea391cef..d3fbc99a 100644 --- a/src/Tiny_httpd_server.mli +++ b/src/Tiny_httpd_server.mli @@ -67,6 +67,7 @@ module Request : sig meth: Meth.t; (** HTTP method for this request. *) host: string; (** Host header, mandatory. It can also be found in {!headers}. *) + client_addr : Unix.sockaddr option; (** Client address. *) headers: Headers.t; (** List of headers. *) http_version: int * int; (** HTTP version. This should be either [1, 0] or [1, 1]. *) From d5f783c1597445adeb6c9f8848b604a6b2b1d1a5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Lavergne?= Date: Tue, 8 Aug 2023 15:00:20 -0400 Subject: [PATCH 2/3] Comment re: NEXT_RELEASE Co-authored-by: Simon Cruanes --- src/Tiny_httpd_server.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Tiny_httpd_server.mli b/src/Tiny_httpd_server.mli index 69d4a524..fbe7a77f 100644 --- a/src/Tiny_httpd_server.mli +++ b/src/Tiny_httpd_server.mli @@ -67,7 +67,7 @@ module Request : sig meth: Meth.t; (** HTTP method for this request. *) host: string; (** Host header, mandatory. It can also be found in {!headers}. *) - client_addr : Unix.sockaddr option; (** Client address. *) + client_addr : Unix.sockaddr option; (** Client address. Available since NEXT_RELEASE. *) headers: Headers.t; (** List of headers. *) http_version: int * int; (** HTTP version. This should be either [1, 0] or [1, 1]. *) From 03596c1a08f9b9fa063f22c40d80afc73d14ed08 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Lavergne?= Date: Tue, 8 Aug 2023 15:18:39 -0400 Subject: [PATCH 3/3] Remove option around client_addr --- src/Tiny_httpd_io.ml | 2 +- src/Tiny_httpd_server.ml | 12 ++++++------ src/Tiny_httpd_server.mli | 4 ++-- tests/unit/t_server.ml | 3 ++- 4 files changed, 11 insertions(+), 10 deletions(-) diff --git a/src/Tiny_httpd_io.ml b/src/Tiny_httpd_io.ml index 1856c056..507d9544 100644 --- a/src/Tiny_httpd_io.ml +++ b/src/Tiny_httpd_io.ml @@ -187,7 +187,7 @@ end (** A TCP server abstraction. *) module TCP_server = struct type conn_handler = { - handle: ?client_addr:Unix.sockaddr -> Input.t -> Output.t -> unit; (** Handle client connection *) + handle: client_addr:Unix.sockaddr -> Input.t -> Output.t -> unit; (** Handle client connection *) } type t = { diff --git a/src/Tiny_httpd_server.ml b/src/Tiny_httpd_server.ml index 30d3b47f..a8b727d2 100644 --- a/src/Tiny_httpd_server.ml +++ b/src/Tiny_httpd_server.ml @@ -164,7 +164,7 @@ module Request = struct type 'body t = { meth: Meth.t; host: string; - client_addr: Unix.sockaddr option; + client_addr: Unix.sockaddr; headers: Headers.t; http_version: int * int; path: string; @@ -246,7 +246,7 @@ module Request = struct bad_reqf 400 "body is too short by %d bytes" size) (* parse request, but not body (yet) *) - let parse_req_start ?client_addr ~get_time_s ~buf (bs : byte_stream) : + let parse_req_start ~client_addr ~get_time_s ~buf (bs : byte_stream) : unit t option resp_result = try let line = Byte_stream.read_line ~buf bs in @@ -342,8 +342,8 @@ module Request = struct | e -> bad_reqf 500 "failed to read body: %s" (Printexc.to_string e) module Internal_ = struct - let parse_req_start ?(buf = Buf.create ()) ~get_time_s bs = - parse_req_start ~get_time_s ~buf bs |> unwrap_resp_result + let parse_req_start ?(buf = Buf.create ()) ~client_addr ~get_time_s bs = + parse_req_start ~client_addr ~get_time_s ~buf bs |> unwrap_resp_result let parse_body ?(buf = Buf.create ()) req bs : _ t = parse_body_ ~tr_stream:(fun s -> s) ~buf { req with body = bs } @@ -1017,7 +1017,7 @@ let find_map f l = aux f l (* handle client on [ic] and [oc] *) -let client_handle_for (self : t) ?client_addr ic oc : unit = +let client_handle_for (self : t) ~client_addr ic oc : unit = Pool.with_resource self.buf_pool @@ fun buf -> Pool.with_resource self.buf_pool @@ fun buf_res -> let is = Byte_stream.of_input ~buf_size:self.buf_size ic in @@ -1025,7 +1025,7 @@ let client_handle_for (self : t) ?client_addr ic oc : unit = while !continue && running self do _debug (fun k -> k "read next request"); let (module B) = self.backend in - match Request.parse_req_start ?client_addr ~get_time_s:B.get_time_s ~buf is with + match Request.parse_req_start ~client_addr ~get_time_s:B.get_time_s ~buf is with | Ok None -> continue := false (* client is done *) | Error (c, s) -> (* connection error, close *) diff --git a/src/Tiny_httpd_server.mli b/src/Tiny_httpd_server.mli index fbe7a77f..b96c6a1d 100644 --- a/src/Tiny_httpd_server.mli +++ b/src/Tiny_httpd_server.mli @@ -67,7 +67,7 @@ module Request : sig meth: Meth.t; (** HTTP method for this request. *) host: string; (** Host header, mandatory. It can also be found in {!headers}. *) - client_addr : Unix.sockaddr option; (** Client address. Available since NEXT_RELEASE. *) + client_addr : Unix.sockaddr; (** Client address. Available since NEXT_RELEASE. *) headers: Headers.t; (** List of headers. *) http_version: int * int; (** HTTP version. This should be either [1, 0] or [1, 1]. *) @@ -162,7 +162,7 @@ module Request : sig (* for testing purpose, do not use. There is no guarantee of stability. *) module Internal_ : sig val parse_req_start : - ?buf:buf -> get_time_s:(unit -> float) -> byte_stream -> unit t option + ?buf:buf -> client_addr:Unix.sockaddr -> get_time_s:(unit -> float) -> byte_stream -> unit t option val parse_body : ?buf:buf -> unit t -> byte_stream -> byte_stream t end diff --git a/tests/unit/t_server.ml b/tests/unit/t_server.ml index ef85e9be..56dd77ff 100644 --- a/tests/unit/t_server.ml +++ b/tests/unit/t_server.ml @@ -10,7 +10,8 @@ let () = salutationsSOMEJUNK" in let str = Tiny_httpd.Byte_stream.of_string q in - let r = Request.Internal_.parse_req_start ~get_time_s:(fun _ -> 0.) str in + let client_addr = Unix.(ADDR_INET (inet_addr_loopback, 1024)) in + let r = Request.Internal_.parse_req_start ~client_addr ~get_time_s:(fun _ -> 0.) str in match r with | None -> failwith "should parse" | Some req ->