Skip to content

GitLab

B
belenios
Commit 7a17b8c7 authored by Stephane Glondu's avatar Stephane Glondu
Browse files
Options

Threshold: server-side tally

parent f140b130
Hide whitespace changes
Inline Side-by-side
Showing with 145 additions and 53 deletions
src/web/web_persist.ml
View file @ 7a17b8c7
......@@ -153,6 +153,13 @@ let get_public_keys uuid =
return @@ Some lines
with _ -> return_none
let get_private_keys uuid =
try%lwt
let lines = Lwt_io.lines_of_file (!spool_dir / uuid / "private_keys.jsons") in
let%lwt lines = Lwt_stream.to_list lines in
return @@ Some lines
with _ -> return_none
let get_threshold uuid =
try%lwt
Lwt_io.chars_of_file (!spool_dir / uuid / "threshold.json") |>
......
src/web/web_persist.mli
View file @ 7a17b8c7
......@@ -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_private_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
......
src/web/web_services.ml
View file @ 7a17b8c7
......@@ -95,7 +95,7 @@ let election_pretty_records = service ~path:["elections"] ~get_params:(suffix (u
let election_missing_voters = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "missing")) ()
let election_compute_encrypted_tally = post_coservice ~csrf_safe:true ~fallback:election_admin ~post_params:unit ()
let election_tally_trustees = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "trustees" ** int "trustee_id")) ()
let election_tally_trustees = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "trustees" ** string "token")) ()
let election_tally_trustees_post = post_service ~fallback:election_tally_trustees ~post_params:(string "partial_decryption") ()
let election_tally_release = post_service ~fallback:election_admin ~post_params:unit ()
......
src/web/web_site.ml
View file @ 7a17b8c7
......@@ -48,6 +48,9 @@ let election_pktokens = Ocsipersist.open_table "site_pktokens"
(* Table with tokens given to trustees (in threshold mode). *)
let election_tpktokens = Ocsipersist.open_table "site_tpktokens"
(* Table with tokens given to trustees (in threshold mode) to decrypt *)
let election_tokens_decrypt = Ocsipersist.open_table "site_tokens_decrypt"
(* Table with tokens given to credential authorities. *)
let election_credtokens = Ocsipersist.open_table "site_credtokens"
......@@ -260,6 +263,7 @@ let cleanup_file f =
let archive_election uuid_s =
let uuid_u = underscorize uuid_s in
let%lwt () = cleanup_table ~uuid_s "election_states" in
let%lwt () = cleanup_table ~uuid_s "site_tokens_decrypt" in
let%lwt () = cleanup_table ~uuid_s "election_pds" in
let%lwt () = cleanup_table ~uuid_s "auth_configs" in
let%lwt () = cleanup_table ("password_" ^ uuid_u) in
......@@ -1092,7 +1096,18 @@ let () =
match site_user with
| Some u when metadata.e_owner = Some u ->
let%lwt state = Web_persist.get_election_state uuid_s in
T.election_admin w metadata state () >>= Html5.send
let get_tokens_decrypt () =
try%lwt
Ocsipersist.find election_tokens_decrypt uuid_s
with Not_found ->
match metadata.e_trustees with
| None -> failwith "missing trustees in get_tokens_decrypt"
| Some ts ->
let%lwt ts = Lwt_list.map_s (fun _ -> generate_token ()) ts in
Ocsipersist.add election_tokens_decrypt uuid_s ts >>
return ts
in
T.election_admin w metadata state get_tokens_decrypt () >>= Html5.send
| _ ->
let cont () =
Redirection.send (Eliom_service.preapply election_admin (uuid, ()))
......@@ -1346,10 +1361,20 @@ let () =
T.pretty_records w (List.rev records) () >>= Html5.send
)
let find_trustee_id uuid_s token =
try%lwt
let%lwt tokens = Ocsipersist.find election_tokens_decrypt uuid_s in
let rec find i = function
| [] -> raise Not_found
| t :: ts -> if t = token then i else find (i+1) ts
in
return (find 1 tokens)
with Not_found -> return (try int_of_string token with _ -> 0)
let () =
Any.register
~service:election_tally_trustees
(fun (uuid, ((), trustee_id)) () ->
(fun (uuid, ((), token)) () ->
let uuid_s = Uuidm.to_string uuid in
let%lwt w = find_election uuid_s in
let module W = (val w) in
......@@ -1358,25 +1383,27 @@ let () =
| `EncryptedTally _ -> return ()
| _ -> fail_http 404
in
let%lwt trustee_id = find_trustee_id uuid_s token in
let%lwt pds = Web_persist.get_partial_decryptions uuid_s in
if List.mem_assoc trustee_id pds then (
T.generic_page ~title:"Error"
"Your partial decryption has already been received and checked!"
() >>= Html5.send
) else (
T.tally_trustees (module W) trustee_id () >>= Html5.send
T.tally_trustees (module W) trustee_id token () >>= Html5.send
))
let () =
Any.register
~service:election_tally_trustees_post
(fun (uuid, ((), trustee_id)) partial_decryption ->
(fun (uuid, ((), token)) partial_decryption ->
let uuid_s = Uuidm.to_string uuid in
let%lwt () =
match%lwt Web_persist.get_election_state uuid_s with
| `EncryptedTally _ -> return ()
| _ -> forbidden ()
in
let%lwt trustee_id = find_trustee_id uuid_s token in
let%lwt pds = Web_persist.get_partial_decryptions uuid_s in
let%lwt () =
if List.mem_assoc trustee_id pds then forbidden () else return ()
......@@ -1387,18 +1414,20 @@ let () =
let%lwt w = find_election uuid_s in
let module W = (val w) in
let module E = Election.MakeElection (W.G) (LwtRandom) in
let pks = !spool_dir / uuid_s / string_of_election_file ESKeys in
let pks = Lwt_io.lines_of_file pks in
let%lwt () = Lwt_stream.njunk (trustee_id-1) pks in
let%lwt pk = Lwt_stream.peek pks in
let%lwt () = Lwt_stream.junk_while (fun _ -> true) pks in
let%lwt pk =
match pk with
| None -> fail_http 404
| Some x -> return x
let%lwt pks =
match%lwt Web_persist.get_threshold uuid_s with
| Some tp ->
let tp = threshold_parameters_of_string W.G.read tp in
return tp.t_verification_keys
| None ->
match%lwt Web_persist.get_public_keys uuid_s with
| None -> failwith "no public keys in election_tally_trustees_post"
| Some pks ->
let pks = Array.of_list pks in
let pks = Array.map (trustee_public_key_of_string W.G.read) pks in
return pks
in
let pk = trustee_public_key_of_string W.G.read pk in
let pk = pk.trustee_public_key in
let pk = pks.(trustee_id-1).trustee_public_key in
let pd = partial_decryption_of_string W.G.read partial_decryption in
let et = !spool_dir / uuid_s / string_of_election_file ESETally in
let%lwt et = Lwt_io.chars_of_file et |> Lwt_stream.to_string in
......@@ -1410,7 +1439,7 @@ let () =
"Your partial decryption has been received and checked!" () >>=
Html5.send
) else (
let service = preapply election_tally_trustees (uuid, ((), trustee_id)) in
let service = preapply election_tally_trustees (uuid, ((), token)) in
T.generic_page ~title:"Error" ~service
"The partial decryption didn't pass validation!" () >>=
Html5.send
......@@ -1422,7 +1451,6 @@ let handle_election_tally_release (uuid, ()) () =
let%lwt metadata = Web_persist.get_election_metadata uuid_s in
let module W = (val w) in
let module E = Election.MakeElection (W.G) (LwtRandom) in
let module KG = Trustees.MakeSimple (W.G) (LwtRandom) in
let%lwt () =
match%lwt Web_state.get_site_user () with
| Some u when metadata.e_owner = Some u -> return ()
......@@ -1433,33 +1461,51 @@ let handle_election_tally_release (uuid, ()) () =
| `EncryptedTally (npks, ntallied, _) -> return (npks, ntallied)
| _ -> forbidden ()
in
let%lwt pks =
match%lwt Web_persist.get_public_keys uuid_s with
| Some l -> return (Array.of_list l)
| _ -> fail_http 404
in
let pks =
Array.map (fun pk ->
(trustee_public_key_of_string W.G.read pk).trustee_public_key
) pks
in
assert (npks = Array.length pks);
let%lwt pds = Web_persist.get_partial_decryptions uuid_s in
let%lwt pds =
try
return @@ Array.init npks (fun i ->
List.assoc (i+1) pds |> partial_decryption_of_string W.G.read
)
with Not_found -> fail_http 404
in
let%lwt et =
!spool_dir / uuid_s / string_of_election_file ESETally |>
Lwt_io.chars_of_file |> Lwt_stream.to_string >>=
wrap1 (encrypted_tally_of_string W.G.read)
in
let%lwt tp = Web_persist.get_threshold uuid_s in
let tp =
match tp with
| None -> None
| Some tp -> Some (threshold_parameters_of_string W.G.read tp)
in
let threshold =
match tp with
| None -> npks
| Some tp -> tp.t_threshold
in
let%lwt pds = Web_persist.get_partial_decryptions uuid_s in
let pds = List.map snd pds in
let pds = List.map (partial_decryption_of_string W.G.read) pds in
let%lwt () =
if List.length pds < threshold then fail_http 404 else return_unit
in
let checker = E.check_factor et in
let combinator = KG.combine_factors checker pks in
let result = E.compute_result ntallied et (Array.to_list pds) combinator in
let%lwt combinator =
match tp with
| None ->
let module K = Trustees.MakeSimple (W.G) (LwtRandom) in
let%lwt pks =
match%lwt Web_persist.get_public_keys uuid_s with
| Some l -> return (Array.of_list l)
| _ -> fail_http 404
in
let pks =
Array.map (fun pk ->
(trustee_public_key_of_string W.G.read pk).trustee_public_key
) pks
in
return (K.combine_factors checker pks)
| Some tp ->
let module P = Trustees.MakePKI (W.G) (LwtRandom) in
let module C = Trustees.MakeChannels (W.G) (LwtRandom) (P) in
let module K = Trustees.MakePedersen (W.G) (LwtRandom) (P) (C) in
return (K.combine_factors checker tp)
in
let result = E.compute_result ntallied et pds combinator in
let%lwt () =
let open Lwt_io in
with_file
......@@ -1467,6 +1513,7 @@ let handle_election_tally_release (uuid, ()) () =
(fun oc -> Lwt_io.write_line oc (string_of_result W.G.write result))
in
let%lwt () = Web_persist.set_election_state uuid_s (`Tallied result.result) in
let%lwt () = Ocsipersist.remove election_tokens_decrypt uuid_s in
Eliom_service.preapply
election_home (W.election.e_params.e_uuid, ()) |>
Redirection.send
......@@ -1529,15 +1576,21 @@ let () =
| _ -> forbidden ()
in
let%lwt nb, hash, tally = WE.B.compute_encrypted_tally () in
let pks = !spool_dir / uuid_s / string_of_election_file ESKeys in
let pks = Lwt_io.lines_of_file pks in
let npks = ref 0 in
let%lwt () = Lwt_stream.junk_while (fun _ -> incr npks; true) pks in
Web_persist.set_election_state uuid_s (`EncryptedTally (!npks, nb, hash)) >>
let%lwt npks =
match%lwt Web_persist.get_threshold uuid_s with
| Some tp ->
let tp = threshold_parameters_of_string WE.G.read tp in
return (Array.length tp.t_verification_keys)
| None ->
match%lwt Web_persist.get_public_keys uuid_s with
| Some pks -> return (List.length pks)
| None -> failwith "missing public keys and threshold parameters"
in
Web_persist.set_election_state uuid_s (`EncryptedTally (npks, nb, hash)) >>
(* compute partial decryption and release tally
if the (single) key is known *)
let skfile = !spool_dir / uuid_s / "private_key.json" in
if !npks = 1 && Sys.file_exists skfile then (
if npks = 1 && Sys.file_exists skfile then (
let%lwt sk = Lwt_io.lines_of_file skfile |> Lwt_stream.to_list in
let sk = match sk with
| [sk] -> number_of_string sk
......
src/web/web_templates.ml
View file @ 7a17b8c7
......@@ -1493,7 +1493,7 @@ Thank you again for your help,
-- \nThe election administrator."
let election_admin w metadata state () =
let election_admin w metadata state get_tokens_decrypt () =
let module W = (val w : ELECTION_DATA) in
let title = W.election.e_params.e_name ^ " — Administration" in
let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in
......@@ -1536,6 +1536,17 @@ let election_admin w metadata state () =
]
| `EncryptedTally (npks, _, hash) ->
let%lwt pds = Web_persist.get_partial_decryptions uuid_s in
let%lwt tp = Web_persist.get_threshold uuid_s in
let tp =
match tp with
| None -> None
| Some tp -> Some (threshold_parameters_of_string W.G.read tp)
in
let threshold_or_not =
match tp with
| None -> pcdata ""
| Some tp -> pcdata (Printf.sprintf " At least %d trustees must act." tp.t_threshold)
in
let trustees =
let rec loop i ts =
if i <= npks then
......@@ -1548,11 +1559,18 @@ let election_admin w metadata state () =
| None -> loop 1 []
| Some ts -> loop 1 ts
in
let rec seq i j = if i >= j then [] else i :: (seq (i+1) j) in
let%lwt trustee_tokens =
match tp with
| None -> return (List.map string_of_int (seq 1 (npks+1)))
| Some _ -> get_tokens_decrypt ()
in
let trustees = List.combine trustees trustee_tokens in
let trustees =
List.map
(fun (name, trustee_id) ->
(fun ((name, trustee_id), token) ->
let service = election_tally_trustees in
let x = (W.election.e_params.e_uuid, ((), trustee_id)) in
let x = (W.election.e_params.e_uuid, ((), token)) in
let uri = rewrite_prefix @@ Eliom_uri.make_string_uri
~absolute:true ~service x
in
......@@ -1598,7 +1616,7 @@ let election_admin w metadata state () =
pcdata ".";
];
div [
div [pcdata "We are now waiting for trustees..."];
div [pcdata "We are now waiting for trustees..."; threshold_or_not];
table
(tr [
th [pcdata "Trustee"];
......@@ -1985,12 +2003,17 @@ let pretty_records w records () =
let%lwt login_box = site_login_box () in
base ~title ?login_box ~content ()
let tally_trustees w trustee_id () =
let tally_trustees w trustee_id token () =
let module W = (val w : ELECTION_DATA) in
let params = W.election.e_params in
let title =
params.e_name ^ " — Partial decryption #" ^ string_of_int trustee_id
in
let%lwt encrypted_private_key =
match%lwt Web_persist.get_private_keys (Uuidm.to_string params.e_uuid) with
| None -> return_none
| Some keys -> return (Some (List.nth keys (trustee_id-1)))
in
let content = [
p [pcdata "It is now time to compute your partial decryption factors."];
p [
......@@ -1998,6 +2021,14 @@ let tally_trustees w trustee_id () =
b [span ~a:[a_id "hash"] []];
pcdata "."
];
(
match encrypted_private_key with
| None -> pcdata ""
| Some epk ->
div ~a:[a_style "display:none;"] [
unsafe_textarea "encrypted_private_key" epk
];
);
div ~a:[a_id "input_private_key"] [
p [pcdata "Please enter your private key:"];
input
......@@ -2022,7 +2053,7 @@ let tally_trustees w trustee_id () =
];
div [string_input ~input_type:`Submit ~value:"Submit" ()];
]
) (params.e_uuid, ((), trustee_id));
) (params.e_uuid, ((), token));
];
div [
script ~a:[a_src (uri_of_string (fun () -> "../../../static/sjcl.js"))] (pcdata "");
......
src/web/web_templates.mli
View file @ 7a17b8c7
......@@ -51,7 +51,7 @@ val election_setup_import_trustees : Uuidm.t -> setup_election -> (module ELECTI
val election_setup_confirm : Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_home : (module ELECTION_DATA) -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_admin : (module ELECTION_DATA) -> Web_serializable_j.metadata -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_admin : (module ELECTION_DATA) -> Web_serializable_j.metadata -> Web_persist.election_state -> (unit -> string list Lwt.t) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val update_credential : (module ELECTION_DATA) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val regenpwd : Uuidm.t -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_raw : (module ELECTION_DATA) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
......@@ -60,7 +60,7 @@ val cast_confirmed : (module ELECTION_DATA) -> result:[< `Error of Web_common.er
val pretty_ballots : (module ELECTION_DATA) -> string list -> Yojson.Safe.json result option -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val pretty_records : (module ELECTION_DATA) -> (string * string) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val tally_trustees : (module ELECTION_DATA) -> int -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val tally_trustees : (module ELECTION_DATA) -> int -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val already_logged_in :
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
......
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