Static linking: defer service fullpath computation after site_dir is …

…known

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

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

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 *)

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

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

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

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
     <ignoredgetparams/> in config file. *)

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
 

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. *)
 
 (*****************************************************************************)

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

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
 

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 []
 

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 :