diff --git a/src/web/web_common.ml b/src/web/web_common.ml index 200d4be282781f899927d37242d77978df1c634b..84a4e7128bcd00a78d23b929f9042624f4369d05 100644 --- a/src/web/web_common.ml +++ b/src/web/web_common.ml @@ -127,6 +127,7 @@ let set_rewrite_prefix ~src ~dst = type election_file = | ESRaw | ESKeys + | ESTParams | ESCreds | ESBallots | ESVoters @@ -137,6 +138,7 @@ type election_file = let election_file_of_string = function | "election.json" -> ESRaw | "public_keys.jsons" -> ESKeys + | "threshold.json" -> ESTParams | "public_creds.txt" -> ESCreds | "ballots.jsons" -> ESBallots | "records" -> ESRecords @@ -148,6 +150,7 @@ let election_file_of_string = function let string_of_election_file = function | ESRaw -> "election.json" | ESKeys -> "public_keys.jsons" + | ESTParams -> "threshold.json" | ESCreds -> "public_creds.txt" | ESBallots -> "ballots.jsons" | ESRecords -> "records" diff --git a/src/web/web_common.mli b/src/web/web_common.mli index bee4a2beb84162056d5fc3b22f4454ae29af51fa..a96561ef6021c755abf197c749d0c68e4e7fad4d 100644 --- a/src/web/web_common.mli +++ b/src/web/web_common.mli @@ -61,6 +61,7 @@ val set_rewrite_prefix : src:string -> dst:string -> unit type election_file = | ESRaw | ESKeys + | ESTParams | ESCreds | ESBallots | ESVoters diff --git a/src/web/web_persist.ml b/src/web/web_persist.ml index c08525bf71c56dce45d3dc313df9c2ba59acbb1d..4a2d5ad9cb05d2ba9983c569ec749077c8df0f9f 100644 --- a/src/web/web_persist.ml +++ b/src/web/web_persist.ml @@ -153,6 +153,13 @@ let get_public_keys uuid = return @@ Some lines 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 BallotsCacheTypes = struct diff --git a/src/web/web_persist.mli b/src/web/web_persist.mli index e7f38a79bf9a8c2cc2da87972ad7ece62e2a857b..934971d7feb58c7509f25ea842625960f7ce3471 100644 --- a/src/web/web_persist.mli +++ b/src/web/web_persist.mli @@ -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_passwords : string -> (string * string) SMap.t 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_by_hash : uuid:string -> hash:string -> string option Lwt.t diff --git a/src/web/web_site.ml b/src/web/web_site.ml index cc4d6940f5de4817779c005a4dabe639d05ad985..862fdef20a2e5b3229858bbea15fcbdbf489d52b 100644 --- a/src/web/web_site.ml +++ b/src/web/web_site.ml @@ -107,24 +107,49 @@ let finalize_election uuid se = (* trustees *) let group = Group.of_string se.se_group in let module G = (val group : GROUP) in - let module KG = Trustees.MakeSimple (G) (LwtRandom) in - let%lwt trustees, public_keys, private_key = - match se.se_public_keys with - | [] -> - let%lwt private_key = KG.generate () in - let%lwt public_key = KG.prove private_key in - return (None, [public_key], Some private_key) - | _ :: _ -> - return ( - Some (List.map (fun {st_id; _} -> st_id) se.se_public_keys), - (List.map - (fun {st_public_key; _} -> - 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) + let%lwt y, trustees, pk_or_tp, private_keys = + match se.se_threshold_trustees with + | None -> + let module KG = Trustees.MakeSimple (G) (LwtRandom) in + let%lwt trustees, public_keys, private_key = + match se.se_public_keys with + | [] -> + let%lwt private_key = KG.generate () in + let%lwt public_key = KG.prove private_key in + return (None, [public_key], `KEY private_key) + | _ :: _ -> + return ( + Some (List.map (fun {st_id; _} -> st_id) se.se_public_keys), + (List.map + (fun {st_public_key; _} -> + 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 - let y = KG.combine (Array.of_list public_keys) in (* election parameters *) let metadata = { se.se_metadata with e_trustees = trustees } in let template = se.se_questions in @@ -149,7 +174,10 @@ let finalize_election uuid se = Lwt_io.write oc "\n") xs) in 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 "metadata.json" string_of_metadata [metadata] >> create_file "election.json" (fun x -> x) [raw_election] >> @@ -176,11 +204,12 @@ let finalize_election uuid se = W.B.update_files () >> Lwt_unix.unlink fname in - (* create file with private key, if any *) + (* create file with private keys, if any *) let%lwt () = - match private_key with - | None -> return_unit - | Some x -> create_file "private_key.json" string_of_number [x] + match private_keys with + | `None -> return_unit + | `KEY x -> create_file "private_key.json" string_of_number [x] + | `KEYS x -> create_file "private_keys.jsons" (fun x -> x) x in (* clean up setup database *) Ocsipersist.remove election_credtokens se.se_public_creds >> @@ -188,6 +217,13 @@ let finalize_election uuid se = (fun {st_token; _} -> Ocsipersist.remove election_pktokens st_token) 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 >> (* inject passwords *) (match metadata.e_auth_config with @@ -1442,14 +1478,14 @@ let () = let content_type_of_file = function | ESRaw -> "application/json; charset=utf-8" - | ESKeys | ESBallots | ESETally | ESResult -> "application/json" + | ESKeys | ESTParams | ESBallots | ESETally | ESResult -> "application/json" | ESCreds | ESRecords | ESVoters -> "text/plain" let handle_pseudo_file uuid_s w f site_user = let module W = (val w : ELECTION_DATA) in let confidential = match f with - | ESRaw | ESKeys | ESBallots | ESETally | ESResult | ESCreds -> false + | ESRaw | ESKeys | ESTParams | ESBallots | ESETally | ESResult | ESCreds -> false | ESRecords | ESVoters -> true in let%lwt () = diff --git a/src/web/web_templates.ml b/src/web/web_templates.ml index 2e740d2e04296d41d7f3badccaae38a5a4a9ab6c..c6984c37033aaa207426d536f837960e9964b18d 100644 --- a/src/web/web_templates.ml +++ b/src/web/web_templates.ml @@ -584,6 +584,27 @@ let election_setup_trustees uuid se () = ) ts ) 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 = 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!"]; @@ -593,29 +614,15 @@ let election_setup_trustees uuid se () = pcdata " of trustees is needed to perform the decryption."; ]; br (); - 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; + div_trustees; ] 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 [ a ~service:Web_services.election_setup [pcdata "Go back to election setup"] uuid; ] in let content = [ div_content; - import_link; back_link; ] in let%lwt login_box = site_login_box () in @@ -1191,9 +1198,13 @@ let election_setup_confirm uuid se () = match se.se_public_keys with | [] -> ready, "OK" | _ :: _ -> - if List.for_all (fun {st_public_key; _} -> - st_public_key <> "" - ) se.se_public_keys then ready, "OK" else false, "Missing" + match se.se_threshold_trustees with + | None -> if List.for_all (fun {st_public_key; _} -> + 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 let div_trustee_warning = match se.se_public_keys with @@ -1283,6 +1294,18 @@ let audit_footer w = let%lwt language = Eliom_reference.get Web_state.language in let module L = (val Web_i18n.get_lang language) 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;"] [ div [ div [ @@ -1295,9 +1318,7 @@ let audit_footer w = pcdata L.parameters ] (); pcdata ", "; - a ~service:(file w ESKeys) [ - pcdata L.trustee_public_keys - ] (); + pk_or_tp; pcdata ", "; a ~service:(file w ESCreds) [ pcdata L.public_credentials