RPC: fix CORS preflight.
This commit is contained in:
parent
9628ff0c2d
commit
f26dfdbe8e
@ -108,11 +108,11 @@ module Answer = struct
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
type step =
|
type step = RestoDirectory.step =
|
||||||
| Static of string
|
| Static of string
|
||||||
| Dynamic of Arg.descr
|
| Dynamic of Arg.descr
|
||||||
|
|
||||||
type conflict =
|
type conflict = RestoDirectory.conflict =
|
||||||
| CService
|
| CService
|
||||||
| CDir
|
| CDir
|
||||||
| CBuilder
|
| CBuilder
|
||||||
@ -120,8 +120,8 @@ type conflict =
|
|||||||
| CTypes of Arg.descr * Arg.descr
|
| CTypes of Arg.descr * Arg.descr
|
||||||
| CType of Arg.descr * string list
|
| CType of Arg.descr * string list
|
||||||
|
|
||||||
exception Conflict of step list * conflict
|
exception Conflict = RestoDirectory.Conflict
|
||||||
exception Cannot_parse of Arg.descr * string * string list
|
exception Cannot_parse = RestoDirectory.Cannot_parse
|
||||||
|
|
||||||
(* Dispatch *)
|
(* Dispatch *)
|
||||||
|
|
||||||
|
@ -18,7 +18,6 @@ type server = (* hidden *)
|
|||||||
module ConnectionMap = Map.Make(Cohttp.Connection)
|
module ConnectionMap = Map.Make(Cohttp.Connection)
|
||||||
|
|
||||||
exception Invalid_method
|
exception Invalid_method
|
||||||
exception Options_preflight
|
|
||||||
exception Cannot_parse_body of string
|
exception Cannot_parse_body of string
|
||||||
|
|
||||||
let check_origin_matches origin allowed_origin =
|
let check_origin_matches origin allowed_origin =
|
||||||
@ -119,9 +118,54 @@ let launch ?pre_hook ?post_hook ?(host="::") mode root cors_allowed_origins cors
|
|||||||
| Some res ->
|
| Some res ->
|
||||||
Lwt.return res
|
Lwt.return res
|
||||||
| None ->
|
| None ->
|
||||||
|
Lwt.catch
|
||||||
|
(fun () ->
|
||||||
lookup root ~meth:req.meth () path >>= fun handler ->
|
lookup root ~meth:req.meth () path >>= fun handler ->
|
||||||
|
Lwt.return_some handler)
|
||||||
|
(function Not_found -> Lwt.return_none
|
||||||
|
| exn -> Lwt.fail exn) >>= function
|
||||||
|
| None ->
|
||||||
begin
|
begin
|
||||||
match req.meth with
|
(* Default OPTIONS handler for CORS preflight *)
|
||||||
|
if req.meth = `OPTIONS && origin_header <> None then
|
||||||
|
match Cohttp.Header.get req_headers
|
||||||
|
"Access-Control-Request-Method" with
|
||||||
|
| Some meth ->
|
||||||
|
let meth = Cohttp.Code.method_of_string meth in
|
||||||
|
lookup root ~meth () path >>= fun _handler ->
|
||||||
|
(* unless [lookup] failed with [Not_found] -> 404 *)
|
||||||
|
Lwt.return [ meth ]
|
||||||
|
| None ->
|
||||||
|
let supported_meths =
|
||||||
|
[ `POST ; `PUT ; `PATCH ; `DELETE ; `GET ; `HEAD ] in
|
||||||
|
Lwt_list.filter_map_p
|
||||||
|
(fun meth ->
|
||||||
|
Lwt.catch
|
||||||
|
(fun () ->
|
||||||
|
lookup root ~meth () path >>= fun _handler ->
|
||||||
|
Lwt.return_some meth)
|
||||||
|
(function Not_found -> Lwt.return_none
|
||||||
|
| exn -> Lwt.fail exn))
|
||||||
|
supported_meths >>= function
|
||||||
|
| [] -> Lwt.fail Not_found (* No handler -> 404 *)
|
||||||
|
| meths -> Lwt.return meths
|
||||||
|
else Lwt.fail Not_found
|
||||||
|
end >>= fun cors_allowed_meths ->
|
||||||
|
lwt_log_info "(%s) RPC preflight"
|
||||||
|
(Cohttp.Connection.to_string con) >>= fun () ->
|
||||||
|
let headers =
|
||||||
|
Cohttp.Header.add
|
||||||
|
(Cohttp.Header.init ())
|
||||||
|
"Access-Control-Allow-Methods"
|
||||||
|
(String.concat ", "
|
||||||
|
(List.map Cohttp.Code.string_of_method cors_allowed_meths)) in
|
||||||
|
let headers =
|
||||||
|
make_cors_headers ~headers
|
||||||
|
cors_allowed_headers cors_allowed_origins origin_header in
|
||||||
|
Lwt.return (Response.make ~flush:true ~status:(`Code 200) ~headers (),
|
||||||
|
Cohttp_lwt_body.empty)
|
||||||
|
| Some handler ->
|
||||||
|
begin match req.meth with
|
||||||
| `POST
|
| `POST
|
||||||
| `PUT
|
| `PUT
|
||||||
| `PATCH
|
| `PATCH
|
||||||
@ -132,8 +176,8 @@ let launch ?pre_hook ?post_hook ?(host="::") mode root cors_allowed_origins cors
|
|||||||
| Ok body -> Lwt.return (Some body)
|
| Ok body -> Lwt.return (Some body)
|
||||||
end
|
end
|
||||||
| `GET
|
| `GET
|
||||||
| `HEAD -> Lwt.return None
|
| `HEAD
|
||||||
| `OPTIONS -> Lwt.fail Options_preflight
|
| `OPTIONS -> Lwt.return None
|
||||||
| _ -> Lwt.fail Invalid_method
|
| _ -> Lwt.fail Invalid_method
|
||||||
end >>= fun body ->
|
end >>= fun body ->
|
||||||
handler body >>= fun { Answer.code ; body } ->
|
handler body >>= fun { Answer.code ; body } ->
|
||||||
@ -184,12 +228,6 @@ let launch ?pre_hook ?post_hook ?(host="::") mode root cors_allowed_origins cors
|
|||||||
(Cohttp.Connection.to_string con) >>= fun () ->
|
(Cohttp.Connection.to_string con) >>= fun () ->
|
||||||
Lwt.return (Response.make ~flush:true ~status:`Bad_request (),
|
Lwt.return (Response.make ~flush:true ~status:`Bad_request (),
|
||||||
Cohttp_lwt_body.of_string msg)
|
Cohttp_lwt_body.of_string msg)
|
||||||
| Options_preflight ->
|
|
||||||
lwt_log_info "(%s) RPC preflight"
|
|
||||||
(Cohttp.Connection.to_string con) >>= fun () ->
|
|
||||||
let headers = make_cors_headers cors_allowed_headers cors_allowed_origins origin_header in
|
|
||||||
Lwt.return (Response.make ~flush:true ~status:(`Code 200) ~headers (),
|
|
||||||
Cohttp_lwt_body.empty)
|
|
||||||
| e -> Lwt.fail e)
|
| e -> Lwt.fail e)
|
||||||
and conn_closed (_, con) =
|
and conn_closed (_, con) =
|
||||||
log_info "connection closed %s" (Cohttp.Connection.to_string con) ;
|
log_info "connection closed %s" (Cohttp.Connection.to_string con) ;
|
||||||
|
Loading…
Reference in New Issue
Block a user