From 2a57f11038c1e69545d927efa1c3f62cbc968185 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 10 May 2024 17:03:47 +0200 Subject: [PATCH] Static linking: defer service fullpath computation after site_dir is known --- src/lib/eliom_common.client.ml | 7 ++++ src/lib/eliom_common.server.ml | 19 +++++++++-- src/lib/eliom_common.server.mli | 14 +++++++- src/lib/eliom_mkreg.server.ml | 26 +++++++-------- src/lib/eliom_registration.server.ml | 2 +- src/lib/eliom_request_info.client.ml | 1 + src/lib/eliom_request_info.client.mli | 3 ++ src/lib/eliom_request_info.server.ml | 8 +++++ src/lib/eliom_request_info.server.mli | 5 +++ src/lib/eliom_service.server.ml | 24 +++++--------- src/lib/eliom_service_base.eliom | 47 ++++++++++++++++++--------- src/lib/server/eliommod.ml | 13 ++++---- src/lib/server/eliommod.mli | 2 -- 13 files changed, 113 insertions(+), 58 deletions(-) diff --git a/src/lib/eliom_common.client.ml b/src/lib/eliom_common.client.ml index 59568e238..4f606702c 100644 --- a/src/lib/eliom_common.client.ml +++ b/src/lib/eliom_common.client.ml @@ -71,3 +71,10 @@ let client_html_file, set_client_html_file = , fun s -> assert !is_client_app; r := s ) + +let defer get f = + let r = ref None in + (match get () with + | Some v -> r := Some (f v) + | None -> raise (Eliom_site_information_not_available "defer")); + r diff --git a/src/lib/eliom_common.server.ml b/src/lib/eliom_common.server.ml index f364c1e45..8586f197d 100644 --- a/src/lib/eliom_common.server.ml +++ b/src/lib/eliom_common.server.ml @@ -26,6 +26,7 @@ exception Eliom_there_are_unregistered_services of (string list * string list list * na_key_serv list) +exception Cannot_call_this_function_before_app_is_linked_to_a_site exception Eliom_error_while_loading_site of string exception Eliom_do_redirection of string exception Eliom_do_half_xhr_redirection of string @@ -496,9 +497,7 @@ and dlist_ip_table = let check_initialised field = match field with - | None -> - failwith - "Static linking: cannot use this function before app is linked to a site" + | None -> raise Cannot_call_this_function_before_app_is_linked_to_a_site | Some a -> a let get_site_dir sitedata = check_initialised sitedata.site_dir @@ -1451,3 +1450,17 @@ module To_and_of_shared = struct end let client_html_file () = failwith "client_html_file is only defined on client" +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 r = ref None in + (match get () with + | Some v -> r := Some (f v) + | None -> + Ocsigen_loader.add_module_init_function (get_app_name ()) (fun () -> + match get () with + | Some v -> r := Some (f v) + | None -> raise (Eliom_site_information_not_available "defer"))); + r diff --git a/src/lib/eliom_common.server.mli b/src/lib/eliom_common.server.mli index f265ee204..0c628984a 100644 --- a/src/lib/eliom_common.server.mli +++ b/src/lib/eliom_common.server.mli @@ -110,7 +110,8 @@ exception Eliom_site_information_not_available of string In that case you must delay the function call using {!Eliom_service.register_eliom_module}. *) - +exception Cannot_call_this_function_before_app_is_linked_to_a_site +(** Statically linked app: You cannot call this function before [Eliom_run]. *) type full_state_name = {user_scope : user_scope; secure : bool; site_dir_str : string} @@ -757,3 +758,14 @@ end val client_html_file : unit -> string (** Raises exception on server, only relevant for client apps *) + +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 ()] + 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 *) diff --git a/src/lib/eliom_mkreg.server.ml b/src/lib/eliom_mkreg.server.ml index b5a157700..daf077bc4 100644 --- a/src/lib/eliom_mkreg.server.ml +++ b/src/lib/eliom_mkreg.server.ml @@ -447,8 +447,7 @@ let register pages ?app:_ ?scope ?options ?charset ?code ?content_type ?headers let sp = Eliom_common.get_sp_option () in match scope, sp with | None, None | Some `Site, None -> ( - let aux get_current_sitedata = - let sitedata = get_current_sitedata () in + let aux sitedata = (match S.info service with | S.Attached attser -> Eliom_common.remove_unregistered sitedata (S.sub_path attser) @@ -459,19 +458,18 @@ let register pages ?app:_ ?scope ?options ?charset ?code ?content_type ?headers page_gen in match Eliom_common.global_register_allowed () with - | Some get_current_sitedata -> aux get_current_sitedata + | Some get_current_sitedata -> + let sitedata = get_current_sitedata () in + if sitedata.Eliom_common.site_dir <> None + then aux sitedata + else + (* I suppose that it's a statically linked module + that is not associated with a site yet. + I will defer the registration until app is initialised. *) + Ocsigen_loader.add_module_init_function + (Eliom_common.get_app_name ()) (fun () -> aux sitedata) | _ -> - (* I'm not in a request, nor during global initialisation. - I suppose that it's a statically linked module. - I will defer the registration until app is initialised. *) - let f () = - match Eliom_common.global_register_allowed () with - | Some get_current_sitedata -> aux get_current_sitedata - | _ -> - raise - (Eliom_common.Eliom_site_information_not_available "register") - in - Ocsigen_loader.add_module_init_function (Eliommod.get_app_name ()) f) + raise (Eliom_common.Eliom_site_information_not_available "register")) | None, Some _ | Some `Site, Some _ -> register_aux pages ?options ?charset ?code ?content_type ?headers ?error_handler diff --git a/src/lib/eliom_registration.server.ml b/src/lib/eliom_registration.server.ml index 1e0e2e06a..c14db9ddc 100644 --- a/src/lib/eliom_registration.server.ml +++ b/src/lib/eliom_registration.server.ml @@ -1261,7 +1261,7 @@ let set_exn_handler h = Eliom_request_info.set_site_handler sitedata (Result_types.cast_function_http h) -let default_app_name = Eliommod.default_app_name +let default_app_name = Eliom_common.default_app_name let set_app_name = Eliommod.set_app_name let instruction ?xhr_links ?(app = default_app_name) ?data_timeout diff --git a/src/lib/eliom_request_info.client.ml b/src/lib/eliom_request_info.client.ml index 8d1f7655d..e4593f396 100644 --- a/src/lib/eliom_request_info.client.ml +++ b/src/lib/eliom_request_info.client.ml @@ -127,6 +127,7 @@ let get_persistent_nl_get_params () = let get_persistent_nl_get_params_sp = get_persistent_nl_get_params let get_si () = get_sess_info () let get_site_dir () = (Eliom_process.get_sitedata ()).site_dir +let get_site_dir_option () = Some (get_site_dir ()) let ssl_ = match Url.Current.get () with diff --git a/src/lib/eliom_request_info.client.mli b/src/lib/eliom_request_info.client.mli index b3a5c37e1..28c493df3 100644 --- a/src/lib/eliom_request_info.client.mli +++ b/src/lib/eliom_request_info.client.mli @@ -36,6 +36,9 @@ val get_nl_get_params : unit -> (string * string) list String.Table.t val get_site_dir : unit -> Url.path (** returns the root of the site. *) +val get_site_dir_option : unit -> Url.path option +(** returns the root of the site. *) + val get_ignored_get_params : unit -> (string * string) list (** returns the GET parameters that have been ignored using in config file. *) diff --git a/src/lib/eliom_request_info.server.ml b/src/lib/eliom_request_info.server.ml index 455e0f1c3..56dab9d12 100644 --- a/src/lib/eliom_request_info.server.ml +++ b/src/lib/eliom_request_info.server.ml @@ -302,6 +302,14 @@ let get_site_dir () = let sitedata = find_sitedata "Eliom_request_info.get_site_dir" in Eliom_common.get_site_dir sitedata +let get_site_dir_option () = + try Some (get_site_dir ()) + with + | Eliom_common.Cannot_call_this_function_before_app_is_linked_to_a_site + | Eliom_common.Eliom_site_information_not_available _ + -> + None + let get_site_dir_sp sp = Eliom_common.get_site_dir sp.Eliom_common.sp_sitedata let in_request_handler () = Lwt.get Eliom_common.sp_key <> None diff --git a/src/lib/eliom_request_info.server.mli b/src/lib/eliom_request_info.server.mli index 6f8a6ed1a..28ada359e 100644 --- a/src/lib/eliom_request_info.server.mli +++ b/src/lib/eliom_request_info.server.mli @@ -142,6 +142,11 @@ val get_file_content_type : (if any). *) val get_site_dir : unit -> Eliom_lib.Url.path +(** returns the root of the site. + Raises [Eliom_common.Eliom_site_information_not_available] + if unavailable. *) + +val get_site_dir_option : unit -> Eliom_lib.Url.path option (** returns the root of the site. *) (*****************************************************************************) diff --git a/src/lib/eliom_service.server.ml b/src/lib/eliom_service.server.ml index e9d52b397..ef9747553 100644 --- a/src/lib/eliom_service.server.ml +++ b/src/lib/eliom_service.server.ml @@ -32,22 +32,16 @@ let plain_service (type m gp gn pp pn gp') ?(https = false) ~path |> Url.remove_slash_at_beginning |> Url.change_empty_list |> Url.remove_internal_slash in - let site_dir = - match Eliom_common.get_sp_option () with - | Some sp -> Eliom_request_info.get_site_dir_sp sp - | None -> ( - match Eliom_common.global_register_allowed () with - | Some current_site_data -> - let sitedata = current_site_data () in - Eliom_common.add_unregistered sitedata path; - Eliom_common.get_site_dir sitedata - | None -> - raise (Eliom_common.Eliom_site_information_not_available "service")) - in + (if Eliom_common.get_sp_option () = None + then + match Eliom_common.global_register_allowed () with + | Some current_site_data -> + Eliom_common.add_unregistered (current_site_data ()) path + | None -> + raise (Eliom_common.Eliom_site_information_not_available "service")); let reload_fun = Rf_client_fun in - main_service ~https ~prefix:"" ~path ~site_dir ~kind:`Service ~meth - ?redirect_suffix ?keep_nl_params ?priority ~get_params ~post_params - ~reload_fun () + main_service ~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 diff --git a/src/lib/eliom_service_base.eliom b/src/lib/eliom_service_base.eliom index de6ede8ce..bfe84a5b3 100644 --- a/src/lib/eliom_service_base.eliom +++ b/src/lib/eliom_service_base.eliom @@ -63,9 +63,10 @@ type att = http://ocsigen.org *) subpath : Url.path ; (* name of the service without parameters *) - fullpath : Url.path - ; (* full path of the service = - site_dir@subpath *) + fullpath : Url.path option ref + ; (* full path of the service = site_dir@subpath. + None means the service has been created before site_dir is known. + In that case, the initialisation is deferred. *) get_name : Eliom_common.att_key_serv ; post_name : Eliom_common.att_key_serv ; redirect_suffix : bool @@ -191,7 +192,13 @@ let post_params_type s = s.post_params_type let prefix s = s.prefix let sub_path s = s.subpath let redirect_suffix s = s.redirect_suffix -let full_path s = s.fullpath + +let full_path s = + match !(s.fullpath) with + | None -> + raise (Eliom_common.Eliom_site_information_not_available "full_path") + | Some a -> a + let get_name s = s.get_name let post_name s = s.post_name let na_name s = s.na_name @@ -231,8 +238,9 @@ let static_dir_ ?(https = false) () = { prefix = "" ; subpath = [""] ; fullpath = - Eliom_request_info.get_site_dir () - @ [Eliom_common.eliom_suffix_internal_name] + Eliom_common.defer Eliom_request_info.get_site_dir_option + (fun site_dir -> + site_dir @ [Eliom_common.eliom_suffix_internal_name]) ; get_name = Eliom_common.SAtt_no ; post_name = Eliom_common.SAtt_no ; redirect_suffix = true @@ -265,8 +273,9 @@ let get_static_dir_ ?(https = false) ?(keep_nl_params = `None) ~get_params () = { prefix = "" ; subpath = [""] ; fullpath = - Eliom_request_info.get_site_dir () - @ [Eliom_common.eliom_suffix_internal_name] + Eliom_common.defer Eliom_request_info.get_site_dir_option + (fun site_dir -> + site_dir @ [Eliom_common.eliom_suffix_internal_name]) ; get_name = Eliom_common.SAtt_no ; post_name = Eliom_common.SAtt_no ; redirect_suffix = true @@ -319,9 +328,12 @@ let preapply ~service getparams = | Some suff -> append_suffix k.subpath suff | _ -> k.subpath) ; fullpath = - (match suff with - | Some suff -> append_suffix k.fullpath suff - | _ -> k.fullpath) }) + Eliom_common.defer + (fun () -> !(k.fullpath)) + (fun fp -> + match suff with + | Some suff -> append_suffix fp suff + | _ -> fp) }) ; client_fun = Some [%client.unsafe @@ -461,7 +473,7 @@ 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) ~site_dir ~kind ~meth +let main_service ~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 () = @@ -476,7 +488,12 @@ let main_service ~https ~prefix ~(path : Url.path) ~site_dir ~kind ~meth Attached { prefix ; subpath = path - ; fullpath = site_dir @ path + ; fullpath = + (match force_site_dir with + | Some site_dir -> ref (Some (site_dir @ path)) + | None -> + Eliom_common.defer 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 ; redirect_suffix @@ -499,8 +516,8 @@ let extern ?keep_nl_params ~prefix ~path ~meth () = (match suffix with | None -> path | _ -> path @ [Eliom_common.eliom_suffix_internal_name])) - ~site_dir:[] ~kind:`External ~meth ?keep_nl_params ~redirect_suffix:false - ~get_params ~post_params ~reload_fun:Rf_keep () + ~force_site_dir:[] ~kind:`External ~meth ?keep_nl_params + ~redirect_suffix:false ~get_params ~post_params ~reload_fun:Rf_keep () let which_meth {meth; _} = meth diff --git a/src/lib/server/eliommod.ml b/src/lib/server/eliommod.ml index 1f268eedb..0ddfa64da 100644 --- a/src/lib/server/eliommod.ml +++ b/src/lib/server/eliommod.ml @@ -691,10 +691,6 @@ let handle_init_exn = function (*****************************************************************************) (** Module loading *) -let default_app_name = "__eliom_default_app__" -let current_app_name = ref default_app_name -let get_app_name () = !current_app_name - let get_sitedata = let r = ref String_map.empty in fun name -> @@ -713,11 +709,14 @@ let update_sitedata app vh site_dir conf_info = update_sitedata vh site_dir sitedata; sitedata -let _ = Eliom_common.absolute_change_sitedata (get_sitedata !current_app_name) +let _ = + Eliom_common.absolute_change_sitedata + (get_sitedata (Eliom_common.get_app_name ())) let set_app_name s = - current_app_name := s; - Eliom_common.absolute_change_sitedata (get_sitedata !current_app_name) + Eliom_common.current_app_name := s; + Eliom_common.absolute_change_sitedata + (get_sitedata (Eliom_common.get_app_name ())) let site_init_ref = ref [] diff --git a/src/lib/server/eliommod.mli b/src/lib/server/eliommod.mli index 13421fc87..4c6e0d046 100644 --- a/src/lib/server/eliommod.mli +++ b/src/lib/server/eliommod.mli @@ -145,9 +145,7 @@ val config_in_tag : string ref type module_to_load = Files of string list | Name of string -val default_app_name : string val set_app_name : string -> unit -val get_app_name : unit -> string val site_init : bool ref -> unit val update_sitedata :