Commit a4bf7a71 authored by Stephane Glondu's avatar Stephane Glondu

Add possibility to add the server itself as a (non-threshold) trustee

parent 494a4d54
...@@ -146,6 +146,11 @@ let get_passwords uuid = ...@@ -146,6 +146,11 @@ let get_passwords uuid =
let get_public_keys uuid = let get_public_keys uuid =
read_file ~uuid "public_keys.jsons" read_file ~uuid "public_keys.jsons"
let get_private_key uuid =
match%lwt read_file ~uuid "private_key.json" with
| Some [x] -> return (Some (number_of_string x))
| _ -> return_none
let get_private_keys uuid = let get_private_keys uuid =
read_file ~uuid "private_keys.jsons" read_file ~uuid "private_keys.jsons"
......
...@@ -51,6 +51,7 @@ val get_elections_by_owner : user -> uuid list Lwt.t ...@@ -51,6 +51,7 @@ val get_elections_by_owner : user -> uuid list Lwt.t
val get_voters : uuid -> string list option Lwt.t val get_voters : uuid -> string list option Lwt.t
val get_passwords : uuid -> (string * string) SMap.t option Lwt.t val get_passwords : uuid -> (string * string) SMap.t option Lwt.t
val get_public_keys : uuid -> string list option Lwt.t val get_public_keys : uuid -> string list option Lwt.t
val get_private_key : uuid -> number option Lwt.t
val get_private_keys : uuid -> string list option Lwt.t val get_private_keys : uuid -> string list option Lwt.t
val get_threshold : uuid -> string option Lwt.t val get_threshold : uuid -> string option Lwt.t
......
...@@ -23,6 +23,7 @@ ...@@ -23,6 +23,7 @@
(** {1 Predefined types} *) (** {1 Predefined types} *)
type number <ocaml predef from="Serializable_builtin"> = abstract
type uuid <ocaml predef from="Serializable_builtin"> = abstract type uuid <ocaml predef from="Serializable_builtin"> = abstract
type string_set <ocaml predef from="Serializable_builtin"> = abstract type string_set <ocaml predef from="Serializable_builtin"> = abstract
type datetime <ocaml predef from="Web_serializable_builtin"> = abstract type datetime <ocaml predef from="Web_serializable_builtin"> = abstract
...@@ -67,6 +68,7 @@ type setup_trustee = { ...@@ -67,6 +68,7 @@ type setup_trustee = {
id : string; id : string;
token : string; token : string;
public_key <ocaml mutable> : string; public_key <ocaml mutable> : string;
?private_key : number option;
} <ocaml field_prefix="st_"> } <ocaml field_prefix="st_">
type setup_threshold_trustee = { type setup_threshold_trustee = {
......
...@@ -45,6 +45,7 @@ let election_setup_voters_add = post_service ~fallback:election_setup_voters ~po ...@@ -45,6 +45,7 @@ let election_setup_voters_add = post_service ~fallback:election_setup_voters ~po
let election_setup_voters_remove = post_coservice ~fallback:election_setup_voters ~post_params:(string "voter") () let election_setup_voters_remove = post_coservice ~fallback:election_setup_voters ~post_params:(string "voter") ()
let election_setup_voters_passwd = post_coservice ~fallback:election_setup_voters ~post_params:(string "voter") () let election_setup_voters_passwd = post_coservice ~fallback:election_setup_voters ~post_params:(string "voter") ()
let election_setup_trustee_add = post_coservice ~fallback:election_setup ~post_params:(string "id") () let election_setup_trustee_add = post_coservice ~fallback:election_setup ~post_params:(string "id") ()
let election_setup_trustee_add_server = post_coservice ~fallback:election_setup ~post_params:unit ()
let election_setup_trustee_del = post_coservice ~fallback:election_setup ~post_params:(int "index") () let election_setup_trustee_del = post_coservice ~fallback:election_setup ~post_params:(int "index") ()
let election_setup_credential_authority = service ~path:["setup"; "credential-authority"] ~get_params:(uuid "uuid") () let election_setup_credential_authority = service ~path:["setup"; "credential-authority"] ~get_params:(uuid "uuid") ()
let election_setup_credentials = service ~path:["setup"; "credentials"] ~get_params:(string "token") () let election_setup_credentials = service ~path:["setup"; "credentials"] ~get_params:(string "token") ()
......
...@@ -122,6 +122,18 @@ let finalize_election uuid se = ...@@ -122,6 +122,18 @@ let finalize_election uuid se =
let%lwt public_key = KG.prove private_key in let%lwt public_key = KG.prove private_key in
return (None, [public_key], `KEY private_key) return (None, [public_key], `KEY private_key)
| _ :: _ -> | _ :: _ ->
let private_key =
List.fold_left (fun accu {st_private_key; _} ->
match st_private_key with
| Some x -> x :: accu
| None -> accu
) [] se.se_public_keys
in
let private_key = match private_key with
| [] -> `None
| [x] -> `KEY x
| _ -> failwith "multiple private keys"
in
return ( return (
Some (List.map (fun {st_id; _} -> st_id) se.se_public_keys), Some (List.map (fun {st_id; _} -> st_id) se.se_public_keys),
(List.map (List.map
...@@ -129,7 +141,7 @@ let finalize_election uuid se = ...@@ -129,7 +141,7 @@ let finalize_election uuid se =
if st_public_key = "" then failwith "some public keys are missing"; if st_public_key = "" then failwith "some public keys are missing";
trustee_public_key_of_string G.read st_public_key trustee_public_key_of_string G.read st_public_key
) se.se_public_keys), ) se.se_public_keys),
`None) private_key)
in in
let y = KG.combine (Array.of_list public_keys) in let y = KG.combine (Array.of_list public_keys) in
return (y, trustees, `PK public_keys, private_key) return (y, trustees, `PK public_keys, private_key)
...@@ -223,7 +235,10 @@ let finalize_election uuid se = ...@@ -223,7 +235,10 @@ let finalize_election uuid se =
Ocsipersist.remove election_credtokens se.se_public_creds >> Ocsipersist.remove election_credtokens se.se_public_creds >>
Lwt_list.iter_s Lwt_list.iter_s
(fun {st_token; _} -> (fun {st_token; _} ->
Ocsipersist.remove election_pktokens st_token) if st_token <> "" then (
Ocsipersist.remove election_pktokens st_token
) else return_unit
)
se.se_public_keys >> se.se_public_keys >>
(match se.se_threshold_trustees with (match se.se_threshold_trustees with
| None -> return_unit | None -> return_unit
...@@ -697,7 +712,7 @@ let () = ...@@ -697,7 +712,7 @@ let () =
with_setup_election uuid (fun se -> with_setup_election uuid (fun se ->
if is_email st_id then ( if is_email st_id then (
let%lwt st_token = generate_token () in let%lwt st_token = generate_token () in
let trustee = {st_id; st_token; st_public_key = ""} in let trustee = {st_id; st_token; st_public_key = ""; st_private_key = None} in
se.se_public_keys <- se.se_public_keys @ [trustee]; se.se_public_keys <- se.se_public_keys @ [trustee];
let%lwt () = Ocsipersist.add election_pktokens st_token (raw_string_of_uuid uuid) in let%lwt () = Ocsipersist.add election_pktokens st_token (raw_string_of_uuid uuid) in
redir_preapply election_setup_trustees uuid () redir_preapply election_setup_trustees uuid ()
...@@ -709,6 +724,23 @@ let () = ...@@ -709,6 +724,23 @@ let () =
) )
) )
let () =
Any.register ~service:election_setup_trustee_add_server
(fun uuid () ->
with_setup_election uuid (fun se ->
let st_id = "server" and st_token = "" in
let module G = (val Group.of_string se.se_group) in
let module K = Trustees.MakeSimple (G) (LwtRandom) in
let%lwt private_key = K.generate () in
let%lwt public_key = K.prove private_key in
let st_public_key = string_of_trustee_public_key G.write public_key in
let st_private_key = Some private_key in
let trustee = {st_id; st_token; st_public_key; st_private_key} in
se.se_public_keys <- se.se_public_keys @ [trustee];
redir_preapply election_setup_trustees uuid ()
)
)
let () = let () =
Any.register ~service:election_setup_trustee_del Any.register ~service:election_setup_trustee_del
(fun uuid index -> (fun uuid index ->
...@@ -722,7 +754,9 @@ let () = ...@@ -722,7 +754,9 @@ let () =
se.se_public_keys <- trustees; se.se_public_keys <- trustees;
let%lwt () = let%lwt () =
Lwt_list.iter_s (fun {st_token; _} -> Lwt_list.iter_s (fun {st_token; _} ->
Ocsipersist.remove election_pktokens st_token if st_token <> "" then (
Ocsipersist.remove election_pktokens st_token
) else return_unit
) old ) old
in in
redir_preapply election_setup_trustees uuid () redir_preapply election_setup_trustees uuid ()
...@@ -1022,17 +1056,27 @@ let () = ...@@ -1022,17 +1056,27 @@ let () =
) se_threshold_trustees >> ) se_threshold_trustees >>
redir_preapply election_setup_threshold_trustees uuid () redir_preapply election_setup_threshold_trustees uuid ()
| Some ts, None, Some pks when List.length ts = List.length pks -> | Some ts, None, Some pks when List.length ts = List.length pks ->
let module G = (val Group.of_string se.se_group) in
let module KG = Trustees.MakeSimple (G) (LwtRandom) in
let%lwt trustees = let%lwt trustees =
List.combine ts pks List.combine ts pks
|> Lwt_list.map_p |> Lwt_list.map_p
(fun (st_id, st_public_key) -> (fun (st_id, st_public_key) ->
let%lwt st_token = generate_token () in let%lwt st_token, st_private_key, st_public_key =
return {st_id; st_token; st_public_key}) if st_id = "server" then (
let%lwt private_key = KG.generate () in
let%lwt public_key = KG.prove private_key in
let public_key = string_of_trustee_public_key G.write public_key in
return ("", Some private_key, public_key)
) else (
let%lwt st_token = generate_token () in
return (st_token, None, st_public_key)
)
in
return {st_id; st_token; st_public_key; st_private_key})
in in
let () = let () =
(* check that imported keys are valid *) (* check that imported keys are valid *)
let module G = (val Group.of_string se.se_group : GROUP) in
let module KG = Trustees.MakeSimple (G) (LwtRandom) in
if not @@ List.for_all (fun t -> if not @@ List.for_all (fun t ->
let pk = t.st_public_key in let pk = t.st_public_key in
let pk = trustee_public_key_of_string G.read pk in let pk = trustee_public_key_of_string G.read pk in
...@@ -1041,7 +1085,9 @@ let () = ...@@ -1041,7 +1085,9 @@ let () =
in in
se.se_public_keys <- se.se_public_keys @ trustees; se.se_public_keys <- se.se_public_keys @ trustees;
Lwt_list.iter_s (fun {st_token; _} -> Lwt_list.iter_s (fun {st_token; _} ->
Ocsipersist.add election_pktokens st_token uuid_s if st_token <> "" then (
Ocsipersist.add election_pktokens st_token uuid_s
) else return_unit
) trustees >> ) trustees >>
redir_preapply election_setup_trustees uuid () redir_preapply election_setup_trustees uuid ()
| _, _, _ -> | _, _, _ ->
...@@ -1532,21 +1578,31 @@ let () = ...@@ -1532,21 +1578,31 @@ let () =
| None -> failwith "missing public keys and threshold parameters" | None -> failwith "missing public keys and threshold parameters"
in in
Web_persist.set_election_state uuid (`EncryptedTally (npks, nb, hash)) >> Web_persist.set_election_state uuid (`EncryptedTally (npks, nb, hash)) >>
(* compute partial decryption and release tally let tally = encrypted_tally_of_string W.G.read tally in
if the (single) key is known *) let%lwt sk = Web_persist.get_private_key uuid in
let skfile = !spool_dir / raw_string_of_uuid uuid / "private_key.json" in match metadata.e_trustees with
if npks = 1 && Sys.file_exists skfile then ( | None ->
let%lwt sk = read_file skfile in (* no trustees: compute decryption and release tally *)
let sk = match sk with let sk = match sk with
| Some [sk] -> number_of_string sk | Some x -> x
| _ -> failwith "several private keys are available" | None -> failwith "missing private key"
in in
let tally = encrypted_tally_of_string W.G.read tally in let%lwt pd = E.compute_factor tally sk in
let%lwt pd = E.compute_factor tally sk in let pd = string_of_partial_decryption W.G.write pd in
let pd = string_of_partial_decryption W.G.write pd in Web_persist.set_partial_decryptions uuid [1, pd]
Web_persist.set_partial_decryptions uuid [1, pd] >> >> handle_election_tally_release (uuid, ()) ()
handle_election_tally_release (uuid, ()) () | Some ts ->
) else redir_preapply election_admin (uuid, ()) () Lwt_list.iteri_s (fun i t ->
if t = "server" then (
match%lwt Web_persist.get_private_key uuid with
| Some k ->
let%lwt pd = E.compute_factor tally k in
let pd = string_of_partial_decryption W.G.write pd in
Web_persist.set_partial_decryptions uuid [i+1, pd]
| None -> return_unit (* dead end *)
) else return_unit
) ts
>> redir_preapply election_admin (uuid, ()) ()
) else forbidden () ) else forbidden ()
) )
) )
......
...@@ -540,6 +540,18 @@ let election_setup_trustees uuid se () = ...@@ -540,6 +540,18 @@ let election_setup_trustees uuid se () =
] ]
) uuid ) uuid
in in
let form_trustees_add_server =
match List.filter (fun {st_id; _} -> st_id = "server") se.se_public_keys with
| [] ->
post_form
~service:election_setup_trustee_add_server
(fun () ->
[
string_input ~input_type:`Submit ~value:"Add the server" ()
]
) uuid
| _ -> pcdata ""
in
let mk_form_trustee_del value = let mk_form_trustee_del value =
post_form post_form
~service:election_setup_trustee_del ~service:election_setup_trustee_del
...@@ -566,15 +578,23 @@ let election_setup_trustees uuid se () = ...@@ -566,15 +578,23 @@ let election_setup_trustees uuid se () =
pcdata t.st_id; pcdata t.st_id;
]; ];
td [ td [
if t.st_token <> "" then (
let uri = rewrite_prefix @@ Eliom_uri.make_string_uri let uri = rewrite_prefix @@ Eliom_uri.make_string_uri
~absolute:true ~service:election_setup_trustee t.st_token ~absolute:true ~service:election_setup_trustee t.st_token
in in
let body = Printf.sprintf mail_trustee_generation uri in let body = Printf.sprintf mail_trustee_generation uri in
let subject = "Link to generate the decryption key" in let subject = "Link to generate the decryption key" in
a_mailto ~dest:t.st_id ~subject ~body "Mail" a_mailto ~dest:t.st_id ~subject ~body "Mail"
) else (
pcdata "(server)"
)
]; ];
td [ td [
if t.st_token <> "" then (
a ~service:election_setup_trustee [pcdata "Link"] t.st_token; a ~service:election_setup_trustee [pcdata "Link"] t.st_token;
) else (
pcdata "(server)"
)
]; ];
td [ td [
pcdata (if t.st_public_key = "" then "No" else "Yes"); pcdata (if t.st_public_key = "" then "No" else "Yes");
...@@ -601,6 +621,7 @@ let election_setup_trustees uuid se () = ...@@ -601,6 +621,7 @@ let election_setup_trustees uuid se () =
] ]
else pcdata ""); else pcdata "");
form_trustees_add; form_trustees_add;
form_trustees_add_server;
] ]
else pcdata "" else pcdata ""
in in
...@@ -1618,16 +1639,21 @@ let election_admin election metadata state get_tokens_decrypt () = ...@@ -1618,16 +1639,21 @@ let election_admin election metadata state get_tokens_decrypt () =
| None -> uri, !server_mail | None -> uri, !server_mail
| Some name -> name, name | Some name -> name, name
in in
tr [ let mail, link =
td [pcdata link_content]; if link_content = "server" then (
td [ pcdata "(server)",
pcdata "(server)"
) else (
let body = Printf.sprintf mail_trustee_tally uri in let body = Printf.sprintf mail_trustee_tally uri in
let subject = "Link to tally the election" in let subject = "Link to tally the election" in
a_mailto ~dest ~subject ~body "Mail" a_mailto ~dest ~subject ~body "Mail",
]; a ~service [pcdata "Link"] x
td [ )
a ~service [pcdata "Link"] x; in
]; tr [
td [pcdata link_content];
td [mail];
td [link];
td [ td [
pcdata (if List.mem_assoc trustee_id pds then "Yes" else "No") pcdata (if List.mem_assoc trustee_id pds then "Yes" else "No")
]; ];
......
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