From ef47753b8e4d8d2045a45b85376bfe9a546e3fc7 Mon Sep 17 00:00:00 2001 From: Maxime Levillain Date: Tue, 1 Oct 2024 12:00:17 +0200 Subject: [PATCH] cors options in implementations --- src/server/cohttp/ezAPIServerCohttp.ml | 6 ++++-- src/server/ezAPIServerUtils.ml | 4 ++-- src/server/httpaf/ezAPIServerHttpAf.ml | 6 ++++-- src/server/virtual/ezServer.mli | 8 ++++++-- 4 files changed, 16 insertions(+), 8 deletions(-) diff --git a/src/server/cohttp/ezAPIServerCohttp.ml b/src/server/cohttp/ezAPIServerCohttp.ml index 5f1d98d..7d653ae 100644 --- a/src/server/cohttp/ezAPIServerCohttp.ml +++ b/src/server/cohttp/ezAPIServerCohttp.ml @@ -116,5 +116,7 @@ let create_server ?catch ?allow_origin ?allow_headers ?allow_methods ~mode:(`TCP (`Port server_port)) (Server.make_response_action ~callback ()) -let server ?catch servers = - Lwt.join (List.map (fun (port,kind) -> create_server ?catch port kind) servers) +let server ?catch ?allow_origin ?allow_headers ?allow_methods ?allow_credentials servers = + Lwt.join (List.map (fun (port,kind) -> + create_server ?catch ?allow_origin ?allow_headers ?allow_methods ?allow_credentials + port kind) servers) diff --git a/src/server/ezAPIServerUtils.ml b/src/server/ezAPIServerUtils.ml index 543e56d..2798255 100644 --- a/src/server/ezAPIServerUtils.ml +++ b/src/server/ezAPIServerUtils.ml @@ -151,12 +151,12 @@ let handle ?meth ?content_type ?ws s r path body = | Some ws -> ws ?onclose ?step ~react ~bg r.Req.req_id end >|= fun ra -> `ws ra +type allow_kind_without_none = [ `all | `default | `custom of string list ] type allow_kind = [ `all | `default | `custom of string list ] -type allow_kind_with_none = [ `all | `default | `custom of string list ] let merge_headers_allow ~dft ~key headers = function | `none -> headers - | #allow_kind as k -> + | #allow_kind_without_none as k -> let v old = match k, old with | `all, _ -> "*" diff --git a/src/server/httpaf/ezAPIServerHttpAf.ml b/src/server/httpaf/ezAPIServerHttpAf.ml index bac05a8..91a5212 100644 --- a/src/server/httpaf/ezAPIServerHttpAf.ml +++ b/src/server/httpaf/ezAPIServerHttpAf.ml @@ -322,10 +322,12 @@ let create_server ?catch ?allow_origin ?allow_headers ?allow_methods ?allow_cred ?allow_credentials s sockaddr fd) >>= fun _server -> Lwt.return_unit -let server ?catch servers = +let server ?catch ?allow_origin ?allow_headers ?allow_methods ?allow_credentials servers = let max_connections = let n = List.length servers in if n = 0 then 0 else limit_open_file () / 2 / n in let waiter = fst @@ Lwt.wait () in - Lwt.join (List.map (fun (port,kind) -> create_server ?catch ~max_connections port kind) servers) >>= fun () -> + Lwt.join (List.map (fun (port,kind) -> + create_server ?catch ?allow_origin ?allow_headers ?allow_methods + ?allow_credentials ~max_connections port kind) servers) >>= fun () -> waiter (* keep the server running *) diff --git a/src/server/virtual/ezServer.mli b/src/server/virtual/ezServer.mli index 374e85e..dd96740 100644 --- a/src/server/virtual/ezServer.mli +++ b/src/server/virtual/ezServer.mli @@ -8,7 +8,11 @@ (* *) (**************************************************************************) -val server : ?catch:(string -> exn -> string EzAPIServerUtils.Answer.t Lwt.t) -> - (int * EzAPIServerUtils.server_kind) list -> unit Lwt.t +open EzAPIServerUtils + +val server : ?catch:(string -> exn -> string Answer.t Lwt.t) -> + ?allow_origin:[ allow_kind | `origin ] -> ?allow_headers:allow_kind -> + ?allow_methods:allow_kind -> ?allow_credentials:bool -> + (int * server_kind) list -> unit Lwt.t val set_debug : unit -> unit