From 24686ae8f2cfc158e342378e9238b4a124fe8adf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= <gregoire.henry@tezos.com>
Date: Wed, 6 Jun 2018 21:16:32 +0200
Subject: [PATCH] Shell/RPC: enforce `Host` when using CORS.

---
 vendors/ocplib-resto/lib_resto-cohttp/cors.ml   | 8 ++++++++
 vendors/ocplib-resto/lib_resto-cohttp/cors.mli  | 1 +
 vendors/ocplib-resto/lib_resto-cohttp/server.ml | 8 ++++++--
 3 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/vendors/ocplib-resto/lib_resto-cohttp/cors.ml b/vendors/ocplib-resto/lib_resto-cohttp/cors.ml
index 14fff5619..fcd313956 100644
--- a/vendors/ocplib-resto/lib_resto-cohttp/cors.ml
+++ b/vendors/ocplib-resto/lib_resto-cohttp/cors.ml
@@ -67,3 +67,11 @@ let add_headers headers cors origin_header =
     Cohttp.Header.add_multi headers
       "Access-Control-Allow-Headers" cors.allowed_headers in
   add_allow_origin cors_headers cors origin_header
+
+let check_host headers cors =
+  match Cohttp.Header.get headers "Host" with
+  | None -> List.mem "*" cors.allowed_origins
+  | Some host ->
+      match find_matching_origin cors.allowed_origins host with
+      | None -> false
+      | Some _ -> true
diff --git a/vendors/ocplib-resto/lib_resto-cohttp/cors.mli b/vendors/ocplib-resto/lib_resto-cohttp/cors.mli
index 93a6c4821..f8d8c067f 100644
--- a/vendors/ocplib-resto/lib_resto-cohttp/cors.mli
+++ b/vendors/ocplib-resto/lib_resto-cohttp/cors.mli
@@ -36,3 +36,4 @@ val add_allow_origin:
 val add_headers:
   Cohttp.Header.t -> t -> string option -> Cohttp.Header.t
 
+val check_host: Cohttp.Header.t -> t -> bool
diff --git a/vendors/ocplib-resto/lib_resto-cohttp/server.ml b/vendors/ocplib-resto/lib_resto-cohttp/server.ml
index be129e0a4..1828c78a9 100644
--- a/vendors/ocplib-resto/lib_resto-cohttp/server.ml
+++ b/vendors/ocplib-resto/lib_resto-cohttp/server.ml
@@ -86,8 +86,7 @@ module Make (Encoding : Resto.ENCODING)(Log : LOGGING) = struct
     | Ok x -> f x
     | Error err -> Lwt.return_error err
 
-  let callback server (_io, con) req body =
-    (* FIXME: check inbound adress *)
+  let callback server ((_io, con) : Cohttp_lwt_unix.Server.conn) req body =
     let uri = Request.uri req in
     let path = Uri.pct_decode (Uri.path uri) in
     lwt_log_info "(%s) receive request to %s"
@@ -96,6 +95,11 @@ module Make (Encoding : Resto.ENCODING)(Log : LOGGING) = struct
     let req_headers = Request.headers req in
     begin
       match Request.meth req with
+      | #Resto.meth when server.cors.allowed_origins <> [] &&
+                         not (Cors.check_host req_headers server.cors) ->
+          Lwt.return_ok
+            (Response.make ~status:`Forbidden (),
+             Cohttp_lwt.Body.empty)
       | #Resto.meth as meth -> begin
           Directory.lookup server.root ()
             meth path >>=? fun (Directory.Service s) ->