src/server/private/eliommod.ml

   1 (* Ocsigen
   2  * http://www.ocsigen.org
   3  * Module eliommod.ml
   4  * Copyright (C) 2007 Vincent Balat
   5  *
   6  * This program is free software; you can redistribute it and/or modify
   7  * it under the terms of the GNU Lesser General Public License as published by
   8  * the Free Software Foundation, with linking exception;
   9  * either version 2.1 of the License, or (at your option) any later version.
  10  *
  11  * This program is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  * GNU Lesser General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU Lesser General Public License
  17  * along with this program; if not, write to the Free Software
  18  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  19  *)
  20 (*****************************************************************************)
  21 (*****************************************************************************)
  22 (** Internal functions used by Eliom:                                        *)
  23 (** Tables of services (global and session tables,                           *)
  24 (** persistant and volatile data tables)                                     *)
  25 (** Store and load services                                                  *)
  26 (*****************************************************************************)
  27 (*****************************************************************************)
  28
  29 open Eliom_pervasives
  30
  31 open Lwt
  32 open Ocsigen_http_frame
  33 open Ocsigen_extensions
  34 open Lazy
  35
  36
  37 (****************************************************************************)
  38 let default_max_persistent_sessions_per_group = ref 5
  39 let default_max_service_sessions_per_group = ref 5
  40 let default_max_service_sessions_per_subnet = ref 1000000
  41 let default_max_data_sessions_per_group = ref 5
  42 let default_max_data_sessions_per_subnet = ref 1000000
  43 let default_max_persistent_tab_sessions_per_group = ref 50
  44 let default_max_service_tab_sessions_per_group = ref 50
  45 let default_max_data_tab_sessions_per_group = ref 50
  46
  47 (* Subnet defaults be large enough, because it must work behind a reverse proxy.
  48
  49    If 1 session takes 1000 bytes (data + tables etc),
  50    1 million sessions take 1 GB.
  51
  52    If somebody opens 1000 sessions per second,
  53    then it will take 1000 s (16 minutes) to reach 1000000.
  54
  55    It means that regular users will have their sessions closed
  56    after 16 minutes of inactivity if they share their sub network with
  57    someone doing an attack (or if the server is behind a proxy).
  58
  59    In any case, it is better to use session groups when possible.
  60
  61    For persistent session, there is a limitation per session group,
  62    efficient only for small values.
  63    But there is no limitation by subnet.
  64    1 billion sessions take 1 TB.
  65    If somebody opens 1000 sessions per second,
  66    then it will take 1 million s (16000 minutes = 266 h = 11 days)
  67    to reach 1TB.
  68
  69  *)
  70
  71 let default_max_anonymous_services_per_subnet = ref 500000
  72 let default_max_anonymous_services_per_session = ref 1000
  73
  74 let default_max_volatile_groups_per_site  = ref 1000000
  75 (*VVV value ??? *)
  76
  77
  78
  79
  80 let new_sitedata =
  81   (* We want to keep the old site data even if we reload the server *)
  82   (* To do that, we keep the site data in a table *)
  83   let module S = Hashtbl.Make(struct
  84                                 type t =
  85                                     Ocsigen_extensions.virtual_hosts * Url.path
  86                                 let equal (vh1, u1 : t) (vh2, u2 : t) =
  87                                   Ocsigen_extensions.equal_virtual_hosts vh1 vh2
  88                                   && u1 = u2
  89                                 let hash (vh, u : t) =
  90                                   Hashtbl.hash (
  91                                     Ocsigen_extensions.hash_virtual_hosts vh, u)
  92                               end)
  93   in
  94   let t = S.create 5 in
  95   fun host site_dir config_info ->
  96     let key = (host, site_dir) in
  97     try
  98       S.find t key
  99     with
 100       | Not_found ->
 101         let gog =
 102           Ocsigen_cache.Dlist.create !default_max_volatile_groups_per_site
 103         in
 104         let sitedata =
 105           let dlist_table = Eliom_common.create_dlist_ip_table 100 in
 106           (* One dlist for each site? *)
 107           {Eliom_common.servtimeout = None, None, [];
 108            datatimeout =  None, None, [];
 109            perstimeout =  None, None, [];
 110            lazy_site_value_table = Polytables.create ();
 111            site_dir = site_dir;
 112 (*VVV encode=false??? *)
 113            site_dir_string = Url.string_of_url_path
 114               ~encode:false site_dir;
 115            config_info = config_info;
 116            global_services =
 117               Eliom_common.empty_tables
 118                 !default_max_anonymous_services_per_subnet
 119                 false;
 120            registered_scope_names = String.Set.empty;
 121            session_services = Eliommod_cookies.new_service_cookie_table ();
 122            session_data = Eliommod_cookies.new_data_cookie_table ();
 123            group_of_groups = gog;
 124            remove_session_data = (fun cookie -> ());
 125            not_bound_in_data_tables = (fun cookie -> true);
 126            exn_handler = Eliommod_pagegen.def_handler;
 127            unregistered_services = [];
 128            unregistered_na_services = [];
 129            max_service_sessions_per_group =
 130               !default_max_service_sessions_per_group, false;
 131            max_volatile_data_sessions_per_group =
 132               !default_max_service_sessions_per_group, false;
 133            max_persistent_data_sessions_per_group =
 134               Some !default_max_persistent_sessions_per_group, false;
 135            max_service_tab_sessions_per_group =
 136               !default_max_service_tab_sessions_per_group, false;
 137            max_volatile_data_tab_sessions_per_group =
 138               !default_max_service_tab_sessions_per_group, false;
 139            max_persistent_data_tab_sessions_per_group =
 140               Some !default_max_persistent_tab_sessions_per_group, false;
 141            max_service_sessions_per_subnet =
 142               !default_max_data_sessions_per_subnet, false;
 143            max_volatile_data_sessions_per_subnet =
 144               !default_max_data_sessions_per_subnet, false;
 145            max_anonymous_services_per_session =
 146               !default_max_anonymous_services_per_session, false;
 147            max_anonymous_services_per_subnet =
 148               !default_max_anonymous_services_per_subnet, false;
 149            dlist_ip_table = dlist_table;
 150            ipv4mask = None, false;
 151            ipv6mask = None, false;
 152           }
 153         in
 154         Ocsigen_cache.Dlist.set_finaliser_after
 155           (fun (node : [ `Session ] Eliom_common.sessgrp
 156                   Ocsigen_cache.Dlist.node) ->
 157             let fullbrowsersessgrp = Ocsigen_cache.Dlist.value node in
 158             (* When removing a group from the dlist, we must close it.
 159                Actually, it must be the only way to close a group *)
 160             (* This finaliser is almost identical to the finaliser for
 161                other groups, defined in Eliommod_sessiongroups *)
 162             (* First we close all browser sessions in the group,
 163                by removing the group from its dlist: *)
 164             Eliommod_sessiongroups.Data.remove_group fullbrowsersessgrp;
 165             (* Then we close all group tables: *)
 166             let key = match thd3 fullbrowsersessgrp with
 167               | Left a -> a
 168               | _ -> Eliom_common.default_group_name
 169             in
 170             (* iterate on all session data tables: *)
 171             sitedata.Eliom_common.remove_session_data key
 172           )
 173           gog;
 174         Eliommod_gc.service_session_gc sitedata;
 175         Eliommod_gc.data_session_gc sitedata;
 176         Eliommod_gc.persistent_session_gc sitedata;
 177         S.add t key sitedata;
 178         sitedata
 179
 180
 181
 182
 183
 184
 185
 186
 187
 188
 189
 190
 191
 192
 193
 194 (*****************************************************************************)
 195 (* Session service table *)
 196 (** We associate to each service a function server_params -> page *)
 197
 198
 199
 200
 201
 202 (****************************************************************************)
 203 (****************************************************************************)
 204 (****************************************************************************)
 205 open Simplexmlparser
 206
 207
 208 (* The following is common to global config and site config *)
 209 let parse_eliom_option
 210     globaloption
 211     (set_volatile_timeout,
 212      set_data_timeout,
 213      set_service_timeout,
 214      set_persistent_timeout,
 215      set_max_service_sessions_per_group,
 216      set_max_service_sessions_per_subnet,
 217      set_max_data_sessions_per_group,
 218      set_max_data_sessions_per_subnet,
 219      set_max_persistent_sessions_per_group,
 220      set_max_service_tab_sessions_per_group,
 221      set_max_data_tab_sessions_per_group,
 222      set_max_persistent_tab_sessions_per_group,
 223      set_max_services_per_session,
 224      set_max_services_per_subnet,
 225      set_max_volatile_groups_per_site,
 226      set_ipv4mask,
 227      set_ipv6mask
 228     )
 229     =
 230   let parse_timeout_attrs tn attrs =
 231     let rec aux ((v, sn, ct) as res) = function
 232       | [] -> res
 233       | ("value", s)::l -> aux (Some s, sn, ct) l
 234       | ("sessionname", sn)::l -> aux (v, Some sn, ct) l
 235       | ("sessiontype", "browser")::l -> aux (v, sn, `Session) l
 236       | ("sessiontype", "tab")::l -> aux (v, sn, `Client_process) l
 237       | ("sessiontype", _)::l ->
 238           raise
 239             (Error_in_config_file
 240                ("Eliom: Wrong attribute value for sessiontype in "^tn^" tag"))
 241       | _ ->
 242           raise
 243             (Error_in_config_file
 244                ("Eliom: Wrong attribute name for "^tn^" tag"))
 245     in
 246     let (a, sn, ct) = aux (None, None, `Session) attrs in
 247     let a = match a with
 248       | None ->
 249         raise
 250           (Error_in_config_file
 251              ("Eliom: Missing value for "^tn^" tag"))
 252       | Some "infinity" -> None
 253       | Some a ->
 254           try Some (float_of_string a)
 255           with Failure _ ->
 256             raise
 257               (Error_in_config_file
 258                  ("Eliom: Wrong attribute value for "^tn^" tag"))
 259     in
 260     if (not globaloption) || sn = None
 261     then
 262       let sn = match sn with
 263         | None -> None
 264         | Some "" -> Some None
 265         | c -> Some c
 266       in (a, sn, ct)
 267     else
 268       raise
 269         (Error_in_config_file
 270            ("Eliom: sessionname attribute not allowed for "^tn^" tag in global configuration"))
 271   in
 272   function
 273   | (Element ("volatiletimeout", attrs, [])) ->
 274       let t, snoo, ct = parse_timeout_attrs "volatiletimeout" attrs in
 275       set_volatile_timeout ct snoo (t : float option)
 276   | (Element ("datatimeout", attrs, [])) ->
 277       let t, snoo, ct = parse_timeout_attrs "datatimeout" attrs in
 278       set_data_timeout ct snoo t
 279   | (Element ("servicetimeout", attrs, [])) ->
 280       let t, snoo, ct = parse_timeout_attrs "servicetimeout" attrs in
 281       set_service_timeout ct snoo t
 282   | (Element ("persistenttimeout", attrs, [])) ->
 283       let t, snoo, ct = parse_timeout_attrs "persistenttimeout" attrs in
 284       set_persistent_timeout ct snoo t
 285
 286   | (Element ("maxvolatilesessionspergroup", [("value", v)], [])) ->
 287       (try
 288          let i = int_of_string v in
 289          set_max_service_sessions_per_group i;
 290          set_max_data_sessions_per_group i
 291        with Failure _ ->
 292          raise
 293            (Error_in_config_file
 294               ("Eliom: Wrong attribute value for maxvolatilesessionspergroup tag")))
 295   | (Element ("maxservicesessionspergroup", [("value", v)], [])) ->
 296       (try
 297          let i = int_of_string v in
 298          set_max_service_sessions_per_group i;
 299        with Failure _ ->
 300          raise (Error_in_config_file
 301                   ("Eliom: Wrong attribute value for maxservicesessionspergroup tag")))
 302   | (Element ("maxdatasessionspergroup", [("value", v)], [])) ->
 303       (try
 304          let i = int_of_string v in
 305          set_max_data_sessions_per_group i
 306        with Failure _ ->
 307          raise (Error_in_config_file
 308                   ("Eliom: Wrong attribute value for maxdatasessionspergroup tag")))
 309   | (Element ("maxvolatilesessionspersubnet", [("value", v)], [])) ->
 310       (try
 311          let i = int_of_string v in
 312          set_max_service_sessions_per_subnet i;
 313          set_max_data_sessions_per_subnet i
 314        with Failure _ ->
 315          raise (Error_in_config_file
 316                   ("Eliom: Wrong attribute value for maxvolatilesessionspersubnet tag")))
 317   | (Element ("maxservicesessionspersubnet", [("value", v)], [])) ->
 318       (try
 319          let i = int_of_string v in
 320          set_max_service_sessions_per_subnet i;
 321        with Failure _ ->
 322          raise (Error_in_config_file
 323                   ("Eliom: Wrong attribute value for maxservicesessionspersubnet tag")))
 324   | (Element ("maxdatasessionspersubnet", [("value", v)], [])) ->
 325       (try
 326          let i = int_of_string v in
 327          set_max_data_sessions_per_subnet i
 328        with Failure _ ->
 329          raise (Error_in_config_file
 330                   ("Eliom: Wrong attribute value for maxdatasessionspersubnet tag")))
 331   | (Element ("maxpersistentsessionspergroup", [("value", v)], [])) ->
 332       (try
 333          let i = int_of_string v in
 334          set_max_persistent_sessions_per_group i;
 335        with Failure _ ->
 336          raise
 337            (Error_in_config_file
 338               ("Eliom: Wrong attribute value for maxpersistentsessionspergroup tag")))
 339   | (Element ("maxvolatiletabsessionspergroup", [("value", v)], [])) ->
 340       (try
 341          let i = int_of_string v in
 342          set_max_service_tab_sessions_per_group i;
 343          set_max_data_tab_sessions_per_group i
 344        with Failure _ ->
 345          raise
 346            (Error_in_config_file
 347               ("Eliom: Wrong attribute value for maxvolatiletabsessionspergroup tag")))
 348   | (Element ("maxservicetabsessionspergroup", [("value", v)], [])) ->
 349       (try
 350          let i = int_of_string v in
 351          set_max_service_tab_sessions_per_group i;
 352        with Failure _ ->
 353          raise (Error_in_config_file
 354                   ("Eliom: Wrong attribute value for maxservicetabsessionspergroup tag")))
 355   | (Element ("maxdatatabsessionspergroup", [("value", v)], [])) ->
 356       (try
 357          let i = int_of_string v in
 358          set_max_data_tab_sessions_per_group i
 359        with Failure _ ->
 360          raise (Error_in_config_file
 361                   ("Eliom: Wrong attribute value for maxdatatabsessionspergroup tag")))
 362   | (Element ("maxpersistenttabsessionspergroup", [("value", v)], [])) ->
 363       (try
 364          let i = int_of_string v in
 365          set_max_persistent_tab_sessions_per_group i;
 366        with Failure _ ->
 367          raise
 368            (Error_in_config_file
 369               ("Eliom: Wrong attribute value for maxpersistenttabsessionspergroup tag")))
 370   | (Element ("maxanonymouscoservicespersession", [("value", v)], [])) ->
 371       (try
 372          let i = int_of_string v in
 373          set_max_services_per_session i;
 374        with Failure _ ->
 375          raise (Error_in_config_file
 376                   ("Eliom: Wrong attribute value for maxanonymouscoservicespersession tag")))
 377   | (Element ("maxanonymouscoservicespersubnet", [("value", v)], [])) ->
 378       (try
 379          let i = int_of_string v in
 380          set_max_services_per_subnet i;
 381        with Failure _ ->
 382          raise (Error_in_config_file
 383                   ("Eliom: Wrong attribute value for maxanonymouscoservicespersubnet tag")))
 384   | (Element ("maxvolatilegroupspersite", [("value", v)], [])) ->
 385       (try
 386          let i = int_of_string v in
 387          set_max_volatile_groups_per_site i
 388        with Failure _ ->
 389          raise (Error_in_config_file
 390                   ("Eliom: Wrong attribute value for maxvolatilegroupspersite tag")))
 391
 392   | (Element ("ipv4subnetmask", [("value", v)], [])) ->
 393       (try
 394          (match Ip_address.parse v with
 395             | Ip_address.IPv4 a, None -> set_ipv4mask a
 396             | _ -> failwith "ipv6"
 397          )
 398        with Failure _ ->
 399          raise (Error_in_config_file
 400                   ("Eliom: Wrong attribute value for ipv4subnetmask tag")))
 401   | (Element ("ipv6subnetmask", [("value", v)], [])) ->
 402       (try
 403          (match Ip_address.parse v with
 404             | Ip_address.IPv6 (a, b), None -> set_ipv6mask (a, b)
 405             | _ -> failwith "ipv6"
 406          )
 407           with Failure _ ->
 408          raise (Error_in_config_file
 409                   ("Eliom: Wrong attribute value for ipv6subnetmask tag")))
 410
 411   | (Element (s, _, _)) ->
 412       raise (Error_in_config_file
 413                ("Unexpected content <"^s^"> inside eliom config"))
 414   | _ -> raise (Error_in_config_file ("Unexpected content inside eliom config"))
 415
 416
 417 let parse_eliom_options f l =
 418   let rec aux rest = function
 419     | [] -> rest
 420     | e::l ->
 421         try
 422           parse_eliom_option true f e;
 423           aux rest l
 424         with Error_in_config_file _ -> aux (e::rest) l
 425   in List.rev (aux [] l)
 426
 427
 428 (*****************************************************************************)
 429 (** Parsing global configuration for Eliommod: *)
 430
 431 let rec parse_global_config = function
 432   | [] -> ()
 433   | (Element ("sessiongcfrequency", [("value", s)], p))::ll ->
 434       (try
 435         let t = float_of_string s in
 436         Eliommod_gc.set_servicesessiongcfrequency (Some t);
 437         Eliommod_gc.set_datasessiongcfrequency (Some t)
 438       with Failure _ ->
 439         if s = "infinity"
 440         then begin
 441           Eliommod_gc.set_servicesessiongcfrequency None;
 442           Eliommod_gc.set_datasessiongcfrequency None
 443         end
 444         else raise (Error_in_config_file
 445                       "Eliom: Wrong value for <sessiongcfrequency>"));
 446       parse_global_config ll
 447   | (Element ("servicesessiongcfrequency", [("value", s)], p))::ll ->
 448       (try
 449         Eliommod_gc.set_servicesessiongcfrequency (Some (float_of_string s))
 450       with Failure _ ->
 451         if s = "infinity"
 452         then Eliommod_gc.set_servicesessiongcfrequency None
 453         else raise (Error_in_config_file
 454                       "Eliom: Wrong value for <servicesessiongcfrequency>"));
 455       parse_global_config ll
 456   | (Element ("datasessiongcfrequency", [("value", s)], p))::ll ->
 457       (try
 458         Eliommod_gc.set_datasessiongcfrequency (Some (float_of_string s))
 459       with Failure _ ->
 460         if s = "infinity"
 461         then Eliommod_gc.set_datasessiongcfrequency None
 462         else raise (Error_in_config_file
 463                       "Eliom: Wrong value for <datasessiongcfrequency>"));
 464       parse_global_config ll
 465   | (Element ("persistentsessiongcfrequency",
 466               [("value", s)], p))::ll ->
 467                 (try
 468                   Eliommod_gc.set_persistentsessiongcfrequency
 469                     (Some (float_of_string s))
 470                 with Failure _ ->
 471                   if s = "infinity"
 472                   then Eliommod_gc.set_persistentsessiongcfrequency None
 473                   else raise
 474                     (Error_in_config_file
 475                        "Eliom: Wrong value for <persistentsessiongcfrequency>"));
 476                 parse_global_config ll
 477   | e::ll ->
 478       parse_eliom_option
 479         false
 480         ((fun ct _ -> Eliommod_timeouts.set_default_volatile_timeout ct),
 481          (fun ct _ -> Eliommod_timeouts.set_default_data_timeout ct),
 482          (fun ct _ -> Eliommod_timeouts.set_default_service_timeout ct),
 483          (fun ct _ -> Eliommod_timeouts.set_default_persistent_timeout ct),
 484          (fun v -> default_max_service_sessions_per_group := v),
 485          (fun v -> default_max_service_sessions_per_subnet := v),
 486          (fun v -> default_max_data_sessions_per_group := v),
 487          (fun v -> default_max_data_sessions_per_subnet := v),
 488          (fun v -> default_max_persistent_sessions_per_group := v),
 489          (fun v -> default_max_service_tab_sessions_per_group := v),
 490          (fun v -> default_max_data_tab_sessions_per_group := v),
 491          (fun v -> default_max_persistent_tab_sessions_per_group := v),
 492          (fun v -> default_max_anonymous_services_per_session := v),
 493          (fun v -> default_max_anonymous_services_per_subnet := v),
 494          (fun v -> default_max_volatile_groups_per_site := v),
 495          (fun v -> Eliom_common.ipv4mask := v),
 496          (fun v -> Eliom_common.ipv6mask := v)
 497         )
 498         e;
 499       parse_global_config ll
 500
 501
 502
 503
 504
 505
 506
 507
 508
 509
 510
 511
 512
 513
 514
 515 (*****************************************************************************)
 516
 517 let exception_during_eliommodule_loading = ref false
 518
 519
 520 (** Function to be called at the end of the initialisation phase *)
 521 let end_init () =
 522   if !exception_during_eliommodule_loading then
 523     (* An eliom module failed with an exception. We do not check
 524        for the missing services, so that the exception can be correctly
 525        propagated by Ocsigen_extensions *)
 526     ()
 527   else
 528     try
 529       Eliom_common.verify_all_registered (Eliom_common.get_current_sitedata ());
 530       Eliom_common.end_current_sitedata ()
 531     with Eliom_common.Eliom_site_information_not_available _ -> ()
 532       (*VVV The "try with" looks like a hack:
 533         end_init is called even for user config files ... but in that case,
 534         current_sitedata is not set ...
 535         It would be better to avoid calling end_init for user config files. *)
 536
 537 (** Function that will handle exceptions during the initialisation phase *)
 538 let handle_init_exn = function
 539   | Eliom_common.Eliom_error_while_loading_site s -> s
 540   | Eliom_common.Eliom_duplicate_registration s ->
 541       ("Eliom: Duplicate registration of service \""^s^
 542        "\". Please correct the module.")
 543   | Eliom_common.Eliom_there_are_unregistered_services (s, l1, l2) ->
 544       ("Eliom: in site /"^
 545        (Url.string_of_url_path ~encode:false s)^" - "^
 546        (match l1 with
 547        | [] -> ""
 548        | [a] -> "One service or coservice has not been registered on URL /"
 549            ^(Url.string_of_url_path ~encode:false a)^". "
 550        | a::ll ->
 551            let string_of = Url.string_of_url_path ~encode:false in
 552            "Some services or coservices have not been registered \
 553              on URLs: "^
 554              (List.fold_left
 555                 (fun beg v -> beg^", /"^(string_of v))
 556                 ("/"^(string_of a))
 557                 ll
 558              )^". ")^
 559        (match l2 with
 560        | [] -> ""
 561        | [Eliom_common.SNa_get' _] ->
 562            "One non-attached GET coservice has not been registered."
 563        | [Eliom_common.SNa_post' _] ->
 564            "One non-attached POST coservice has not been registered."
 565        | [Eliom_common.SNa_get_ a] -> "The non-attached GET service \""
 566            ^a^
 567            "\" has not been registered."
 568        | [Eliom_common.SNa_post_ a] -> "The non-attached POST service \""
 569            ^a^
 570            "\" has not been registered."
 571        | a::ll ->
 572            let string_of = function
 573              | Eliom_common.SNa_void_keep
 574              | Eliom_common.SNa_void_dontkeep
 575              | Eliom_common.SNa_no -> assert false
 576              | Eliom_common.SNa_get' _ -> "<GET coservice>"
 577              | Eliom_common.SNa_get_ n -> n^" (GET)"
 578              | Eliom_common.SNa_post' _ -> "<POST coservice>"
 579              | Eliom_common.SNa_post_ n -> n^" (POST)"
 580              | Eliom_common.SNa_get_csrf_safe _ -> " <GET CSRF-safe coservice>"
 581              | Eliom_common.SNa_post_csrf_safe _ -> "<POST CSRF-safe coservice>"
 582            in
 583            "Some non-attached services or coservices have not been registered: "^
 584              (List.fold_left
 585                 (fun beg v -> beg^", "^(string_of v))
 586                 (string_of a)
 587                 ll
 588              )^".")^
 589          "\nPlease correct your modules and make sure you have linked in all the modules...")
 590   | Eliom_common.Eliom_site_information_not_available f ->
 591       ("Eliom: Bad use of function \""^f^
 592           "\". Must be used only during site intialisation phase (or, sometimes, also during request).")
 593   | Eliom_common.Eliom_page_erasing s ->
 594       ("Eliom: You cannot create a page or directory here. "^s^
 595        " already exists. Please correct your modules.")
 596   | e -> raise e
 597
 598 (*****************************************************************************)
 599 (** Module loading *)
 600 let config = ref []
 601
 602 type module_to_load = Files of string list | Name of string
 603
 604 let load_eliom_module sitedata cmo_or_name content =
 605   let preload () =
 606     config := content;
 607     Eliom_common.begin_load_eliom_module ()
 608   in
 609   let postload () =
 610     Eliom_common.end_load_eliom_module ();
 611     config := []
 612   in
 613   try
 614     match cmo_or_name with
 615       | Files cmo -> Ocsigen_loader.loadfiles preload postload true cmo
 616       | Name name -> Ocsigen_loader.init_module preload postload true name
 617   with
 618     | Ocsigen_loader.Dynlink_error (n, e) ->
 619       raise (Eliom_common.Eliom_error_while_loading_site
 620                (Printf.sprintf "Eliom: while loading %s: %s"
 621                   n
 622                   (try handle_init_exn e
 623                    with e -> Printexc.to_string e)))
 624
 625
 626 (*****************************************************************************)
 627 (* If page has already been generated becauise there are several <eliom>
 628    tags in the same site:
 629 *)
 630 let gen_nothing () _ = Lwt.return Ocsigen_extensions.Ext_do_nothing
 631
 632
 633
 634 (*****************************************************************************)
 635 let default_module_action _ = failwith "default_module_action"
 636
 637 (** Parsing of config file for each site: *)
 638 let parse_config hostpattern conf_info site_dir =
 639 (*--- if we put the following line here: *)
 640   let sitedata = new_sitedata hostpattern site_dir conf_info in
 641 (*--- then there is one service tree for each <site> *)
 642 (*--- (mutatis mutandis for the following line:) *)
 643   Eliom_common.absolute_change_sitedata sitedata;
 644   let firsteliomtag = ref true in
 645   let rec parse_module_attrs file = function
 646     | [] -> file
 647     | ("name", s)::suite ->
 648         (match file with
 649            | None -> parse_module_attrs (Some (Name s)) suite
 650            | _ ->
 651                raise (Error_in_config_file
 652                         ("Duplicate attribute module in <eliom>")))
 653     | ("module", s)::suite ->
 654         (match file with
 655            | None -> parse_module_attrs (Some (Files [s])) suite
 656            | _ ->
 657                raise (Error_in_config_file
 658                         ("Duplicate attribute module in <eliom>")))
 659     | ("findlib-package", s)::suite ->
 660         begin match file with
 661           | None ->
 662               begin try
 663                 parse_module_attrs
 664                   (Some (Files (Ocsigen_loader.findfiles s))) suite
 665               with Ocsigen_loader.Findlib_error _ as e ->
 666                 raise (Error_in_config_file
 667                          (Printf.sprintf "Findlib error: %s"
 668                             (Printexc.to_string e)))
 669               end
 670           | _ -> raise (Error_in_config_file
 671                           ("Duplicate attribute module in <eliom>"))
 672         end
 673     | (s, _)::_ ->
 674         raise
 675           (Error_in_config_file ("Wrong attribute for <eliom>: "^s))
 676   in fun _ parse_site -> function
 677     | Element ("eliommodule", atts, content) ->
 678       Eliom_extensions.register_eliom_extension
 679         default_module_action;
 680       (match parse_module_attrs None atts with
 681         | Some file_or_name ->
 682           exception_during_eliommodule_loading := true;
 683           load_eliom_module sitedata file_or_name content;
 684           exception_during_eliommodule_loading := false
 685         | _ -> ());
 686       if Eliom_extensions.get_eliom_extension ()
 687         != default_module_action
 688       then
 689         Eliommod_pagegen.gen
 690           (Some (Eliom_extensions.get_eliom_extension ()))
 691           sitedata
 692       else gen_nothing ()
 693     | Element ("eliom", atts, content) ->
 694 (*--- if we put the line "new_sitedata" here, then there is
 695   one service table for each <eliom> tag ...
 696   I think the other one is the best,
 697   because it corresponds to the way
 698   browsers manage cookies (one cookie for one site).
 699   Thus we can have one site in several cmo (with one session).
 700  *)
 701         let set_timeout (f : ?fullsessname:Eliom_common.fullsessionname ->
 702                          ?cookie_scope:[< Eliom_common.cookie_scope ] ->
 703                          recompute_expdates:bool ->
 704                          bool -> bool -> Eliom_common.sitedata ->
 705                          float option -> unit)
 706             cookie_type state_name_oo v =
 707           let make_fullsessname state_name =
 708             let state_name : Eliom_common.scope_name =
 709               match state_name with
 710                 | None -> `Default_ref_name
 711                 | Some s when String.lowercase s = "default" -> `Default_ref_name
 712                 | Some s when String.lowercase s = "comet" -> `Default_comet_name
 713                 | Some s -> `String s
 714             in
 715             let scope =
 716               match cookie_type with
 717                 | `Session -> `Session state_name
 718                 | `Client_process -> `Client_process state_name
 719             in
 720             Eliom_common.make_fullsessname2
 721               sitedata.Eliom_common.site_dir_string
 722               scope
 723           in
 724           f
 725             ?fullsessname:(map_option make_fullsessname state_name_oo)
 726             ?cookie_scope:(Some cookie_type)
 727             ~recompute_expdates:false
 728             true
 729             true
 730             sitedata
 731             v
 732         in
 733         let oldipv6mask = sitedata.Eliom_common.ipv6mask in
 734         let content =
 735           parse_eliom_options
 736             ((fun ct snoo v ->
 737               set_timeout Eliommod_timeouts.set_global_data_timeout_ ct snoo v;
 738               set_timeout Eliommod_timeouts.set_global_service_timeout_ ct snoo v
 739              ),
 740              (set_timeout Eliommod_timeouts.set_global_data_timeout_),
 741              (set_timeout Eliommod_timeouts.set_global_service_timeout_),
 742              (set_timeout Eliommod_timeouts.set_global_persistent_timeout_),
 743              (fun v -> sitedata.Eliom_common.max_service_sessions_per_group <- v, true),
 744              (fun v -> sitedata.Eliom_common.max_service_sessions_per_subnet <- v, true),
 745              (fun v -> sitedata.Eliom_common.max_volatile_data_sessions_per_group <- v, true),
 746              (fun v -> sitedata.Eliom_common.max_volatile_data_sessions_per_subnet <- v, true),
 747              (fun v -> sitedata.Eliom_common.max_persistent_data_sessions_per_group <- Some v,true),
 748              (fun v -> sitedata.Eliom_common.max_service_tab_sessions_per_group <- v, true),
 749              (fun v -> sitedata.Eliom_common.max_volatile_data_tab_sessions_per_group <- v, true),
 750              (fun v -> sitedata.Eliom_common.max_persistent_data_tab_sessions_per_group <- Some v,true),
 751              (fun v -> sitedata.Eliom_common.max_anonymous_services_per_session <- v, true),
 752              (fun v ->
 753                 sitedata.Eliom_common.max_anonymous_services_per_subnet <- v, true;
 754                 (* The global table has already been created, with old max
 755                    and old ipv6mask.
 756                    I update it, otherwise the setting has no effect
 757                    for this table: *)
 758                 try
 759                   let dlist = Eliom_common.find_dlist_ip_table
 760                     sitedata.Eliom_common.ipv4mask (* unused *)
 761                     oldipv6mask
 762                     sitedata.Eliom_common.dlist_ip_table
 763                     Ip_address.inet6_addr_loopback
 764                   in
 765                   ignore (Ocsigen_cache.Dlist.set_maxsize dlist v)
 766                 with Not_found -> () (* should not occure *)
 767              ),
 768              (fun v ->
 769                ignore (Ocsigen_cache.Dlist.set_maxsize
 770                          sitedata.Eliom_common.group_of_groups v)),
 771              (fun v -> sitedata.Eliom_common.ipv4mask <- Some v, true),
 772              (fun v -> sitedata.Eliom_common.ipv6mask <- Some v, true)
 773             )
 774             content
 775         in
 776         (match parse_module_attrs None atts with
 777           | Some file_or_name ->
 778             exception_during_eliommodule_loading := true;
 779             load_eliom_module sitedata file_or_name content;
 780             exception_during_eliommodule_loading := false
 781           | _ -> ());
 782         (* We must generate the page only if it is the first <eliom> tag
 783            for that site: *)
 784         if !firsteliomtag
 785         then begin
 786           firsteliomtag := false;
 787           Eliommod_pagegen.gen None sitedata
 788         end
 789         else
 790           gen_nothing ()
 791     | Element (t, _, _) ->
 792         raise (Ocsigen_extensions.Bad_config_tag_for_extension t)
 793     | _ -> raise (Error_in_config_file "(Eliommod extension)")
 794
 795
 796
 797 (*****************************************************************************)
 798 (** extension registration *)
 799 let () =
 800   register_extension
 801     ~name:"eliom"
 802     ~fun_site:parse_config
 803     ~end_init
 804     ~exn_handler:handle_init_exn
 805     ~init_fun:parse_global_config
 806     ()
 807