diff --git a/src/server/ocsigen_cohttp.ml b/src/server/ocsigen_cohttp.ml index fcef7343e..c0e79fed5 100644 --- a/src/server/ocsigen_cohttp.ml +++ b/src/server/ocsigen_cohttp.ml @@ -58,10 +58,12 @@ 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) -> Ipaddr.to_string ip - | `Unix_domain_socket path -> "unix://" ^ path + | `TCP (ip, port) -> Unix.ADDR_INET (Ipaddr_unix.to_inet_addr ip, port) + | `Unix_domain_socket path -> Unix.ADDR_UNIX path | `TLS (_, edn) -> getsockname edn - | `Unknown _ | `Vchan_direct _ | `Vchan_domain_socket _ -> "unknown" + | `Unknown err -> raise (Failure ("resolution failed: " ^ err)) + | `Vchan_direct _ -> raise (Failure "VChan not supported") + | `Vchan_domain_socket _ -> raise (Failure "VChan not supported") in let sockaddr = getsockname edn in let connection_closed = diff --git a/src/server/ocsigen_request.ml b/src/server/ocsigen_request.ml index a61442b28..040662272 100644 --- a/src/server/ocsigen_request.ml +++ b/src/server/ocsigen_request.ml @@ -53,7 +53,9 @@ type t = ; r_port : int ; r_ssl : bool ; r_filenames : string list ref - ; r_remote_ip : string + ; 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_forward_ip : string list ; r_uri : uri ; r_meth : Cohttp.Code.meth @@ -84,11 +86,26 @@ 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_remote_ip = sockaddr + ; r_sockaddr = sockaddr + ; r_remote_ip + ; r_remote_ip_parsed ; r_forward_ip = forward_ip ; r_uri = make_uri (Cohttp.Request.uri request) ; r_encoding = Cohttp.Request.encoding request @@ -123,6 +140,7 @@ let update ; r_meth ; r_forward_ip ; r_remote_ip + ; r_remote_ip_parsed ; r_cookies_override ; r_body ; r_sub_path @@ -132,8 +150,11 @@ 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 = - match remote_ip with Some remote_ip -> remote_ip | None -> r_remote_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_sub_path = match sub_path with Some _ -> sub_path | None -> r_sub_path and r_body = match post_data with @@ -172,6 +193,7 @@ let update ; r_meth ; r_forward_ip ; r_remote_ip + ; r_remote_ip_parsed ; r_body ; r_cookies_override ; r_sub_path @@ -270,19 +292,8 @@ 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; _} = 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 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 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 f1c3c7d78..4d9db6004 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:string + -> sockaddr:Lwt_unix.sockaddr -> body:Cohttp_lwt.Body.t -> connection_closed:unit Lwt.t -> Cohttp.Request.t