Commit f8020dc2 authored by Stephane Glondu's avatar Stephane Glondu

Remove one layer of functors in Web_site

parent af078a49
......@@ -11,10 +11,10 @@ Web_serializable_j
Web_common
Web_services
Web_auth
Web_election
Web_site
Web_templates
Auth_dummy
Auth_password
Auth_cas
Web_templates
Web_election
Web_site
Web_main
......@@ -117,22 +117,15 @@ let spool_dir =
(** Build up the site *)
module Site_config = struct
let name = "site"
let path = []
let source_file = source_file
let spool_dir = spool_dir
end
module Site = Web_site.Make (Site_config)
let () = Site.install_authentication !auth_instances
let () = Web_site.source_file := source_file
let () = Web_site.spool_dir := spool_dir
let () = Web_site.install_authentication !auth_instances
lwt () =
Lwt_list.iter_s (fun dir ->
read_election_dir dir >>=
Lwt_list.iter_s (fun (f, featured) ->
match_lwt Site.import_election f with
match_lwt Web_site.import_election f with
| None ->
Ocsigen_messages.debug (fun () ->
Printf.sprintf "Ignored: %s" f.f_election
......@@ -143,12 +136,12 @@ lwt () =
let module W = (val w : WEB_ELECTION) in
if featured then (
let uuid = Uuidm.to_string W.election.e_params.e_uuid in
Site.add_featured_election uuid
Web_site.add_featured_election uuid
) else return ()
)
) !import_dirs
lwt () =
match !main_election_uuid with
| Some uuid -> Site.set_main_election uuid
| Some uuid -> Web_site.set_main_election uuid
| _ -> return ()
......@@ -29,12 +29,8 @@ open Web_common
open Web_signatures
open Web_services
module type CONFIG = sig
val name : string
val path : string list
val source_file : string
val spool_dir : string
end
let source_file = ref "belenios.tar.gz"
let spool_dir = ref "."
let rec list_remove x = function
| [] -> []
......@@ -62,12 +58,12 @@ let delete_shallow_directory dir =
in
Lwt_unix.rmdir dir
module Make (C : CONFIG) : SITE = struct
open Eliom_service
open Eliom_registration
module C = struct
include C
let name = "site"
let path = []
let kind = `Site
end
......@@ -213,7 +209,7 @@ module Make (C : CONFIG) : SITE = struct
Lwt_mutex.unlock registration_mutex;
return None
) else (
let dir = C.spool_dir/uuid in
let dir = !spool_dir/uuid in
lwt metadata =
Lwt_io.chars_of_file f.f_metadata |>
Lwt_stream.to_string >>=
......@@ -366,7 +362,7 @@ module Make (C : CONFIG) : SITE = struct
let () = File.register
~service:source_code
~content_type:"application/x-gzip"
(fun () () -> return C.source_file)
(fun () () -> return !source_file)
let do_get_randomness =
let prng = Lazy.lazy_from_fun (Lwt_preemptive.detach (fun () ->
......@@ -572,7 +568,7 @@ module Make (C : CONFIG) : SITE = struct
~content_type:"text/plain"
(fun token () ->
lwt uuid = Ocsipersist.find election_credtokens token in
return (C.spool_dir / uuid ^ ".public_creds.txt")
return (!spool_dir / uuid ^ ".public_creds.txt")
)
let wrap_handler f =
......@@ -584,7 +580,7 @@ module Make (C : CONFIG) : SITE = struct
lwt uuid = Ocsipersist.find election_credtokens token in
lwt se = Ocsipersist.find election_stable uuid in
let module G = (val Group.of_string se.se_group : GROUP) in
let fname = C.spool_dir / uuid ^ ".public_creds.txt" in
let fname = !spool_dir / uuid ^ ".public_creds.txt" in
Lwt_mutex.with_lock
election_setup_mutex
(fun () ->
......@@ -694,10 +690,10 @@ module Make (C : CONFIG) : SITE = struct
e_short_name = template.t_short_name;
} in
let files = {
f_election = C.spool_dir / uuid_s ^ ".election.json";
f_metadata = C.spool_dir / uuid_s ^ ".metadata.json";
f_public_keys = C.spool_dir / uuid_s ^ ".public_keys.jsons";
f_public_creds = C.spool_dir / uuid_s ^ ".public_creds.txt";
f_election = !spool_dir / uuid_s ^ ".election.json";
f_metadata = !spool_dir / uuid_s ^ ".metadata.json";
f_public_keys = !spool_dir / uuid_s ^ ".public_keys.jsons";
f_public_creds = !spool_dir / uuid_s ^ ".public_creds.txt";
} in
lwt _ =
try_lwt Lwt_unix.stat files.f_public_creds
......@@ -863,5 +859,3 @@ module Make (C : CONFIG) : SITE = struct
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
W.Z.election_dir f x)
end
......@@ -22,11 +22,7 @@
open Web_serializable_t
open Web_signatures
module type CONFIG = sig
val name : string
val path : string list
val source_file : string
val spool_dir : string
end
val source_file : string ref
val spool_dir : string ref
module Make (C : CONFIG) : SITE
include SITE
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment