From 69197bc6cd8527c4bcd9940d64ed260b8a42357d Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Wed, 8 May 2024 16:53:02 +0200 Subject: [PATCH] Add configuration options to instruction --- src/lib/eliom.server.ml | 2 +- src/lib/eliom_config.server.ml | 72 ++++++++++ src/lib/eliom_config.server.mli | 69 +++++++++- src/lib/eliom_registration.server.ml | 69 +++++++++- src/lib/eliom_registration.server.mli | 32 ++++- src/lib/server/eliommod.ml | 86 ++++++------ src/lib/server/eliommod.mli | 184 ++++++++++++++++++++++++++ 7 files changed, 466 insertions(+), 48 deletions(-) create mode 100644 src/lib/server/eliommod.mli diff --git a/src/lib/eliom.server.ml b/src/lib/eliom.server.ml index 694a5154ee..6bb96cd31c 100644 --- a/src/lib/eliom.server.ml +++ b/src/lib/eliom.server.ml @@ -1,2 +1,2 @@ let run ?site () = - Ocsigen_server.Site.register ?site Eliom_registration.instruction + Ocsigen_server.Site.register ?site (Eliom_registration.instruction ()) diff --git a/src/lib/eliom_config.server.ml b/src/lib/eliom_config.server.ml index 9f08153556..5f80fcb046 100644 --- a/src/lib/eliom_config.server.ml +++ b/src/lib/eliom_config.server.ml @@ -16,6 +16,78 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +let set_session_gc_frequency t = + let t = Option.map float_of_int t in + Eliommod_gc.set_servicesessiongcfrequency t; + Eliommod_gc.set_datasessiongcfrequency t + +let set_service_session_gc_frequency t = + let t = Option.map float_of_int t in + Eliommod_gc.set_servicesessiongcfrequency t + +let set_data_session_gc_frequency t = + let t = Option.map float_of_int t in + Eliommod_gc.set_datasessiongcfrequency t + +let set_persistent_session_gc_frequency t = + let t = Option.map float_of_int t in + Eliommod_gc.set_persistentsessiongcfrequency t + +let set_volatile_timeout ?scope_hierarchy ~cookie_level v = + let v = Option.map float_of_int v in + Eliommod_timeouts.set_default ?scope_hierarchy `Data cookie_level v; + Eliommod_timeouts.set_default ?scope_hierarchy `Service cookie_level v + +let set_data_timeout ?scope_hierarchy ~cookie_level v = + let v = Option.map float_of_int v in + Eliommod_timeouts.set_default ?scope_hierarchy `Data cookie_level v + +let set_service_timeout ?scope_hierarchy ~cookie_level v = + let v = Option.map float_of_int v in + Eliommod_timeouts.set_default ?scope_hierarchy `Service cookie_level v + +let set_persistent_timeout ?scope_hierarchy ~cookie_level v = + let v = Option.map float_of_int v in + Eliommod_timeouts.set_default ?scope_hierarchy `Persistent cookie_level v + +let set_max_service_sessions_per_group v = + Eliommod.default_max_service_sessions_per_group := v + +let set_max_volatile_data_sessions_per_group v = + Eliommod.default_max_volatile_data_sessions_per_group := v + +let set_max_persistent_data_sessions_per_group v = + Eliommod.default_max_persistent_data_sessions_per_group := v + +let set_max_service_tab_sessions_per_group v = + Eliommod.default_max_service_tab_sessions_per_group := v + +let set_max_volatile_data_tab_sessions_per_group v = + Eliommod.default_max_volatile_data_tab_sessions_per_group := v + +let set_max_persistent_data_tab_sessions_per_group v = + Eliommod.default_max_persistent_data_tab_sessions_per_group := v + +let set_max_anonymous_services_per_session v = + Eliommod.default_max_anonymous_services_per_session := v + +let set_max_volatile_groups_per_site v = + Eliommod.default_max_volatile_groups_per_site := v + +let set_secure_cookies v = Eliommod.default_secure_cookies := v +let set_application_script v = Eliommod.default_application_script := v +let set_cache_global_data v = Eliommod.default_cache_global_data := v +let set_html_content_type v = Eliommod.default_html_content_type := Some v + +let add_ignored_get_params regexp = + Eliommod.default_ignored_get_params := + regexp :: !Eliommod.default_ignored_get_params + +let add_ignored_post_params regexp = + Eliommod.default_ignored_post_params := + regexp :: !Eliommod.default_ignored_post_params + +let set_omitpersistentstorage v = Eliommod.default_omitpersistentstorage := v let get_default_hostname () = let sitedata = Eliom_request_info.find_sitedata "get_default_hostname" in diff --git a/src/lib/eliom_config.server.mli b/src/lib/eliom_config.server.mli index cd9dd918b9..6e5e8d9950 100644 --- a/src/lib/eliom_config.server.mli +++ b/src/lib/eliom_config.server.mli @@ -35,15 +35,76 @@ v} *) +val set_session_gc_frequency : int option -> unit +(** Set frequency + for garnage collection of both in memory data and service sessions. + [None] means never. *) + +val set_service_session_gc_frequency : int option -> unit +(** Set frequency for garbage collection of service sessions. + [None] means never. *) + +val set_data_session_gc_frequency : int option -> unit +(** Set frequency for garbage collection of in memory data sessions. + [None] means never. *) + +val set_persistent_session_gc_frequency : int option -> unit +(** Set frequency for garbage collection of persistent data sessions. + [None] means never. *) + +val set_volatile_timeout : + ?scope_hierarchy:Eliom_common.scope_hierarchy + -> cookie_level:[< `Session | `Client_process] + -> int option + -> unit + +val set_data_timeout : + ?scope_hierarchy:Eliom_common.scope_hierarchy + -> cookie_level:[< `Session | `Client_process] + -> int option + -> unit + +val set_service_timeout : + ?scope_hierarchy:Eliom_common.scope_hierarchy + -> cookie_level:[< `Session | `Client_process] + -> int option + -> unit + +val set_persistent_timeout : + ?scope_hierarchy:Eliom_common.scope_hierarchy + -> cookie_level:[< `Session | `Client_process] + -> int option + -> unit + +val set_max_service_sessions_per_group : int -> unit +val set_max_volatile_data_sessions_per_group : int -> unit +val set_max_persistent_data_sessions_per_group : int -> unit +val set_max_service_tab_sessions_per_group : int -> unit +val set_max_volatile_data_tab_sessions_per_group : int -> unit +val set_max_persistent_data_tab_sessions_per_group : int -> unit +val set_max_anonymous_services_per_session : int -> unit +val set_max_volatile_groups_per_site : int -> unit +val set_secure_cookies : bool -> unit +val set_application_script : bool * bool -> unit +val set_cache_global_data : (Eliom_lib.Url.path * int) option -> unit +val set_html_content_type : string -> unit +val add_ignored_get_params : string * Re.re -> unit +val add_ignored_post_params : string * Re.re -> unit + +val set_omitpersistentstorage : + Eliom_common.omitpersistentstorage_rule list option + -> unit + val get_default_hostname : unit -> string (** The function [get_default_hostname ()]returns the hostname - declared in the config file ([]) or - the default machine hostname. - In that case, absolute URL will use that hostname. *) + declared in the config file ([]) or + the default machine hostname. + In that case, absolute URL will use that hostname. *) val get_default_port : unit -> int (** The function [get_default_port ()] returns the port number - declared in the config file ([]) or + declared in the config file ([]) or + -> unit 80 if undeclared. *) diff --git a/src/lib/eliom_registration.server.ml b/src/lib/eliom_registration.server.ml index 693af65b3f..213b508626 100644 --- a/src/lib/eliom_registration.server.ml +++ b/src/lib/eliom_registration.server.ml @@ -1261,8 +1261,75 @@ let set_exn_handler h = Eliom_request_info.set_site_handler sitedata (Result_types.cast_function_http h) -let instruction vh conf_info site_dir = +let instruction ?xhr_links ?data_timeout ?service_timeout ?persistent_timeout + ?max_service_sessions_per_group ?max_volatile_data_sessions_per_group + ?max_persistent_data_sessions_per_group ?max_service_tab_sessions_per_group + ?max_volatile_data_tab_sessions_per_group + ?max_persistent_data_tab_sessions_per_group + ?max_anonymous_services_per_session ?secure_cookies ?application_script + ?global_data_caching ?html_content_type ?ignored_get_params + ?ignored_post_params ?omitpersistentstorage () vh conf_info site_dir + = let sitedata = Eliommod.create_sitedata vh site_dir conf_info in + (* customize sitedata according to optional parameters: *) + Option.iter + (fun v -> + sitedata.Eliom_common.default_links_xhr#set ~override_tenable:true v) + xhr_links; + Option.iter + (fun (level, hierarchyname, v) -> + Eliommod.set_timeout + (Eliommod_timeouts.set_global_ ~kind:`Data) + sitedata level hierarchyname v) + data_timeout; + Option.iter + (fun (level, hierarchyname, v) -> + Eliommod.set_timeout + (Eliommod_timeouts.set_global_ ~kind:`Service) + sitedata level hierarchyname v) + service_timeout; + Option.iter + (fun (level, hierarchyname, v) -> + Eliommod.set_timeout + (Eliommod_timeouts.set_global_ ~kind:`Persistent) + sitedata level hierarchyname v) + persistent_timeout; + Option.iter + (fun v -> sitedata.max_service_sessions_per_group <- v) + max_service_sessions_per_group; + Option.iter + (fun v -> sitedata.max_volatile_data_sessions_per_group <- v) + max_volatile_data_sessions_per_group; + Option.iter + (fun v -> sitedata.max_persistent_data_sessions_per_group <- Some v, true) + max_persistent_data_sessions_per_group; + Option.iter + (fun v -> sitedata.max_service_tab_sessions_per_group <- v) + max_service_tab_sessions_per_group; + Option.iter + (fun v -> sitedata.max_volatile_data_tab_sessions_per_group <- v) + max_volatile_data_tab_sessions_per_group; + Option.iter + (fun v -> + sitedata.max_persistent_data_tab_sessions_per_group <- Some v, true) + max_persistent_data_tab_sessions_per_group; + Option.iter + (fun v -> sitedata.max_anonymous_services_per_session <- v) + max_anonymous_services_per_session; + Option.iter (fun v -> sitedata.secure_cookies <- v) secure_cookies; + Option.iter (fun v -> sitedata.application_script <- v) application_script; + Option.iter (fun v -> sitedata.cache_global_data <- v) global_data_caching; + Option.iter (fun v -> sitedata.html_content_type <- Some v) html_content_type; + Option.iter + (fun v -> sitedata.ignored_get_params <- v :: sitedata.ignored_get_params) + ignored_get_params; + Option.iter + (fun v -> sitedata.ignored_post_params <- v :: sitedata.ignored_post_params) + ignored_post_params; + Option.iter + (fun v -> sitedata.omitpersistentstorage <- v) + omitpersistentstorage; + (* end sitedata *) Eliom_common.absolute_change_sitedata sitedata; (* CHECKME *) Eliom_common.begin_load_eliom_module (); diff --git a/src/lib/eliom_registration.server.mli b/src/lib/eliom_registration.server.mli index 49011fb34d..d63a905cad 100644 --- a/src/lib/eliom_registration.server.mli +++ b/src/lib/eliom_registration.server.mli @@ -488,5 +488,35 @@ val cast_http_result : Ocsigen_response.t -> 'a kind (** [cast_http_result] should only be used to register new output modules *) -val instruction : Ocsigen_server.Site.instruction +val instruction : + ?xhr_links:bool + -> ?data_timeout: + [< Eliom_common.cookie_level] + * Eliom_common_base.scope_hierarchy option + * float option + -> ?service_timeout: + [< Eliom_common.cookie_level] + * Eliom_common_base.scope_hierarchy option + * float option + -> ?persistent_timeout: + [< Eliom_common.cookie_level] + * Eliom_common_base.scope_hierarchy option + * float option + -> ?max_service_sessions_per_group:int * bool + -> ?max_volatile_data_sessions_per_group:int * bool + -> ?max_persistent_data_sessions_per_group:int + -> ?max_service_tab_sessions_per_group:int * bool + -> ?max_volatile_data_tab_sessions_per_group:int * bool + -> ?max_persistent_data_tab_sessions_per_group:int + -> ?max_anonymous_services_per_session:int * bool + -> ?secure_cookies:bool + -> ?application_script:bool * bool + -> ?global_data_caching:(string list * int) option + -> ?html_content_type:string + -> ?ignored_get_params:string * Re.re + -> ?ignored_post_params:string * Re.re + -> ?omitpersistentstorage:Eliom_common.omitpersistentstorage_rule list option + -> unit + -> Ocsigen_server.Site.instruction + val end_init : unit -> unit diff --git a/src/lib/server/eliommod.ml b/src/lib/server/eliommod.ml index 2face67e1b..657148305a 100644 --- a/src/lib/server/eliommod.ml +++ b/src/lib/server/eliommod.ml @@ -608,8 +608,8 @@ let end_init () = if !exception_during_eliommodule_loading then (* An eliom module failed with an exception. We do not check - for the missing services, so that the exception can be correctly - propagated by Ocsigen_extensions *) + for the missing services, so that the exception can be correctly + propagated by Ocsigen_extensions *) () else try @@ -617,9 +617,9 @@ let end_init () = Eliom_common.end_current_sitedata () with Eliom_common.Eliom_site_information_not_available _ -> () (*VVV The "try with" looks like a hack: - end_init is called even for user config files ... but in that case, - current_sitedata is not set ... - It would be better to avoid calling end_init for user config files. *) + end_init is called even for user config files ... but in that case, + current_sitedata is not set ... + It would be better to avoid calling end_init for user config files. *) (** Function that will handle exceptions during the initialisation phase *) let handle_init_exn = function @@ -739,6 +739,37 @@ let gen_nothing () _ = Lwt.return Ocsigen_extensions.Ext_do_nothing (*****************************************************************************) let default_module_action _ = failwith "default_module_action" +let set_timeout + (f : + ?full_st_name:Eliom_common.full_state_name + -> ?cookie_level:[< Eliom_common.cookie_level] + -> recompute_expdates:bool + -> bool (* override configfile *) + -> bool (* from config file *) + -> Eliom_common.sitedata + -> float option + -> unit) sitedata cookie_type state_hier v + = + let make_full_st_name secure state_hier = + let scope = + match cookie_type with + | `Session -> `Session state_hier + | `Client_process -> `Client_process state_hier + in + Eliom_common.make_full_state_name2 sitedata.Eliom_common.site_dir_string + secure ~scope + in + (*VVV We set timeout for both secure and unsecure states. +Make possible to customize this? *) + f + ?full_st_name:(Option.map (make_full_st_name false) state_hier) + ?cookie_level:(Some cookie_type) ~recompute_expdates:false true true + sitedata v; + f + ?full_st_name:(Option.map (make_full_st_name true) state_hier) + ?cookie_level:(Some cookie_type) ~recompute_expdates:false true true + sitedata v + (** Parsing of config file for each site: *) let parse_config _ hostpattern conf_info site_dir = (*--- if we put the following line here: *) @@ -814,50 +845,23 @@ let parse_config _ hostpattern conf_info site_dir = browsers manage cookies (one cookie for one site). Thus we can have one site in several cmo (with one session). *) - let set_timeout - (f : - ?full_st_name:Eliom_common.full_state_name - -> ?cookie_level:[< Eliom_common.cookie_level] - -> recompute_expdates:bool - -> bool (* override configfile *) - -> bool (* from config file *) - -> Eliom_common.sitedata - -> float option - -> unit) cookie_type state_hier v - = - let make_full_st_name secure state_hier = - let scope = - match cookie_type with - | `Session -> `Session state_hier - | `Client_process -> `Client_process state_hier - in - Eliom_common.make_full_state_name2 - sitedata.Eliom_common.site_dir_string secure ~scope - in - (*VVV We set timeout for both secure and unsecure states. - Make possible to customize this? *) - f - ?full_st_name:(Option.map (make_full_st_name false) state_hier) - ?cookie_level:(Some cookie_type) ~recompute_expdates:false true true - sitedata v; - f - ?full_st_name:(Option.map (make_full_st_name true) state_hier) - ?cookie_level:(Some cookie_type) ~recompute_expdates:false true true - sitedata v - in let oldipv6mask = sitedata.Eliom_common.ipv6mask in let content = parse_eliom_options ( (fun ct snoo v -> set_timeout (Eliommod_timeouts.set_global_ ~kind:`Data) - ct snoo v; + sitedata ct snoo v; set_timeout (Eliommod_timeouts.set_global_ ~kind:`Service) - ct snoo v) - , set_timeout (Eliommod_timeouts.set_global_ ~kind:`Data) - , set_timeout (Eliommod_timeouts.set_global_ ~kind:`Service) - , set_timeout (Eliommod_timeouts.set_global_ ~kind:`Persistent) + sitedata ct snoo v) + , set_timeout (Eliommod_timeouts.set_global_ ~kind:`Data) sitedata + , set_timeout + (Eliommod_timeouts.set_global_ ~kind:`Service) + sitedata + , set_timeout + (Eliommod_timeouts.set_global_ ~kind:`Persistent) + sitedata , (fun v -> sitedata.Eliom_common.max_service_sessions_per_group <- v, true) , (fun v -> diff --git a/src/lib/server/eliommod.mli b/src/lib/server/eliommod.mli new file mode 100644 index 0000000000..16d36fb831 --- /dev/null +++ b/src/lib/server/eliommod.mli @@ -0,0 +1,184 @@ +val default_max_persistent_data_sessions_per_group : int ref +val default_max_service_sessions_per_group : int ref +val default_max_service_sessions_per_subnet : int ref +val default_max_volatile_data_sessions_per_group : int ref +val default_max_volatile_data_sessions_per_subnet : int ref +val default_max_persistent_data_tab_sessions_per_group : int ref +val default_max_service_tab_sessions_per_group : int ref +val default_max_volatile_data_tab_sessions_per_group : int ref +val default_secure_cookies : bool ref +val default_application_script : (bool * bool) ref +val default_cache_global_data : (Eliom_lib.Url.path * int) option ref +val default_html_content_type : string option ref +val default_ignored_get_params : (string * Re.re) list ref +val default_ignored_post_params : (string * Re.re) list ref + +val default_omitpersistentstorage : + Eliom_common.omitpersistentstorage_rule list option ref + +val default_max_anonymous_services_per_subnet : int ref +val default_max_anonymous_services_per_session : int ref +val default_max_volatile_groups_per_site : int ref + +module S : sig + type key = Ocsigen_extensions.virtual_hosts * Eliom_lib.Url.path + type !'a t + + val create : int -> 'a t + val clear : 'a t -> unit + val reset : 'a t -> unit + val copy : 'a t -> 'a t + val add : 'a t -> key -> 'a -> unit + val remove : 'a t -> key -> unit + val find : 'a t -> key -> 'a + val find_opt : 'a t -> key -> 'a option + val find_all : 'a t -> key -> 'a list + val replace : 'a t -> key -> 'a -> unit + val mem : 'a t -> key -> bool + val iter : (key -> 'a -> unit) -> 'a t -> unit + val filter_map_inplace : (key -> 'a -> 'a option) -> 'a t -> unit + val fold : (key -> 'a -> 'acc -> 'acc) -> 'a t -> 'acc -> 'acc + val length : 'a t -> int + val stats : 'a t -> Hashtbl.statistics + val to_seq : 'a t -> (key * 'a) Seq.t + val to_seq_keys : 'a t -> key Seq.t + val to_seq_values : 'a t -> 'a Seq.t + val add_seq : 'a t -> (key * 'a) Seq.t -> unit + val replace_seq : 'a t -> (key * 'a) Seq.t -> unit + val of_seq : (key * 'a) Seq.t -> 'a t +end + +val create_sitedata : + Ocsigen_extensions.virtual_hosts + -> Eliom_lib.Url.path + -> Ocsigen_extensions.config_info + -> Eliom_common.sitedata + +val parse_eliom_option : + ([> `Client_process | `Session] + -> Eliom_common_base.scope_hierarchy option + -> float option + -> unit) + * ([> `Client_process | `Session] + -> Eliom_common_base.scope_hierarchy option + -> float option + -> unit) + * ([> `Client_process | `Session] + -> Eliom_common_base.scope_hierarchy option + -> float option + -> unit) + * ([> `Client_process | `Session] + -> Eliom_common_base.scope_hierarchy option + -> float option + -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (bool -> unit) + * (int -> unit) + * (int -> unit) + * (bool * bool -> unit) + * ((Eliom_lib.Url.path * int) option -> unit) + * (string -> unit) + * (string * Re.re -> unit) + * (string * Re.re -> unit) + * (Eliom_common.omitpersistentstorage_rule list option -> unit) + -> Xml_light_types.xml + -> unit + +val parse_eliom_options : + ([> `Client_process | `Session] + -> Eliom_common_base.scope_hierarchy option + -> float option + -> unit) + * ([> `Client_process | `Session] + -> Eliom_common_base.scope_hierarchy option + -> float option + -> unit) + * ([> `Client_process | `Session] + -> Eliom_common_base.scope_hierarchy option + -> float option + -> unit) + * ([> `Client_process | `Session] + -> Eliom_common_base.scope_hierarchy option + -> float option + -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (int -> unit) + * (bool -> unit) + * (int -> unit) + * (int -> unit) + * (bool * bool -> unit) + * ((Eliom_lib.Url.path * int) option -> unit) + * (string -> unit) + * (string * Re.re -> unit) + * (string * Re.re -> unit) + * (Eliom_common.omitpersistentstorage_rule list option -> unit) + -> Xml_light_types.xml list + -> Xml_light_types.xml list + +val parse_global_config : Xml_light_types.xml list -> unit +val exception_during_eliommodule_loading : bool ref +val end_init : unit -> unit +val handle_init_exn : exn -> string +val site_init_ref : (unit -> unit) list ref +val register_site_init : (unit -> unit) -> unit +val config : Xml_light_types.xml list ref +val config_in_tag : string ref + +type module_to_load = Files of string list | Name of string + +val site_init : bool ref -> unit + +val load_eliom_module : + 'a + -> module_to_load + -> string + -> Xml_light_types.xml list + -> unit + +val gen_nothing : unit -> 'a -> Ocsigen_extensions.answer Lwt.t +val default_module_action : 'a -> 'b + +val set_timeout : + (?full_st_name:Eliom_common.full_state_name + -> ?cookie_level:([< Eliom_common.cookie_level] as 'a) + -> recompute_expdates:bool + -> bool + -> bool + -> Eliom_common.sitedata + -> float option + -> unit) + -> Eliom_common.sitedata + -> 'a + -> Eliom_common_base.scope_hierarchy option + -> float option + -> unit + +val parse_config : + 'a + -> Ocsigen_extensions.virtual_hosts + -> Ocsigen_extensions.config_info + -> Eliom_lib.Url.path + -> 'b + -> 'c + -> Xml_light_types.xml + -> Ocsigen_extensions.request_state + -> Ocsigen_extensions.answer Lwt.t