Shell/RPC: enforce Host when using CORS.

This commit is contained in:
Grégoire Henry 2018-06-06 21:16:32 +02:00
parent e9eac31e9a
commit 24686ae8f2
No known key found for this signature in database
GPG Key ID: 50D984F20BD445D2
3 changed files with 15 additions and 2 deletions

View File

@ -67,3 +67,11 @@ let add_headers headers cors origin_header =
Cohttp.Header.add_multi headers Cohttp.Header.add_multi headers
"Access-Control-Allow-Headers" cors.allowed_headers in "Access-Control-Allow-Headers" cors.allowed_headers in
add_allow_origin cors_headers cors origin_header 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

View File

@ -36,3 +36,4 @@ val add_allow_origin:
val add_headers: val add_headers:
Cohttp.Header.t -> t -> string option -> Cohttp.Header.t Cohttp.Header.t -> t -> string option -> Cohttp.Header.t
val check_host: Cohttp.Header.t -> t -> bool

View File

@ -86,8 +86,7 @@ module Make (Encoding : Resto.ENCODING)(Log : LOGGING) = struct
| Ok x -> f x | Ok x -> f x
| Error err -> Lwt.return_error err | Error err -> Lwt.return_error err
let callback server (_io, con) req body = let callback server ((_io, con) : Cohttp_lwt_unix.Server.conn) req body =
(* FIXME: check inbound adress *)
let uri = Request.uri req in let uri = Request.uri req in
let path = Uri.pct_decode (Uri.path uri) in let path = Uri.pct_decode (Uri.path uri) in
lwt_log_info "(%s) receive request to %s" 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 let req_headers = Request.headers req in
begin begin
match Request.meth req with 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 | #Resto.meth as meth -> begin
Directory.lookup server.root () Directory.lookup server.root ()
meth path >>=? fun (Directory.Service s) -> meth path >>=? fun (Directory.Service s) ->