Attention une mise à jour du serveur va être effectuée le vendredi 16 avril entre 12h et 12h30. Cette mise à jour va générer une interruption du service de quelques minutes.

Commit f140b130 authored by Stephane Glondu's avatar Stephane Glondu

Threshold: election finalization + running

parent 5dce1128
...@@ -127,6 +127,7 @@ let set_rewrite_prefix ~src ~dst = ...@@ -127,6 +127,7 @@ let set_rewrite_prefix ~src ~dst =
type election_file = type election_file =
| ESRaw | ESRaw
| ESKeys | ESKeys
| ESTParams
| ESCreds | ESCreds
| ESBallots | ESBallots
| ESVoters | ESVoters
...@@ -137,6 +138,7 @@ type election_file = ...@@ -137,6 +138,7 @@ type election_file =
let election_file_of_string = function let election_file_of_string = function
| "election.json" -> ESRaw | "election.json" -> ESRaw
| "public_keys.jsons" -> ESKeys | "public_keys.jsons" -> ESKeys
| "threshold.json" -> ESTParams
| "public_creds.txt" -> ESCreds | "public_creds.txt" -> ESCreds
| "ballots.jsons" -> ESBallots | "ballots.jsons" -> ESBallots
| "records" -> ESRecords | "records" -> ESRecords
...@@ -148,6 +150,7 @@ let election_file_of_string = function ...@@ -148,6 +150,7 @@ let election_file_of_string = function
let string_of_election_file = function let string_of_election_file = function
| ESRaw -> "election.json" | ESRaw -> "election.json"
| ESKeys -> "public_keys.jsons" | ESKeys -> "public_keys.jsons"
| ESTParams -> "threshold.json"
| ESCreds -> "public_creds.txt" | ESCreds -> "public_creds.txt"
| ESBallots -> "ballots.jsons" | ESBallots -> "ballots.jsons"
| ESRecords -> "records" | ESRecords -> "records"
......
...@@ -61,6 +61,7 @@ val set_rewrite_prefix : src:string -> dst:string -> unit ...@@ -61,6 +61,7 @@ val set_rewrite_prefix : src:string -> dst:string -> unit
type election_file = type election_file =
| ESRaw | ESRaw
| ESKeys | ESKeys
| ESTParams
| ESCreds | ESCreds
| ESBallots | ESBallots
| ESVoters | ESVoters
......
...@@ -153,6 +153,13 @@ let get_public_keys uuid = ...@@ -153,6 +153,13 @@ let get_public_keys uuid =
return @@ Some lines return @@ Some lines
with _ -> return_none with _ -> return_none
let get_threshold uuid =
try%lwt
Lwt_io.chars_of_file (!spool_dir / uuid / "threshold.json") |>
Lwt_stream.to_string >>= fun x ->
return (Some x)
with _ -> return_none
module Ballots = Map.Make (String) module Ballots = Map.Make (String)
module BallotsCacheTypes = struct module BallotsCacheTypes = struct
......
...@@ -51,6 +51,7 @@ val get_elections_by_owner : user -> string list Lwt.t ...@@ -51,6 +51,7 @@ val get_elections_by_owner : user -> string list Lwt.t
val get_voters : string -> string list option Lwt.t val get_voters : string -> string list option Lwt.t
val get_passwords : string -> (string * string) SMap.t option Lwt.t val get_passwords : string -> (string * string) SMap.t option Lwt.t
val get_public_keys : string -> string list option Lwt.t val get_public_keys : string -> string list option Lwt.t
val get_threshold : string -> string option Lwt.t
val get_ballot_hashes : uuid:string -> string list Lwt.t val get_ballot_hashes : uuid:string -> string list Lwt.t
val get_ballot_by_hash : uuid:string -> hash:string -> string option Lwt.t val get_ballot_by_hash : uuid:string -> hash:string -> string option Lwt.t
...@@ -107,24 +107,49 @@ let finalize_election uuid se = ...@@ -107,24 +107,49 @@ let finalize_election uuid se =
(* trustees *) (* trustees *)
let group = Group.of_string se.se_group in let group = Group.of_string se.se_group in
let module G = (val group : GROUP) in let module G = (val group : GROUP) in
let module KG = Trustees.MakeSimple (G) (LwtRandom) in let%lwt y, trustees, pk_or_tp, private_keys =
let%lwt trustees, public_keys, private_key = match se.se_threshold_trustees with
match se.se_public_keys with | None ->
| [] -> let module KG = Trustees.MakeSimple (G) (LwtRandom) in
let%lwt private_key = KG.generate () in let%lwt trustees, public_keys, private_key =
let%lwt public_key = KG.prove private_key in match se.se_public_keys with
return (None, [public_key], Some private_key) | [] ->
| _ :: _ -> let%lwt private_key = KG.generate () in
return ( let%lwt public_key = KG.prove private_key in
Some (List.map (fun {st_id; _} -> st_id) se.se_public_keys), return (None, [public_key], `KEY private_key)
(List.map | _ :: _ ->
(fun {st_public_key; _} -> return (
if st_public_key = "" then failwith "some public keys are missing"; Some (List.map (fun {st_id; _} -> st_id) se.se_public_keys),
trustee_public_key_of_string G.read st_public_key (List.map
) se.se_public_keys), (fun {st_public_key; _} ->
None) if st_public_key = "" then failwith "some public keys are missing";
trustee_public_key_of_string G.read st_public_key
) se.se_public_keys),
`None)
in
let y = KG.combine (Array.of_list public_keys) in
return (y, trustees, `PK public_keys, private_key)
| Some ts ->
match se.se_threshold_parameters with
| None -> failwith "key establishment not finished"
| Some tp ->
let tp = threshold_parameters_of_string G.read tp in
let module P = Trustees.MakePKI (G) (LwtRandom) in
let module C = Trustees.MakeChannels (G) (LwtRandom) (P) in
let module K = Trustees.MakePedersen (G) (LwtRandom) (P) (C) in
let trustees = List.map (fun {stt_id; _} -> stt_id) ts in
let private_keys =
List.map (fun {stt_voutput; _} ->
match stt_voutput with
| Some v ->
let voutput = voutput_of_string G.read v in
voutput.vo_private_key
| None -> failwith "inconsistent state"
) ts
in
let y = K.combine tp in
return (y, Some trustees, `TP tp, `KEYS private_keys)
in in
let y = KG.combine (Array.of_list public_keys) in
(* election parameters *) (* election parameters *)
let metadata = { se.se_metadata with e_trustees = trustees } in let metadata = { se.se_metadata with e_trustees = trustees } in
let template = se.se_questions in let template = se.se_questions in
...@@ -149,7 +174,10 @@ let finalize_election uuid se = ...@@ -149,7 +174,10 @@ let finalize_election uuid se =
Lwt_io.write oc "\n") xs) Lwt_io.write oc "\n") xs)
in in
Lwt_unix.mkdir dir 0o700 >> Lwt_unix.mkdir dir 0o700 >>
create_file "public_keys.jsons" (string_of_trustee_public_key G.write) public_keys >> (match pk_or_tp with
| `PK pk -> create_file "public_keys.jsons" (string_of_trustee_public_key G.write) pk
| `TP tp -> create_file "threshold.json" (string_of_threshold_parameters G.write) [tp]
) >>
create_file "voters.txt" (fun x -> x.sv_id) se.se_voters >> create_file "voters.txt" (fun x -> x.sv_id) se.se_voters >>
create_file "metadata.json" string_of_metadata [metadata] >> create_file "metadata.json" string_of_metadata [metadata] >>
create_file "election.json" (fun x -> x) [raw_election] >> create_file "election.json" (fun x -> x) [raw_election] >>
...@@ -176,11 +204,12 @@ let finalize_election uuid se = ...@@ -176,11 +204,12 @@ let finalize_election uuid se =
W.B.update_files () >> W.B.update_files () >>
Lwt_unix.unlink fname Lwt_unix.unlink fname
in in
(* create file with private key, if any *) (* create file with private keys, if any *)
let%lwt () = let%lwt () =
match private_key with match private_keys with
| None -> return_unit | `None -> return_unit
| Some x -> create_file "private_key.json" string_of_number [x] | `KEY x -> create_file "private_key.json" string_of_number [x]
| `KEYS x -> create_file "private_keys.jsons" (fun x -> x) x
in in
(* clean up setup database *) (* clean up setup database *)
Ocsipersist.remove election_credtokens se.se_public_creds >> Ocsipersist.remove election_credtokens se.se_public_creds >>
...@@ -188,6 +217,13 @@ let finalize_election uuid se = ...@@ -188,6 +217,13 @@ let finalize_election uuid se =
(fun {st_token; _} -> (fun {st_token; _} ->
Ocsipersist.remove election_pktokens st_token) Ocsipersist.remove election_pktokens st_token)
se.se_public_keys >> se.se_public_keys >>
(match se.se_threshold_trustees with
| None -> return_unit
| Some ts ->
Lwt_list.iter_s
(fun x -> Ocsipersist.remove election_tpktokens x.stt_token)
ts
) >>
Ocsipersist.remove election_stable uuid_s >> Ocsipersist.remove election_stable uuid_s >>
(* inject passwords *) (* inject passwords *)
(match metadata.e_auth_config with (match metadata.e_auth_config with
...@@ -1442,14 +1478,14 @@ let () = ...@@ -1442,14 +1478,14 @@ let () =
let content_type_of_file = function let content_type_of_file = function
| ESRaw -> "application/json; charset=utf-8" | ESRaw -> "application/json; charset=utf-8"
| ESKeys | ESBallots | ESETally | ESResult -> "application/json" | ESKeys | ESTParams | ESBallots | ESETally | ESResult -> "application/json"
| ESCreds | ESRecords | ESVoters -> "text/plain" | ESCreds | ESRecords | ESVoters -> "text/plain"
let handle_pseudo_file uuid_s w f site_user = let handle_pseudo_file uuid_s w f site_user =
let module W = (val w : ELECTION_DATA) in let module W = (val w : ELECTION_DATA) in
let confidential = let confidential =
match f with match f with
| ESRaw | ESKeys | ESBallots | ESETally | ESResult | ESCreds -> false | ESRaw | ESKeys | ESTParams | ESBallots | ESETally | ESResult | ESCreds -> false
| ESRecords | ESVoters -> true | ESRecords | ESVoters -> true
in in
let%lwt () = let%lwt () =
......
...@@ -584,6 +584,27 @@ let election_setup_trustees uuid se () = ...@@ -584,6 +584,27 @@ let election_setup_trustees uuid se () =
) ts ) ts
) )
in in
let import_link = div [
a ~service:Web_services.election_setup_import_trustees
[pcdata "Import trustees from another election"] uuid
]
in
let div_trustees =
if se.se_threshold_trustees = None then
div [
trustees;
(if se.se_public_keys <> [] then
div [
pcdata "There is one link per trustee. Send each trustee her link.";
br ();
br ();
]
else pcdata "");
form_trustees_add;
import_link;
]
else pcdata ""
in
let div_content = let div_content =
div [ div [
div [pcdata "If you do not wish the server to store any keys, you may nominate trustees. In that case, each trustee will create her own secret key. Be careful, once the election is over, you will need the contribution of each trustee to compute the result!"]; div [pcdata "If you do not wish the server to store any keys, you may nominate trustees. In that case, each trustee will create her own secret key. Be careful, once the election is over, you will need the contribution of each trustee to compute the result!"];
...@@ -593,29 +614,15 @@ let election_setup_trustees uuid se () = ...@@ -593,29 +614,15 @@ let election_setup_trustees uuid se () =
pcdata " of trustees is needed to perform the decryption."; pcdata " of trustees is needed to perform the decryption.";
]; ];
br (); br ();
trustees; div_trustees;
(if se.se_public_keys <> [] then
div [
pcdata "There is one link per trustee. Send each trustee her link.";
br ();
br ();
]
else pcdata "");
form_trustees_add;
] ]
in in
let import_link = div [
a ~service:Web_services.election_setup_import_trustees
[pcdata "Import trustees from another election"] uuid
]
in
let back_link = div [ let back_link = div [
a ~service:Web_services.election_setup a ~service:Web_services.election_setup
[pcdata "Go back to election setup"] uuid; [pcdata "Go back to election setup"] uuid;
] in ] in
let content = [ let content = [
div_content; div_content;
import_link;
back_link; back_link;
] in ] in
let%lwt login_box = site_login_box () in let%lwt login_box = site_login_box () in
...@@ -1191,9 +1198,13 @@ let election_setup_confirm uuid se () = ...@@ -1191,9 +1198,13 @@ let election_setup_confirm uuid se () =
match se.se_public_keys with match se.se_public_keys with
| [] -> ready, "OK" | [] -> ready, "OK"
| _ :: _ -> | _ :: _ ->
if List.for_all (fun {st_public_key; _} -> match se.se_threshold_trustees with
st_public_key <> "" | None -> if List.for_all (fun {st_public_key; _} ->
) se.se_public_keys then ready, "OK" else false, "Missing" st_public_key <> ""
) se.se_public_keys then ready, "OK" else false, "Missing"
| Some _ ->
if se.se_threshold_parameters <> None then ready, "OK"
else false, "Missing"
in in
let div_trustee_warning = let div_trustee_warning =
match se.se_public_keys with match se.se_public_keys with
...@@ -1283,6 +1294,18 @@ let audit_footer w = ...@@ -1283,6 +1294,18 @@ let audit_footer w =
let%lwt language = Eliom_reference.get Web_state.language in let%lwt language = Eliom_reference.get Web_state.language in
let module L = (val Web_i18n.get_lang language) in let module L = (val Web_i18n.get_lang language) in
let module W = (val w : ELECTION_DATA) in let module W = (val w : ELECTION_DATA) in
let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in
let%lwt pk_or_tp =
match%lwt Web_persist.get_threshold uuid_s with
| None ->
return (a ~service:(file w ESKeys) [
pcdata L.trustee_public_keys
] ())
| Some _ ->
return (a ~service:(file w ESTParams) [
pcdata "threshold parameters"
] ())
in
return @@ div ~a:[a_style "line-height:1.5em;"] [ return @@ div ~a:[a_style "line-height:1.5em;"] [
div [ div [
div [ div [
...@@ -1295,9 +1318,7 @@ let audit_footer w = ...@@ -1295,9 +1318,7 @@ let audit_footer w =
pcdata L.parameters pcdata L.parameters
] (); ] ();
pcdata ", "; pcdata ", ";
a ~service:(file w ESKeys) [ pk_or_tp;
pcdata L.trustee_public_keys
] ();
pcdata ", "; pcdata ", ";
a ~service:(file w ESCreds) [ a ~service:(file w ESCreds) [
pcdata L.public_credentials pcdata L.public_credentials
......
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