Commit 24686ae8 authored by Grégoire Henry's avatar Grégoire Henry

Shell/RPC: enforce `Host` when using CORS.

parent e9eac31e
......@@ -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
......@@ -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
......@@ -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) ->
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment