From 37b7b5a1bf3ea31794e8f9e44e55b7be65495726 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Wed, 22 May 2024 22:01:27 +0200 Subject: [PATCH] Static linking: Add optional parameter ?app to Eliom_service.create and others --- src/lib/eliom_common.client.ml | 2 +- src/lib/eliom_common.server.ml | 4 ++-- src/lib/eliom_common.server.mli | 10 +++++---- src/lib/eliom_service.server.ml | 14 +++++++----- src/lib/eliom_service.server.mli | 14 +++++++++--- src/lib/eliom_service_base.eliom | 32 ++++++++++++++------------- src/lib/eliom_service_sigs.shared.mli | 15 ++++++++----- 7 files changed, 55 insertions(+), 36 deletions(-) diff --git a/src/lib/eliom_common.client.ml b/src/lib/eliom_common.client.ml index 4f606702c..a8181bab8 100644 --- a/src/lib/eliom_common.client.ml +++ b/src/lib/eliom_common.client.ml @@ -72,7 +72,7 @@ let client_html_file, set_client_html_file = assert !is_client_app; r := s ) -let defer get f = +let defer ?app:(_ : string option) get f = let r = ref None in (match get () with | Some v -> r := Some (f v) diff --git a/src/lib/eliom_common.server.ml b/src/lib/eliom_common.server.ml index 8586f197d..8b14634a0 100644 --- a/src/lib/eliom_common.server.ml +++ b/src/lib/eliom_common.server.ml @@ -1454,12 +1454,12 @@ let default_app_name = "__eliom_default_app__" let current_app_name = ref default_app_name let get_app_name () = !current_app_name -let defer get f = +let defer ?(app = get_app_name ()) get f = let r = ref None in (match get () with | Some v -> r := Some (f v) | None -> - Ocsigen_loader.add_module_init_function (get_app_name ()) (fun () -> + Ocsigen_loader.add_module_init_function app (fun () -> match get () with | Some v -> r := Some (f v) | None -> raise (Eliom_site_information_not_available "defer"))); diff --git a/src/lib/eliom_common.server.mli b/src/lib/eliom_common.server.mli index 0c628984a..b12d913ce 100644 --- a/src/lib/eliom_common.server.mli +++ b/src/lib/eliom_common.server.mli @@ -754,7 +754,7 @@ module To_and_of_shared : sig val to_and_of : 'a t -> 'a to_and_of end -(*/*) +(**/**) val client_html_file : unit -> string (** Raises exception on server, only relevant for client apps *) @@ -763,9 +763,11 @@ val default_app_name : string val current_app_name : string ref val get_app_name : unit -> string -val defer : (unit -> 'a option) -> ('a -> 'b) -> 'b option ref -(** [defer get f] returns a reference to [Some (f v)] if [get ()] +val defer : ?app:string -> (unit -> 'a option) -> ('a -> 'b) -> 'b option ref +(** [defer ?app get f] returns a reference to [Some (f v)] if [get ()] return [Some v]. If not, it returns a reference to [None] and registers a deferred computation to update the value of the reference - when [site_dir] is known *) + when [site_dir] is known and [Eliom.run] is called. + If [~app] is present, the computation will be executed when + [Eliom.run ~app ()] is called, otherwise [current_app_name] is used. *) diff --git a/src/lib/eliom_service.server.ml b/src/lib/eliom_service.server.ml index ef9747553..86128c0d1 100644 --- a/src/lib/eliom_service.server.ml +++ b/src/lib/eliom_service.server.ml @@ -19,7 +19,7 @@ include Eliom_service_base -let plain_service (type m gp gn pp pn gp') ?(https = false) ~path +let plain_service (type m gp gn pp pn gp') ?app ?(https = false) ~path ?keep_nl_params ?priority ~(meth : (m, gp, gn, pp, pn, _, gp') meth) () = let get_params, post_params = params_of_meth meth @@ -40,8 +40,9 @@ let plain_service (type m gp gn pp pn gp') ?(https = false) ~path | None -> raise (Eliom_common.Eliom_site_information_not_available "service")); let reload_fun = Rf_client_fun in - main_service ~https ~prefix:"" ~path ~kind:`Service ~meth ?redirect_suffix - ?keep_nl_params ?priority ~get_params ~post_params ~reload_fun () + main_service ?app ~https ~prefix:"" ~path ~kind:`Service ~meth + ?redirect_suffix ?keep_nl_params ?priority ~get_params ~post_params + ~reload_fun () let create_attached ?name ?(csrf_safe = false) ?csrf_scope ?csrf_secure ?max_use ?timeout ?(https = false) ?keep_nl_params ~fallback ~get_params ~post_params @@ -150,15 +151,16 @@ let coservice' (type m gp gn pp pn) ?name ?(csrf_safe = false) ?csrf_scope ; client_fun = no_client_fun () ; reload_fun = Rf_client_fun } -let create ?name ?(csrf_safe = false) ?csrf_scope ?csrf_secure ?max_use ?timeout - ?(https = false) ?(keep_nl_params = `Persistent) ?priority +let create ?app ?name ?(csrf_safe = false) ?csrf_scope ?csrf_secure ?max_use + ?timeout ?(https = false) ?(keep_nl_params = `Persistent) ?priority (type m gp gn pp pn gp' att_ co_ ext_ reg_ rr) ~(meth : (m, gp, gn, pp, pn, _, gp') meth) ~(path : (att_, co_, gp') path_option) () : (gp, pp, m, att_, co_, ext_, reg_, _, gn, pn, rr) t = match path with - | Path path -> plain_service ~https ~keep_nl_params ?priority ~path ~meth () + | Path path -> + plain_service ?app ~https ~keep_nl_params ?priority ~path ~meth () | No_path -> coservice' ?name ~csrf_safe ?csrf_scope ?csrf_secure ?max_use ?timeout ~https ~keep_nl_params ~meth () diff --git a/src/lib/eliom_service.server.mli b/src/lib/eliom_service.server.mli index 5d3db5a68..40caaf9c3 100644 --- a/src/lib/eliom_service.server.mli +++ b/src/lib/eliom_service.server.mli @@ -28,7 +28,8 @@ include Eliom_service_sigs.S val create : - ?name:string + ?app:string + -> ?name:string -> ?csrf_safe:bool -> ?csrf_scope:[< Eliom_common.user_scope] -> ?csrf_secure:bool @@ -103,6 +104,11 @@ val create : {!Eliom_registration}[.*.register] functions for a description of these arguments. + If [~app] is present, the service will belong to the corresponding app, + which means that it will be available under the site where + [Eliom.run ~app ()] is called. Use this if you don't use a configuation file + and want to be able to have several Eliom apps on different sites. + {e Warning: [create] must be called when the site information is available, that is, either during a request or during the initialisation phase of the site. Otherwise, it will raise the @@ -271,7 +277,8 @@ exception Wrong_session_table_for_CSRF_safe_coservice val eliom_appl_answer_content_type : string val create_ocaml : - ?name:string + ?app:string + -> ?name:string -> ?csrf_safe:bool -> ?csrf_scope:[< Eliom_common.user_scope] -> ?csrf_secure:bool @@ -286,7 +293,8 @@ val create_ocaml : -> ('gp, 'pp, 'm, 'att, 'co, non_ext, reg, 'tipo, 'gn, 'pn, 'ret ocaml) t val create_unsafe : - ?name:string + ?app:string + -> ?name:string -> ?csrf_safe:bool -> ?csrf_scope:[< Eliom_common.user_scope] -> ?csrf_secure:bool diff --git a/src/lib/eliom_service_base.eliom b/src/lib/eliom_service_base.eliom index bfe84a5b3..9d563b945 100644 --- a/src/lib/eliom_service_base.eliom +++ b/src/lib/eliom_service_base.eliom @@ -223,7 +223,7 @@ let change_get_num service attser n = ; info = Attached {attser with get_name = n} } (** Static directories **) -let static_dir_ ?(https = false) () = +let static_dir_ ?app ?(https = false) () = { pre_applied_parameters = Eliom_lib.String.Table.empty, [] ; get_params_type = Eliom_parameter.suffix @@ -238,7 +238,7 @@ let static_dir_ ?(https = false) () = { prefix = "" ; subpath = [""] ; fullpath = - Eliom_common.defer Eliom_request_info.get_site_dir_option + Eliom_common.defer ?app Eliom_request_info.get_site_dir_option (fun site_dir -> site_dir @ [Eliom_common.eliom_suffix_internal_name]) ; get_name = Eliom_common.SAtt_no @@ -254,10 +254,12 @@ let static_dir_ ?(https = false) () = for this service *) reload_fun = Rf_client_fun } -let static_dir () = static_dir_ () -let https_static_dir () = static_dir_ ~https:true () +let static_dir ?app () = static_dir_ ?app () +let https_static_dir ?app () = static_dir_ ?app ~https:true () -let get_static_dir_ ?(https = false) ?(keep_nl_params = `None) ~get_params () = +let get_static_dir_ ?app ?(https = false) ?(keep_nl_params = `None) ~get_params + () + = { pre_applied_parameters = Eliom_lib.String.Table.empty, [] ; get_params_type = Eliom_parameter.suffix_prod @@ -273,7 +275,7 @@ let get_static_dir_ ?(https = false) ?(keep_nl_params = `None) ~get_params () = { prefix = "" ; subpath = [""] ; fullpath = - Eliom_common.defer Eliom_request_info.get_site_dir_option + Eliom_common.defer ?app Eliom_request_info.get_site_dir_option (fun site_dir -> site_dir @ [Eliom_common.eliom_suffix_internal_name]) ; get_name = Eliom_common.SAtt_no @@ -289,11 +291,11 @@ let get_static_dir_ ?(https = false) ?(keep_nl_params = `None) ~get_params () = for this service *) reload_fun = Rf_client_fun } -let static_dir_with_params ?keep_nl_params ~get_params () = - get_static_dir_ ?keep_nl_params ~get_params () +let static_dir_with_params ?app ?keep_nl_params ~get_params () = + get_static_dir_ ?app ?keep_nl_params ~get_params () -let https_static_dir_with_params ?keep_nl_params ~get_params () = - get_static_dir_ ~https:true ?keep_nl_params ~get_params () +let https_static_dir_with_params ?app ?keep_nl_params ~get_params () = + get_static_dir_ ?app ~https:true ?keep_nl_params ~get_params () let send_appl_content s = s.send_appl_content let set_send_appl_content s n = s.send_appl_content <- n @@ -308,7 +310,7 @@ let rec append_suffix l m = | [_eliom_suffix_internal_name] -> m | a :: ll -> a :: append_suffix ll m -let preapply ~service getparams = +let preapply ?app ~service getparams = let nlp, preapp = service.pre_applied_parameters in let suff, nlp, params = Eliom_parameter.construct_params_list_raw nlp service.get_params_type @@ -328,7 +330,7 @@ let preapply ~service getparams = | Some suff -> append_suffix k.subpath suff | _ -> k.subpath) ; fullpath = - Eliom_common.defer + Eliom_common.defer ?app (fun () -> !(k.fullpath)) (fun fp -> match suff with @@ -473,8 +475,8 @@ let%client no_client_fun () : _ ref Eliom_client_value.t option = Some (ref None) (** Create a main service (not a coservice), internal or external *) -let main_service ~https ~prefix ~(path : Url.path) ?force_site_dir ~kind ~meth - ?(redirect_suffix = true) ?(keep_nl_params = `None) +let main_service ?app ~https ~prefix ~(path : Url.path) ?force_site_dir ~kind + ~meth ?(redirect_suffix = true) ?(keep_nl_params = `None) ?(priority = default_priority) ~get_params ~post_params ~reload_fun () = { pre_applied_parameters = Eliom_lib.String.Table.empty, [] @@ -492,7 +494,7 @@ let main_service ~https ~prefix ~(path : Url.path) ?force_site_dir ~kind ~meth (match force_site_dir with | Some site_dir -> ref (Some (site_dir @ path)) | None -> - Eliom_common.defer Eliom_request_info.get_site_dir_option + Eliom_common.defer ?app Eliom_request_info.get_site_dir_option (fun site_dir -> site_dir @ path)) ; get_name = Eliom_common.SAtt_no ; post_name = Eliom_common.SAtt_no diff --git a/src/lib/eliom_service_sigs.shared.mli b/src/lib/eliom_service_sigs.shared.mli index 559cae921..52c5b5600 100644 --- a/src/lib/eliom_service_sigs.shared.mli +++ b/src/lib/eliom_service_sigs.shared.mli @@ -257,7 +257,8 @@ module type S = sig (** {3 Static files} *) val static_dir : - unit + ?app:string + -> unit -> ( string list , unit , get @@ -278,7 +279,8 @@ module type S = sig extension. *) val https_static_dir : - unit + ?app:string + -> unit -> ( string list , unit , get @@ -294,7 +296,8 @@ module type S = sig (** Like {!static_dir}, but forces HTTPS link *) val static_dir_with_params : - ?keep_nl_params:[`All | `Persistent | `None] + ?app:string + -> ?keep_nl_params:[`All | `Persistent | `None] -> get_params:('a, [`WithoutSuffix], 'an) Eliom_parameter.params_type -> unit -> ( string list * 'a @@ -312,7 +315,8 @@ module type S = sig (** Like {!static_dir}, but allows one to put GET parameters *) val https_static_dir_with_params : - ?keep_nl_params:[`All | `Persistent | `None] + ?app:string + -> ?keep_nl_params:[`All | `Persistent | `None] -> get_params:('a, [`WithoutSuffix], 'an) Eliom_parameter.params_type -> unit -> ( string list * 'a @@ -332,7 +336,8 @@ module type S = sig (** {3 Miscellaneous} *) val preapply : - service:('a, 'b, 'meth, att, 'co, 'ext, 'reg, _, 'e, 'f, 'return) t + ?app:string + -> service:('a, 'b, 'meth, att, 'co, 'ext, 'reg, _, 'e, 'f, 'return) t -> 'a -> ( unit , 'b