Merge branch 'master' into compat_with_cohttp_610

Author: balat

src/baselib/dune

@@ -26,6 +26,7 @@
   cryptokit
   re
   ocsigen_lib_base
+  cohttp-lwt
   logs
   (select
    dynlink_wrapper.ml

src/baselib/ocsigen_stream.ml

@@ -239,22 +239,7 @@ let of_lwt_stream stream =
   in
   make aux
 
-(** Convert an {!Ocsigen_stream.t} into a {!Lwt_stream.t}.
-    @param is_empty function to skip empty chunk.
-*)
-let to_lwt_stream ?(is_empty = fun _ -> false) o_stream =
-  let stream = ref (get o_stream) in
-  let rec wrap () =
-    next !stream >>= function
-    | Finished None -> o_stream.finalizer `Success >>= fun () -> Lwt.return None
-    | Finished (Some next) ->
-        stream := next;
-        wrap ()
-    | Cont (value, next) ->
-        stream := next;
-        if is_empty value then wrap () else Lwt.return (Some value)
-  in
-  Lwt_stream.from wrap
+let of_cohttp_body body = Cohttp_lwt.Body.to_stream body |> of_lwt_stream
 
 module StringStream = struct
   type out = string t

src/baselib/ocsigen_stream.mli

@@ -106,14 +106,9 @@ val of_file : string -> string t
 val of_string : string -> string t
 (** returns a stream containing a string. *)
 
-val of_lwt_stream : 'a Lwt_stream.t -> 'a t
+val of_cohttp_body : Cohttp_lwt.Body.t -> string t
 (** Convert a {!Lwt_stream.t} to an {!Ocsigen_stream.t}. *)
 
-val to_lwt_stream : ?is_empty:('a -> bool) -> 'a t -> 'a Lwt_stream.t
-(** Convert an {!Ocsigen_stream.t} into a {!Lwt_stream.t}.
-    @param is_empty function to skip empty chunk.
-*)
-
 module StringStream : sig
   type out = string t
   (** Interface for stream creation (for tyxml) *)

src/extensions/accesscontrol.ml

@@ -39,17 +39,19 @@ let ip s =
   in
   fun ri ->
     let r =
-      match Ocsigen_request.remote_ip_parsed ri with
-      | `Ip ip -> Ipaddr.Prefix.mem ip prefix
-      | `Unix _ -> false
+      match Ocsigen_request.client_conn ri with
+      | `Inet (ip, _) -> Ipaddr.Prefix.mem ip prefix
+      | _ -> false
     in
     if r
     then
       Logs.info ~src:section (fun fmt ->
-        fmt "IP: %s matches %s" (Ocsigen_request.remote_ip ri) s)
+        fmt "IP: %s matches %s" (Ocsigen_request.client_conn_to_string ri) s)
     else
       Logs.info ~src:section (fun fmt ->
-        fmt "IP: %s does not match %s" (Ocsigen_request.remote_ip ri) s);
+        fmt "IP: %s does not match %s"
+          (Ocsigen_request.client_conn_to_string ri)
+          s);
     r
 
 let port port ri =
@@ -222,22 +224,22 @@ let allow_forward_for_handler ?(check_equal_ip = false) () =
             let last_proxy = List.last proxies in
             let proxy_ip = Ipaddr.of_string_exn last_proxy in
             let equal_ip =
-              match Ocsigen_request.remote_ip_parsed request_info with
-              | `Ip r_ip -> Ipaddr.compare proxy_ip r_ip = 0
-              | `Unix _ -> false
+              match Ocsigen_request.client_conn request_info with
+              | `Inet (r_ip, _) -> Ipaddr.compare proxy_ip r_ip = 0
+              | _ -> false
             in
             if equal_ip || not check_equal_ip
             then
               { request with
                 Ocsigen_extensions.request_info =
                   Ocsigen_request.update ~forward_ip:proxies
-                    ~remote_ip:original_ip request_info }
+                    ~client_conn:(`Forwarded_for original_ip) request_info }
             else (
               (* the announced ip of the proxy is not its real ip *)
               Logs.warn ~src:section (fun fmt ->
                 fmt
                   "X-Forwarded-For: host ip (%s) does not match the header (%s)"
-                  (Ocsigen_request.remote_ip request_info)
+                  (Ocsigen_request.client_conn_to_string request_info)
                   header);
               request)
         | _ ->

src/extensions/revproxy.ml

@@ -109,7 +109,7 @@ let gen dir = function
                        (Ocsigen_request.address request_info)
                    in
                    String.concat ", "
-                     (Ocsigen_request.remote_ip request_info
+                     (Ocsigen_request.client_conn_to_string request_info
                       :: Ocsigen_request.forward_ip request_info
                      @ [address])
                  in

src/server/ocsigen_cohttp.ml

@@ -57,13 +57,13 @@ end
 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 getsockname = function
-    | `TCP (ip, _) | `TLS (_, `TCP (ip, _)) -> Ipaddr.to_string ip
+  let client_conn =
+    match edn with
+    | `TCP (ip, port) | `TLS (_, `TCP (ip, port)) -> `Inet (ip, port)
     | `Unix_domain_socket path | `TLS (_, `Unix_domain_socket path) ->
-        "unix://" ^ path
-    | _ -> "unknown"
+        `Unix path
+    | _ -> `Unknown
   in
-  let sockaddr = getsockname edn in
   let connection_closed =
     try fst (Hashtbl.find connections conn)
     with Not_found ->
@@ -108,7 +108,7 @@ let handler ~ssl ~address ~port ~connector (flow, conn) request body =
   in
   (* TODO: equivalent of Ocsigen_range *)
   let request =
-    Ocsigen_request.make ~address ~port ~ssl ~filenames ~sockaddr ~body
+    Ocsigen_request.make ~address ~port ~ssl ~filenames ~client_conn ~body
       ~connection_closed request
   in
   Lwt.finalize
@@ -118,7 +118,7 @@ let handler ~ssl ~address ~port ~connector (flow, conn) request body =
             (match Ocsigen_request.host request with
             | None -> "<host not specified in the request>"
             | Some h -> h)
-            (Ocsigen_request.remote_ip request)
+            (Ocsigen_request.client_conn_to_string request)
             (Option.value ~default:""
                (Ocsigen_request.header request Ocsigen_header.Name.user_agent))
             (Option.fold ~none:""

src/server/ocsigen_multipart.ml

@@ -365,10 +365,10 @@ let post_params ~content_type body_gen =
   match String.lowercase_ascii ct, String.lowercase_ascii cst with
   | "application", "x-www-form-urlencoded" ->
       Some
-        (body_gen |> Cohttp_lwt.Body.to_stream |> Ocsigen_stream.of_lwt_stream
+        (body_gen |> Ocsigen_stream.of_cohttp_body
        |> post_params_form_urlencoded)
   | "multipart", "form-data" ->
       Some
-        (body_gen |> Cohttp_lwt.Body.to_stream |> Ocsigen_stream.of_lwt_stream
+        (body_gen |> Ocsigen_stream.of_cohttp_body
         |> post_params_multipart_form_data ctparams)
   | _ -> None

src/server/ocsigen_request.ml

@@ -48,12 +48,18 @@ let make_uri u =
   and u_get_params_flat = lazy (flatten_get_params (Lazy.force u_get_params)) in
   {u_uri; u_get_params; u_get_params_flat; u_path; u_path_string}
 
+type client_conn =
+  [ `Inet of Ipaddr.t * int
+  | `Unix of string
+  | `Forwarded_for of string
+  | `Unknown ]
+
 type t =
   { r_address : Ocsigen_config.Socket_type.t
   ; r_port : int
   ; r_ssl : bool
   ; r_filenames : string list ref
-  ; r_remote_ip : string
+  ; r_client_conn : client_conn
   ; r_forward_ip : string list
   ; r_uri : uri
   ; r_meth : Cohttp.Code.meth
@@ -79,7 +85,7 @@ let make
       ~port
       ~ssl
       ~filenames
-      ~sockaddr
+      ~client_conn
       ~body
       ~connection_closed
       request
@@ -88,7 +94,7 @@ let make
   ; r_port = port
   ; r_ssl = ssl
   ; r_filenames = filenames
-  ; r_remote_ip = sockaddr
+  ; r_client_conn = client_conn
   ; r_forward_ip = forward_ip
   ; r_uri = make_uri (Cohttp.Request.uri request)
   ; r_encoding = Cohttp.Request.encoding request
@@ -110,7 +116,7 @@ let path {r_uri = {u_path; _}; _} = Lazy.force u_path
 let update
       ?ssl
       ?forward_ip
-      ?remote_ip
+      ?client_conn
       ?sub_path
       ?meth
       ?get_params_flat
@@ -122,7 +128,7 @@ let update
        ; r_uri = {u_uri; _} as r_uri
        ; r_meth
        ; r_forward_ip
-       ; r_remote_ip
+       ; r_client_conn
        ; r_cookies_override
        ; r_body
        ; r_sub_path
@@ -132,8 +138,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 =
-    match remote_ip with Some remote_ip -> remote_ip | None -> r_remote_ip
+  and r_client_conn =
+    match client_conn with Some c -> c | None -> r_client_conn
   and r_sub_path = match sub_path with Some _ -> sub_path | None -> r_sub_path
   and r_body =
     match post_data with
@@ -171,7 +177,7 @@ let update
   ; r_uri
   ; r_meth
   ; r_forward_ip
-  ; r_remote_ip
+  ; r_client_conn
   ; r_body
   ; r_cookies_override
   ; r_sub_path
@@ -270,18 +276,14 @@ 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 client_conn {r_client_conn = c; _} = c
 
-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 client_conn_to_string {r_client_conn = c; _} =
+  match c with
+  | `Inet (ip, _) -> Ipaddr.to_string ip
+  | `Unix path -> "unix:" ^ path
+  | `Forwarded_for ip -> "forwarded:" ^ ip
+  | `Unknown -> "unknown"
 
 let forward_ip {r_forward_ip; _} = r_forward_ip
 let request_cache {r_request_cache; _} = r_request_cache

src/server/ocsigen_request.mli

@@ -9,6 +9,15 @@ type file_info = Ocsigen_multipart.file_info =
 
 type post_data = (string * string) list * (string * file_info) list
 
+type client_conn =
+  [ `Inet of Ipaddr.t * int
+  | `Unix of string
+  | `Forwarded_for of string
+  | `Unknown ]
+(** Type of connection used by the client. [`Inet] means the client connected
+    through the Internet. [`Forwarded_for] means that the client connected
+    through a proxy and carries the IP address reported in the HTTP headers. *)
+
 val make :
    ?forward_ip:string list
   -> ?sub_path:string
@@ -19,7 +28,7 @@ val make :
   -> port:int
   -> ssl:bool
   -> filenames:string list ref
-  -> sockaddr:string
+  -> client_conn:client_conn
   -> body:Cohttp_lwt.Body.t
   -> connection_closed:unit Lwt.t
   -> Cohttp.Request.t
@@ -28,7 +37,7 @@ val make :
 val update :
    ?ssl:bool
   -> ?forward_ip:string list
-  -> ?remote_ip:string
+  -> ?client_conn:client_conn
   -> ?sub_path:string
   -> ?meth:Cohttp.Code.meth
   -> ?get_params_flat:(string * string) list
@@ -74,8 +83,13 @@ val post_params :
   -> Int64.t option
   -> (string * string) list Lwt.t option
 
-val remote_ip : t -> string
-val remote_ip_parsed : t -> [`Ip of Ipaddr.t | `Unix of string]
+val client_conn : t -> client_conn
+(** The way the client connects to the server (for example, its IP address if
+    connected over the internet). *)
+
+val client_conn_to_string : t -> string
+(** A textual representation of [client_conn] suitable for use in logs. *)
+
 val forward_ip : t -> string list
 val content_type : t -> content_type option
 val request_cache : t -> Polytables.t

test/extensions/deflatemod.t/run.t

@@ -1,14 +1,14 @@
   $ source ../../server-test-helpers.sh
   $ run_server ./test.exe
   ocsigen:main: [WARNING] Command pipe created
-  ocsigen:access:  connection for local-test from unix:// (): /index.html
+  ocsigen:access:  connection for local-test from unix: (): /index.html
   ocsigen:ext: [INFO] host found! local-test:0 matches .* 
   ocsigen:ext:staticmod: [INFO] Is it a static file?
   ocsigen:local-file: [INFO] Testing "./index.html".
   ocsigen:local-file: [INFO] checking if file index.html can be sent
   ocsigen:ext: [INFO] Compiling exclusion regexp $^
   ocsigen:local-file: [INFO] Returning "./index.html".
-  ocsigen:access:  connection for local-test from unix:// (): /index.html
+  ocsigen:access:  connection for local-test from unix: (): /index.html
   ocsigen:ext: [INFO] host found! local-test:0 matches .* 
   ocsigen:ext:staticmod: [INFO] Is it a static file?
   ocsigen:local-file: [INFO] Testing "./index.html".