Split Registration into Web_site and Web_main

src/web/server.mllib

@@ -10,4 +10,5 @@ Auth_cas
 Web_election
 Election
 Templates
-Registration
+Web_site
+Web_main

src/web/registration.ml → src/web/web_main.ml

@@ -142,122 +142,27 @@ lwt election_configs =
   Lwt_list.map_p parse_election_dir !data_dirs >>=
   wrap1 List.flatten
 
-(** Build up the site *)
-
-module Site : SITE_SERVICES = struct
-  open Eliom_service
-  open Eliom_registration
-
-  module Auth = Auth_common.Make (struct
-    let name = "site"
-    let path = []
-    let instances = !auth_instances
-  end)
-
-  let main_election = ref None
-  let featured = ref []
-
-  (* The following reference is there to cut a dependency loop:
-     S.register_election depends on S (via Templates). It will be set
-     to a proper value once we have called Templates.Make. *)
-
-  let register_election_ref = ref (fun _ -> assert false)
-
-  (* We use an intermediate module S that will be passed to Templates
-     and Web_election. S is not meant to leak and will be included
-     in the returned module later. *)
-
-  module S : SITE_SERVICES = struct
-    include Auth.Services
-    open Eliom_parameter
-
-    let home = service
-      ~path:[]
-      ~get_params:unit
-      ()
-
-    let source_code = service
-      ~path:["belenios.tar.gz"]
-      ~get_params:unit
-      ()
-
-    let get_randomness = service
-      ~path:["get-randomness"]
-      ~get_params:unit
-      ()
-
-    let saved_service = Eliom_reference.eref
-      ~scope:Eliom_common.default_session_scope
-      (module struct let s = home end : SAVED_SERVICE)
-
-    let register_election config = !register_election_ref config
-
-    let cont () =
-      lwt x = Eliom_reference.get saved_service in
-      let module X = (val x : SAVED_SERVICE) in
-      return X.s
-
-  end
-
-  include S
-
-  module T = Templates.Make (S)
-
-  let () = register_election_ref := fun config ->
-    let registration = Web_election.make config in
-    let module R = (val registration : Web_election.REGISTRATION) in
-    let module W = R.W in
-    let module X : EMPTY = R.Register (S) (T.Election (W)) in
-    let election = (module W : WEB_ELECTION) in
-    let u = W.election.e_params.e_uuid in
-    if !main_election_uuid = Some u then main_election := Some election;
-    if W.featured then featured := election :: !featured;
-    return election
-
-  let () = let module X : EMPTY = Auth.Register (S) (T) in ()
-
-  let () = Any.register ~service:home
-    (fun () () ->
-      Eliom_reference.unset saved_service >>
-      match !main_election with
-      | None ->
-        T.home ~featured:!featured () >>= Html5.send
-      | Some w ->
-        let module W = (val w : WEB_ELECTION) in
-        Redirection.send W.S.home
-    )
-
-  let () = File.register
-    ~service:source_code
-    ~content_type:"application/x-gzip"
-    (fun () () -> match !source_file with
-    | None -> fail_http 404
-    | Some f -> return f
+lwt source_file =
+  match !source_file with
+  | Some f ->
+    lwt b = file_exists f in
+    if b then (
+      return f
+    ) else (
+      Printf.ksprintf failwith "file %s does not exist" f
     )
+  | None -> failwith "missing <source> in configuration"
 
-  let do_get_randomness =
-    let prng = Lazy.lazy_from_fun (Lwt_preemptive.detach (fun () ->
-      Cryptokit.Random.(pseudo_rng (string secure_rng 16))
-    )) in
-    let mutex = Lwt_mutex.create () in
-    fun () ->
-      Lwt_mutex.with_lock mutex (fun () ->
-        lwt prng = Lazy.force prng in
-        return Cryptokit.Random.(string prng 32)
-      )
-
-  let () = String.register
-    ~service:get_randomness
-    (fun () () ->
-      lwt r = do_get_randomness () in
-      Cryptokit.(transform_string (Base64.encode_compact ()) r) |>
-      (fun x -> string_of_randomness { randomness=x }) |>
-      (fun x -> return (x, "application/json"))
-    )
+(** Build up the site *)
 
+module Site_config = struct
+  let name = "site"
+  let path = []
+  let source_file = source_file
+  let instances = !auth_instances
 end
 
-
+module Site = Web_site.Make (Site_config)
 
 let populate accu f s = Lwt_stream.fold_s f s accu
 
@@ -265,6 +170,11 @@ lwt () =
   Lwt_list.iter_s (fun (config, public_creds_fname) ->
     lwt election = Site.register_election config in
     let module W = (val election : WEB_ELECTION) in
+    (match !main_election_uuid with
+    | Some u when u = W.election.e_params.e_uuid ->
+      Site.set_main_election election
+    | _ -> ()
+    );
     lwt public_creds =
       Lwt_io.lines_of_file public_creds_fname |>
       populate SSet.empty (fun c accu ->

src/web/web_signatures.mli

@@ -262,7 +262,11 @@ module type SITE_SERVICES = sig
   include CORE_SERVICES
   include CONT_SERVICE
   include AUTH_SERVICES
+
   val register_election : election_config -> (module WEB_ELECTION) Lwt.t
+
+  val set_main_election : (module WEB_ELECTION) -> unit
+  val unset_main_election : unit -> unit
 end
 
 module type TEMPLATES = sig

src/web/web_site.ml

+(**************************************************************************)
+(*                                BELENIOS                                *)
+(*                                                                        *)
+(*  Copyright © 2012-2014 Inria                                           *)
+(*                                                                        *)
+(*  This program is free software: you can redistribute it and/or modify  *)
+(*  it under the terms of the GNU Affero General Public License as        *)
+(*  published by the Free Software Foundation, either version 3 of the    *)
+(*  License, or (at your option) any later version, with the additional   *)
+(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
+(*                                                                        *)
+(*  This program is distributed in the hope that it will be useful, but   *)
+(*  WITHOUT ANY WARRANTY; without even the implied warranty of            *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *)
+(*  Affero General Public License for more details.                       *)
+(*                                                                        *)
+(*  You should have received a copy of the GNU Affero General Public      *)
+(*  License along with this program.  If not, see                         *)
+(*  <http://www.gnu.org/licenses/>.                                       *)
+(**************************************************************************)
+
+open Lwt
+open Util
+open Serializable_t
+open Signatures
+open Web_serializable_j
+open Web_common
+open Web_signatures
+
+module type CONFIG = sig
+  val name : string
+  val path : string list
+  val source_file : string
+  val instances : Auth_common.auth_instance list
+end
+
+module Make (C : CONFIG) : SITE_SERVICES = struct
+  open Eliom_service
+  open Eliom_registration
+
+  module Auth = Auth_common.Make (C)
+
+  let main_election = ref None
+  let featured = ref []
+
+  (* The following reference is there to cut a dependency loop:
+     S.register_election depends on S (via Templates). It will be set
+     to a proper value once we have called Templates.Make. *)
+
+  let register_election_ref = ref (fun _ -> assert false)
+
+  (* We use an intermediate module S that will be passed to Templates
+     and Web_election. S is not meant to leak and will be included
+     in the returned module later. *)
+
+  module S : SITE_SERVICES = struct
+    include Auth.Services
+    open Eliom_parameter
+
+    let home = service
+      ~path:[]
+      ~get_params:unit
+      ()
+
+    let source_code = service
+      ~path:["belenios.tar.gz"]
+      ~get_params:unit
+      ()
+
+    let get_randomness = service
+      ~path:["get-randomness"]
+      ~get_params:unit
+      ()
+
+    let saved_service = Eliom_reference.eref
+      ~scope:Eliom_common.default_session_scope
+      (module struct let s = home end : SAVED_SERVICE)
+
+    let cont () =
+      lwt x = Eliom_reference.get saved_service in
+      let module X = (val x : SAVED_SERVICE) in
+      return X.s
+
+    let register_election config = !register_election_ref config
+
+    let set_main_election x = main_election := Some x
+    let unset_main_election () = main_election := None
+
+  end
+
+  include S
+
+  module T = Templates.Make (S)
+
+  let () = register_election_ref := fun config ->
+    let registration = Web_election.make config in
+    let module R = (val registration : Web_election.REGISTRATION) in
+    let module W = R.W in
+    let module X : EMPTY = R.Register (S) (T.Election (W)) in
+    let election = (module W : WEB_ELECTION) in
+    if W.featured then featured := election :: !featured;
+    return election
+
+  let () = let module X : EMPTY = Auth.Register (S) (T) in ()
+
+  let () = Any.register ~service:home
+    (fun () () ->
+      Eliom_reference.unset saved_service >>
+      match !main_election with
+      | None ->
+        T.home ~featured:!featured () >>= Html5.send
+      | Some w ->
+        let module W = (val w : WEB_ELECTION) in
+        Redirection.send W.S.home
+    )
+
+  let () = File.register
+    ~service:source_code
+    ~content_type:"application/x-gzip"
+    (fun () () -> return C.source_file)
+
+  let do_get_randomness =
+    let prng = Lazy.lazy_from_fun (Lwt_preemptive.detach (fun () ->
+      Cryptokit.Random.(pseudo_rng (string secure_rng 16))
+    )) in
+    let mutex = Lwt_mutex.create () in
+    fun () ->
+      Lwt_mutex.with_lock mutex (fun () ->
+        lwt prng = Lazy.force prng in
+        return Cryptokit.Random.(string prng 32)
+      )
+
+  let () = String.register
+    ~service:get_randomness
+    (fun () () ->
+      lwt r = do_get_randomness () in
+      Cryptokit.(transform_string (Base64.encode_compact ()) r) |>
+      (fun x -> string_of_randomness { randomness=x }) |>
+      (fun x -> return (x, "application/json"))
+    )
+
+end

src/web/web_site.mli

+(**************************************************************************)
+(*                                BELENIOS                                *)
+(*                                                                        *)
+(*  Copyright © 2012-2014 Inria                                           *)
+(*                                                                        *)
+(*  This program is free software: you can redistribute it and/or modify  *)
+(*  it under the terms of the GNU Affero General Public License as        *)
+(*  published by the Free Software Foundation, either version 3 of the    *)
+(*  License, or (at your option) any later version, with the additional   *)
+(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
+(*                                                                        *)
+(*  This program is distributed in the hope that it will be useful, but   *)
+(*  WITHOUT ANY WARRANTY; without even the implied warranty of            *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *)
+(*  Affero General Public License for more details.                       *)
+(*                                                                        *)
+(*  You should have received a copy of the GNU Affero General Public      *)
+(*  License along with this program.  If not, see                         *)
+(*  <http://www.gnu.org/licenses/>.                                       *)
+(**************************************************************************)
+
+open Web_signatures
+
+module type CONFIG = sig
+  val name : string
+  val path : string list
+  val source_file : string
+  val instances : Auth_common.auth_instance list
+end
+
+module Make (C : CONFIG) : SITE_SERVICES