Attention une mise à jour du serveur va être effectuée le lundi 17 mai entre 13h et 13h30. Cette mise à jour va générer une interruption du service de quelques minutes.

Commit a9e8f543 authored by Stephane Glondu's avatar Stephane Glondu

Remove election_table and register_election

parent e17fa8d0
...@@ -73,14 +73,11 @@ let election_pktokens = Ocsipersist.open_table "site_pktokens" ...@@ -73,14 +73,11 @@ let election_pktokens = Ocsipersist.open_table "site_pktokens"
(* Table with tokens given to credential authorities. *) (* Table with tokens given to credential authorities. *)
let election_credtokens = Ocsipersist.open_table "site_credtokens" let election_credtokens = Ocsipersist.open_table "site_credtokens"
(* In-memory table, indexed by UUID, contains closures. *)
let election_table = ref SMap.empty
module T = Web_templates module T = Web_templates
let register_election params web_params = let web_election_data (raw_election, web_params) =
let params = Group.election_params_of_string raw_election in
let module P = (val params : ELECTION_PARAMS) in let module P = (val params : ELECTION_PARAMS) in
let uuid = Uuidm.to_string P.params.e_uuid in
let module D = struct let module D = struct
module G = P.G module G = P.G
let election = { let election = {
...@@ -90,12 +87,11 @@ let register_election params web_params = ...@@ -90,12 +87,11 @@ let register_election params web_params =
} }
include (val web_params : WEB_PARAMS) include (val web_params : WEB_PARAMS)
end in end in
let module W = Web_election.Make (D) (LwtRandom) in (module D : WEB_ELECTION_DATA)
let election = (module W : WEB_ELECTION) in
fun () -> let find_election uuid =
(* starting from here, we do side-effects on the running server *) lwt x = Ocsipersist.find election_ptable uuid in
election_table := SMap.add uuid election !election_table; return (web_election_data x)
election
(* Mutex to avoid simultaneous registrations of the same election *) (* Mutex to avoid simultaneous registrations of the same election *)
let registration_mutex = Lwt_mutex.create () let registration_mutex = Lwt_mutex.create ()
...@@ -136,7 +132,6 @@ let import_election f = ...@@ -136,7 +132,6 @@ let import_election f =
let dir = dir let dir = dir
end in end in
let web_params = (module X : WEB_PARAMS) in let web_params = (module X : WEB_PARAMS) in
let do_register = register_election params web_params in
let module G = P.G in let module G = P.G in
let module KG = Election.MakeSimpleDistKeyGen (G) (LwtRandom) in let module KG = Election.MakeSimpleDistKeyGen (G) (LwtRandom) in
let public_keys = Lwt_io.lines_of_file f.f_public_keys in let public_keys = Lwt_io.lines_of_file f.f_public_keys in
...@@ -189,8 +184,8 @@ let import_election f = ...@@ -189,8 +184,8 @@ let import_election f =
Lwt_io.(with_file Output (dir/"voters.txt") (fun oc -> Lwt_io.(with_file Output (dir/"voters.txt") (fun oc ->
write_lines oc voters write_lines oc voters
)) >> )) >>
let election = do_register () in let election = web_election_data (raw_election, web_params) in
let module W = (val election : WEB_ELECTION) in let module W = Web_election.Make ((val election)) (LwtRandom) in
lwt () = lwt () =
match W.D.metadata.e_auth_config with match W.D.metadata.e_auth_config with
| None -> return () | None -> return ()
...@@ -212,7 +207,7 @@ let import_election f = ...@@ -212,7 +207,7 @@ let import_election f =
W.B.update_files () >> W.B.update_files () >>
Ocsipersist.add election_ptable uuid (raw_election, web_params) >> Ocsipersist.add election_ptable uuid (raw_election, web_params) >>
let () = Lwt_mutex.unlock registration_mutex in let () = Lwt_mutex.unlock registration_mutex in
return election return (module W : WEB_ELECTION)
with e -> with e ->
lwt () = lwt () =
try_lwt delete_shallow_directory dir try_lwt delete_shallow_directory dir
...@@ -233,20 +228,6 @@ let import_election f = ...@@ -233,20 +228,6 @@ let import_election f =
Lwt_mutex.unlock registration_mutex; Lwt_mutex.unlock registration_mutex;
Lwt.fail e Lwt.fail e
lwt () =
Ocsipersist.iter_step (fun uuid (raw_election, web_params) ->
let params = Group.election_params_of_string raw_election in
let do_register = register_election params web_params in
let election = do_register () in
let module W = (val election : WEB_ELECTION) in
let module W = W.D in
assert (uuid = Uuidm.to_string W.election.e_params.e_uuid);
Ocsigen_messages.debug (fun () ->
Printf.sprintf "Initialized election %s from persistent store" uuid
);
return ()
) election_ptable
let () = Any.register ~service:home let () = Any.register ~service:home
(fun () () -> (fun () () ->
Eliom_reference.unset Web_auth_state.cont >> Eliom_reference.unset Web_auth_state.cont >>
...@@ -263,22 +244,20 @@ let () = Html5.register ~service:admin ...@@ -263,22 +244,20 @@ let () = Html5.register ~service:admin
| None -> return None | None -> return None
| Some u -> | Some u ->
lwt elections, tallied = lwt elections, tallied =
SMap.fold (fun _ w accu -> Ocsipersist.fold_step (fun uuid_s (_, web_params) accu ->
let module W = (val w : WEB_ELECTION) in let module W = (val web_params : WEB_PARAMS) in
let module W = W.D in
let w = (module W : WEB_ELECTION_DATA) in
if W.metadata.e_owner = Some u then ( if W.metadata.e_owner = Some u then (
let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in lwt w = find_election uuid_s in
lwt state = Web_persist.get_election_state uuid_s in lwt state = Web_persist.get_election_state uuid_s in
lwt date = Web_persist.get_election_date uuid_s in lwt date = Web_persist.get_election_date uuid_s in
lwt elections, tallied = accu in let elections, tallied = accu in
match state with match state with
| `Tallied _ -> return (elections, (date, w) :: tallied) | `Tallied _ -> return (elections, (date, w) :: tallied)
| _ -> return ((date, w) :: elections, tallied) | _ -> return ((date, w) :: elections, tallied)
) else ( ) else (
accu return accu
) )
) !election_table (return ([], [])) ) election_ptable ([], [])
and setup_elections = and setup_elections =
Ocsipersist.fold_step (fun k v accu -> Ocsipersist.fold_step (fun k v accu ->
if v.se_owner = u if v.se_owner = u
...@@ -539,9 +518,8 @@ let () = ...@@ -539,9 +518,8 @@ let () =
~service:election_regenpwd_post ~service:election_regenpwd_post
(fun (uuid, ()) user -> (fun (uuid, ()) user ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w : WEB_ELECTION) in let module W = (val w) in
let module W = W.D in
lwt site_user = Web_auth_state.get_site_user () in lwt site_user = Web_auth_state.get_site_user () in
match site_user with match site_user with
| Some u when W.metadata.e_owner = Some u -> | Some u when W.metadata.e_owner = Some u ->
...@@ -987,10 +965,9 @@ let () = ...@@ -987,10 +965,9 @@ let () =
~service:election_home ~service:election_home
(fun (uuid, ()) () -> (fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
try try_lwt
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w : WEB_ELECTION) in let module W = (val w) in
let module W = W.D in
Eliom_reference.unset Web_services.ballot >> Eliom_reference.unset Web_services.ballot >>
let cont () = let cont () =
Redirection.send Redirection.send
...@@ -1015,10 +992,9 @@ let () = ...@@ -1015,10 +992,9 @@ let () =
~service:election_admin ~service:election_admin
(fun (uuid, ()) () -> (fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
lwt site_user = Web_auth_state.get_site_user () in lwt site_user = Web_auth_state.get_site_user () in
let module W = (val w : WEB_ELECTION) in let module W = (val w) in
let module W = W.D in
let uuid = Uuidm.to_string W.election.e_params.e_uuid in let uuid = Uuidm.to_string W.election.e_params.e_uuid in
match site_user with match site_user with
| Some u when W.metadata.e_owner = Some u -> | Some u when W.metadata.e_owner = Some u ->
...@@ -1029,9 +1005,8 @@ let () = ...@@ -1029,9 +1005,8 @@ let () =
let election_set_state state (uuid, ()) () = let election_set_state state (uuid, ()) () =
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w : WEB_ELECTION) in let module W = (val w) in
let module W = W.D in
lwt () = lwt () =
match_lwt Web_auth_state.get_site_user () with match_lwt Web_auth_state.get_site_user () with
| Some u when W.metadata.e_owner = Some u -> return () | Some u when W.metadata.e_owner = Some u -> return ()
...@@ -1054,10 +1029,9 @@ let () = ...@@ -1054,10 +1029,9 @@ let () =
~service:election_update_credential ~service:election_update_credential
(fun (uuid, ()) () -> (fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
lwt site_user = Web_auth_state.get_site_user () in lwt site_user = Web_auth_state.get_site_user () in
let module W = (val w : WEB_ELECTION) in let module W = (val w) in
let module W = W.D in
match site_user with match site_user with
| Some u -> | Some u ->
if W.metadata.e_owner = Some u then ( if W.metadata.e_owner = Some u then (
...@@ -1072,9 +1046,9 @@ let () = ...@@ -1072,9 +1046,9 @@ let () =
~service:election_update_credential_post ~service:election_update_credential_post
(fun (uuid, ()) (old, new_) -> (fun (uuid, ()) (old, new_) ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
lwt site_user = Web_auth_state.get_site_user () in lwt site_user = Web_auth_state.get_site_user () in
let module W = (val w : WEB_ELECTION) in let module W = Web_election.Make ((val w)) (LwtRandom) in
let module B = W.B in let module B = W.B in
let module W = W.D in let module W = W.D in
match site_user with match site_user with
...@@ -1096,8 +1070,8 @@ let () = ...@@ -1096,8 +1070,8 @@ let () =
~service:election_vote ~service:election_vote
(fun (uuid, ()) () -> (fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w : WEB_ELECTION) in let module W = (val w) in
Eliom_reference.unset Web_services.ballot >> Eliom_reference.unset Web_services.ballot >>
Redirection.send Redirection.send
(Eliom_service.preapply (Eliom_service.preapply
...@@ -1111,9 +1085,8 @@ let () = ...@@ -1111,9 +1085,8 @@ let () =
~service:election_cast ~service:election_cast
(fun (uuid, ()) () -> (fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w : WEB_ELECTION) in let module W = (val w) in
let module W = W.D in
let cont () = let cont () =
Redirection.send Redirection.send
(Eliom_service.preapply (Eliom_service.preapply
...@@ -1129,9 +1102,8 @@ let () = ...@@ -1129,9 +1102,8 @@ let () =
~service:election_cast_post ~service:election_cast_post
(fun (uuid, ()) (ballot_raw, ballot_file) -> (fun (uuid, ()) (ballot_raw, ballot_file) ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w : WEB_ELECTION) in let module W = (val w) in
let module W = W.D in
lwt user = Web_auth_state.get_election_user uuid in lwt user = Web_auth_state.get_election_user uuid in
lwt the_ballot = match ballot_raw, ballot_file with lwt the_ballot = match ballot_raw, ballot_file with
| Some ballot, None -> return ballot | Some ballot, None -> return ballot
...@@ -1160,8 +1132,8 @@ let () = ...@@ -1160,8 +1132,8 @@ let () =
~service:election_cast_confirm ~service:election_cast_confirm
(fun (uuid, ()) () -> (fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w : WEB_ELECTION) in let module W = Web_election.Make ((val w)) (LwtRandom) in
let module B = W.B in let module B = W.B in
let module W = W.D in let module W = W.D in
match_lwt Eliom_reference.get Web_services.ballot with match_lwt Eliom_reference.get Web_services.ballot with
...@@ -1190,8 +1162,8 @@ let () = ...@@ -1190,8 +1162,8 @@ let () =
~service:election_pretty_ballots ~service:election_pretty_ballots
(fun ((uuid, ()), start) () -> (fun ((uuid, ()), start) () ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w : WEB_ELECTION) in let module W = Web_election.Make ((val w)) (LwtRandom) in
let module B = W.B in let module B = W.B in
let module W = W.D in let module W = W.D in
lwt res, _ = lwt res, _ =
...@@ -1208,8 +1180,8 @@ let () = ...@@ -1208,8 +1180,8 @@ let () =
~service:election_pretty_ballot ~service:election_pretty_ballot
(fun ((uuid, ()), hash) () -> (fun ((uuid, ()), hash) () ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w : WEB_ELECTION) in let module W = Web_election.Make ((val w)) (LwtRandom) in
lwt ballot = lwt ballot =
W.B.Ballots.fold W.B.Ballots.fold
(fun h b accu -> (fun h b accu ->
...@@ -1228,9 +1200,8 @@ let () = ...@@ -1228,9 +1200,8 @@ let () =
~service:election_missing_voters ~service:election_missing_voters
(fun (uuid, ()) () -> (fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w : WEB_ELECTION) in let module W = (val w) in
let module W = W.D in
lwt () = lwt () =
match_lwt Web_auth_state.get_site_user () with match_lwt Web_auth_state.get_site_user () with
| Some u when W.metadata.e_owner = Some u -> return () | Some u when W.metadata.e_owner = Some u -> return ()
...@@ -1263,9 +1234,8 @@ let () = ...@@ -1263,9 +1234,8 @@ let () =
~service:election_tally_trustees ~service:election_tally_trustees
(fun (uuid, ((), trustee_id)) () -> (fun (uuid, ((), trustee_id)) () ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w : WEB_ELECTION) in let module W = (val w) in
let module W = W.D in
lwt () = lwt () =
match_lwt Web_persist.get_election_state uuid_s with match_lwt Web_persist.get_election_state uuid_s with
| `EncryptedTally _ -> return () | `EncryptedTally _ -> return ()
...@@ -1297,8 +1267,8 @@ let () = ...@@ -1297,8 +1267,8 @@ let () =
lwt () = lwt () =
if trustee_id > 0 then return () else fail_http 404 if trustee_id > 0 then return () else fail_http 404
in in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w : WEB_ELECTION) in let module W = Web_election.Make ((val w)) (LwtRandom) in
let module E = W.E in let module E = W.E in
let module W = W.D in let module W = W.D in
let pks = W.dir / string_of_election_file ESKeys in let pks = W.dir / string_of_election_file ESKeys in
...@@ -1331,8 +1301,8 @@ let () = ...@@ -1331,8 +1301,8 @@ let () =
let handle_election_tally_release (uuid, ()) () = let handle_election_tally_release (uuid, ()) () =
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w) in let module W = Web_election.Make ((val w)) (LwtRandom) in
let module E = W.E in let module E = W.E in
let module W = W.D in let module W = W.D in
lwt () = lwt () =
...@@ -1380,8 +1350,7 @@ let content_type_of_file = function ...@@ -1380,8 +1350,7 @@ let content_type_of_file = function
| ESCreds | ESRecords | ESVoters -> "text/plain" | ESCreds | ESRecords | ESVoters -> "text/plain"
let handle_pseudo_file w u f site_user = let handle_pseudo_file w u f site_user =
let module W = (val w : WEB_ELECTION) in let module W = (val w : WEB_ELECTION_DATA) in
let module W = W.D in
let confidential = let confidential =
match f with match f with
| ESRaw | ESKeys | ESBallots | ESETally | ESResult | ESCreds -> false | ESRaw | ESKeys | ESBallots | ESETally | ESResult | ESCreds -> false
...@@ -1402,9 +1371,9 @@ let () = ...@@ -1402,9 +1371,9 @@ let () =
~service:election_dir ~service:election_dir
(fun (uuid, f) () -> (fun (uuid, f) () ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
lwt site_user = Web_auth_state.get_site_user () in lwt site_user = Web_auth_state.get_site_user () in
let module W = (val w : WEB_ELECTION) in let module W = (val w) in
handle_pseudo_file w () f site_user) handle_pseudo_file w () f site_user)
let () = let () =
...@@ -1412,8 +1381,8 @@ let () = ...@@ -1412,8 +1381,8 @@ let () =
~service:election_compute_encrypted_tally ~service:election_compute_encrypted_tally
(fun (uuid, ()) () -> (fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in lwt w = find_election uuid_s in
let module W = (val w : WEB_ELECTION) in let module W = Web_election.Make ((val w)) (LwtRandom) in
let module E = W.E in let module E = W.E in
let module B = W.B in let module B = W.B in
let module W = W.D in let module W = W.D in
......
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