From f26dfdbe8ed4462d9ba4e0aa849bdbb6252ae8d1 Mon Sep 17 00:00:00 2001 From: Benjamin Canou Date: Sat, 8 Apr 2017 16:09:40 +0200 Subject: [PATCH] RPC: fix CORS preflight. --- src/minutils/RPC.ml | 8 +-- src/node/net/RPC_server.ml | 134 ++++++++++++++++++++++++------------- 2 files changed, 90 insertions(+), 52 deletions(-) diff --git a/src/minutils/RPC.ml b/src/minutils/RPC.ml index ea58839e2..95b0ec917 100644 --- a/src/minutils/RPC.ml +++ b/src/minutils/RPC.ml @@ -108,11 +108,11 @@ module Answer = struct end -type step = +type step = RestoDirectory.step = | Static of string | Dynamic of Arg.descr -type conflict = +type conflict = RestoDirectory.conflict = | CService | CDir | CBuilder @@ -120,8 +120,8 @@ type conflict = | CTypes of Arg.descr * Arg.descr | CType of Arg.descr * string list -exception Conflict of step list * conflict -exception Cannot_parse of Arg.descr * string * string list +exception Conflict = RestoDirectory.Conflict +exception Cannot_parse = RestoDirectory.Cannot_parse (* Dispatch *) diff --git a/src/node/net/RPC_server.ml b/src/node/net/RPC_server.ml index 97a4229df..8535339cf 100644 --- a/src/node/net/RPC_server.ml +++ b/src/node/net/RPC_server.ml @@ -18,7 +18,6 @@ type server = (* hidden *) module ConnectionMap = Map.Make(Cohttp.Connection) exception Invalid_method -exception Options_preflight exception Cannot_parse_body of string let check_origin_matches origin allowed_origin = @@ -119,46 +118,91 @@ let launch ?pre_hook ?post_hook ?(host="::") mode root cors_allowed_origins cors | Some res -> Lwt.return res | None -> - lookup root ~meth:req.meth () path >>= fun handler -> - begin - match req.meth with - | `POST - | `PUT - | `PATCH - | `DELETE -> begin - Cohttp_lwt_body.to_string body >>= fun body -> - match Data_encoding_ezjsonm.from_string body with - | Error msg -> Lwt.fail (Cannot_parse_body msg) - | Ok body -> Lwt.return (Some body) - end - | `GET - | `HEAD -> Lwt.return None - | `OPTIONS -> Lwt.fail Options_preflight - | _ -> Lwt.fail Invalid_method - end >>= fun body -> - handler body >>= fun { Answer.code ; body } -> - let body = match body with - | Empty -> - Cohttp_lwt_body.empty - | Single json -> - Cohttp_lwt_body.of_string (Data_encoding_ezjsonm.to_string json) - | Stream s -> - let stream = - create_stream io con Data_encoding_ezjsonm.to_string s in - Cohttp_lwt_body.of_stream stream in - lwt_log_info "(%s) RPC %s" - (Cohttp.Connection.to_string con) - (if Cohttp.Code.is_error code - then "failed" - else "success") >>= fun () -> - let headers = - Cohttp.Header.init_with "Content-Type" "application/json" in - let headers = - make_cors_headers ~headers - cors_allowed_headers cors_allowed_origins origin_header - in - Lwt.return (Response.make - ~flush:true ~status:(`Code code) ~headers (), body)) + Lwt.catch + (fun () -> + 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 + (* 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 + | `PUT + | `PATCH + | `DELETE -> begin + Cohttp_lwt_body.to_string body >>= fun body -> + match Data_encoding_ezjsonm.from_string body with + | Error msg -> Lwt.fail (Cannot_parse_body msg) + | Ok body -> Lwt.return (Some body) + end + | `GET + | `HEAD + | `OPTIONS -> Lwt.return None + | _ -> Lwt.fail Invalid_method + end >>= fun body -> + handler body >>= fun { Answer.code ; body } -> + let body = match body with + | Empty -> + Cohttp_lwt_body.empty + | Single json -> + Cohttp_lwt_body.of_string (Data_encoding_ezjsonm.to_string json) + | Stream s -> + let stream = + create_stream io con Data_encoding_ezjsonm.to_string s in + Cohttp_lwt_body.of_stream stream in + lwt_log_info "(%s) RPC %s" + (Cohttp.Connection.to_string con) + (if Cohttp.Code.is_error code + then "failed" + else "success") >>= fun () -> + let headers = + Cohttp.Header.init_with "Content-Type" "application/json" in + let headers = + make_cors_headers ~headers + cors_allowed_headers cors_allowed_origins origin_header + in + Lwt.return (Response.make + ~flush:true ~status:(`Code code) ~headers (), body)) (function | Not_found | Cannot_parse _ -> lwt_log_info "(%s) not found" @@ -184,12 +228,6 @@ let launch ?pre_hook ?post_hook ?(host="::") mode root cors_allowed_origins cors (Cohttp.Connection.to_string con) >>= fun () -> Lwt.return (Response.make ~flush:true ~status:`Bad_request (), 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) and conn_closed (_, con) = log_info "connection closed %s" (Cohttp.Connection.to_string con) ; @@ -200,7 +238,7 @@ let launch ?pre_hook ?post_hook ?(host="::") mode root cors_allowed_origins cors let on_exn = function | Unix.Unix_error (Unix.EADDRINUSE, "bind", _) -> log_error "RPC server port already taken, \ - the node will be shutdown" ; + the node will be shutdown" ; Lwt_exit.exit 1 | Unix.Unix_error (ECONNRESET, _, _) | Unix.Unix_error (EPIPE, _, _) -> ()