From 7b1965c30eec4a5c969f35fadb15acceac374825 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Fri, 20 Jun 2025 15:22:12 +0200 Subject: [PATCH 1/2] Remove usage of Unix.sockaddr type This makes `Ocsigen_request.t` lighter and remove a source of exceptions. Value of type `Unix.sockaddr` were constructed for purposes other than performing network calls and can easily be replaced by a string. Accesscontrol is the only user of parsed IP addresses, which doesn't justifies the weight added to the request record. This removes a source of exception for every requests. --- src/server/ocsigen_cohttp.ml | 8 +++--- src/server/ocsigen_request.ml | 45 +++++++++++++--------------------- src/server/ocsigen_request.mli | 2 +- 3 files changed, 21 insertions(+), 34 deletions(-) diff --git a/src/server/ocsigen_cohttp.ml b/src/server/ocsigen_cohttp.ml index c0e79fed5..fcef7343e 100644 --- a/src/server/ocsigen_cohttp.ml +++ b/src/server/ocsigen_cohttp.ml @@ -58,12 +58,10 @@ let handler ~ssl ~address ~port ~connector (flow, conn) request body = let filenames = ref [] in let edn = Conduit_lwt_unix.endp_of_flow flow in let rec getsockname = function - | `TCP (ip, port) -> Unix.ADDR_INET (Ipaddr_unix.to_inet_addr ip, port) - | `Unix_domain_socket path -> Unix.ADDR_UNIX path + | `TCP (ip, _port) -> Ipaddr.to_string ip + | `Unix_domain_socket path -> "unix://" ^ path | `TLS (_, edn) -> getsockname edn - | `Unknown err -> raise (Failure ("resolution failed: " ^ err)) - | `Vchan_direct _ -> raise (Failure "VChan not supported") - | `Vchan_domain_socket _ -> raise (Failure "VChan not supported") + | `Unknown _ | `Vchan_direct _ | `Vchan_domain_socket _ -> "unknown" in let sockaddr = getsockname edn in let connection_closed = diff --git a/src/server/ocsigen_request.ml b/src/server/ocsigen_request.ml index 040662272..a61442b28 100644 --- a/src/server/ocsigen_request.ml +++ b/src/server/ocsigen_request.ml @@ -53,9 +53,7 @@ type t = ; r_port : int ; r_ssl : bool ; r_filenames : string list ref - ; r_sockaddr : Lwt_unix.sockaddr - ; r_remote_ip : string Lazy.t - ; r_remote_ip_parsed : [`Ip of Ipaddr.t | `Unix of string] Lazy.t + ; r_remote_ip : string ; r_forward_ip : string list ; r_uri : uri ; r_meth : Cohttp.Code.meth @@ -86,26 +84,11 @@ let make ~connection_closed request = - let r_remote_ip = - lazy - (match sockaddr with - | Unix.ADDR_INET (ip, _port) -> Unix.string_of_inet_addr ip - | ADDR_UNIX f -> f) - in - let r_remote_ip_parsed = - lazy - (match sockaddr with - | Unix.ADDR_INET (ip, _port) -> - `Ip (Ipaddr.of_string_exn (Unix.string_of_inet_addr ip)) - | ADDR_UNIX f -> `Unix f) - in { r_address = address ; r_port = port ; r_ssl = ssl ; r_filenames = filenames - ; r_sockaddr = sockaddr - ; r_remote_ip - ; r_remote_ip_parsed + ; r_remote_ip = sockaddr ; r_forward_ip = forward_ip ; r_uri = make_uri (Cohttp.Request.uri request) ; r_encoding = Cohttp.Request.encoding request @@ -140,7 +123,6 @@ let update ; r_meth ; r_forward_ip ; r_remote_ip - ; r_remote_ip_parsed ; r_cookies_override ; r_body ; r_sub_path @@ -150,11 +132,8 @@ let update let r_ssl = match ssl with Some ssl -> ssl | None -> r_ssl and r_forward_ip = match forward_ip with Some forward_ip -> forward_ip | None -> r_forward_ip - and r_remote_ip, r_remote_ip_parsed = - match remote_ip with - | Some remote_ip -> - lazy remote_ip, lazy (`Ip (Ipaddr.of_string_exn remote_ip)) - | None -> r_remote_ip, r_remote_ip_parsed + and r_remote_ip = + match remote_ip with Some remote_ip -> remote_ip | None -> r_remote_ip and r_sub_path = match sub_path with Some _ -> sub_path | None -> r_sub_path and r_body = match post_data with @@ -193,7 +172,6 @@ let update ; r_meth ; r_forward_ip ; r_remote_ip - ; r_remote_ip_parsed ; r_body ; r_cookies_override ; r_sub_path @@ -292,8 +270,19 @@ let post_params r s i = let files r s i = match force_post_data r s i with Some v -> Some (v >|= snd) | None -> None -let remote_ip {r_remote_ip; _} = Lazy.force r_remote_ip -let remote_ip_parsed {r_remote_ip_parsed; _} = Lazy.force r_remote_ip_parsed +let remote_ip {r_remote_ip; _} = r_remote_ip + +let remote_ip_parsed {r_remote_ip; _} = + let is_prefix prefix s = + (* TODO: Naive version to be swapped with [String.starts_with ~prefix s] + when the dependency on OCaml >= 4.13 is acceptable. *) + let plen = String.length prefix in + String.length s >= plen && String.sub s 0 plen = prefix + in + if is_prefix "unix://" r_remote_ip + then `Unix r_remote_ip + else `Ip (Ipaddr.of_string_exn r_remote_ip) + let forward_ip {r_forward_ip; _} = r_forward_ip let request_cache {r_request_cache; _} = r_request_cache let tries {r_tries; _} = r_tries diff --git a/src/server/ocsigen_request.mli b/src/server/ocsigen_request.mli index 4d9db6004..f1c3c7d78 100644 --- a/src/server/ocsigen_request.mli +++ b/src/server/ocsigen_request.mli @@ -19,7 +19,7 @@ val make : -> port:int -> ssl:bool -> filenames:string list ref - -> sockaddr:Lwt_unix.sockaddr + -> sockaddr:string -> body:Cohttp_lwt.Body.t -> connection_closed:unit Lwt.t -> Cohttp.Request.t From d455c3d030517980ecef88940ee552d01af465d8 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Fri, 20 Jun 2025 15:28:38 +0200 Subject: [PATCH 2/2] Remove unused Unix.sockaddr printer --- src/server/ocsigen_server.ml | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/src/server/ocsigen_server.ml b/src/server/ocsigen_server.ml index e4a221444..a9297858c 100644 --- a/src/server/ocsigen_server.ml +++ b/src/server/ocsigen_server.ml @@ -38,19 +38,6 @@ let () = ("Uncaught Exception after lwt timeout" ^^ "@\n%s") (Printexc.to_string e))) -let pp_sockaddr ppf = function - | Unix.ADDR_INET (ip, _port) -> - Format.fprintf ppf "%s" (Unix.string_of_inet_addr ip) - | ADDR_UNIX f -> Format.fprintf ppf "%s" f - -let _warn sockaddr s = - Logs.warn ~src:section (fun fmt -> - fmt "While talking to %a:%s" pp_sockaddr sockaddr s) - -let _dbg sockaddr s = - Logs.info ~src:section (fun fmt -> - fmt "While talking to %a:%s" pp_sockaddr sockaddr s) - (* fatal errors messages *) let errmsg = function | Dynlink_wrapper.Error e ->