Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 5 additions & 3 deletions src/server/ocsigen_cohttp.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
45 changes: 28 additions & 17 deletions src/server/ocsigen_request.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/server/ocsigen_request.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down