Commit 5dce1128 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Threshold: add basic trustee management + key establishment protocol

parent da4a0a30
......@@ -27,6 +27,9 @@ type uuid <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 template <ocaml predef from="Serializable"> = abstract
type cert <ocaml predef from="Serializable"> = abstract
type polynomial <ocaml predef from="Serializable"> = abstract
type vinput <ocaml predef from="Serializable"> = abstract
(** {1 Web-specific types} *)
......@@ -66,6 +69,16 @@ type setup_trustee = {
public_key <ocaml mutable> : string;
} <ocaml field_prefix="st_">
type setup_threshold_trustee = {
id : string;
token : string;
?step <ocaml mutable> : int option;
?cert <ocaml mutable> : cert option;
?polynomial <ocaml mutable> : polynomial option;
?vinput <ocaml mutable> : vinput option;
?voutput <ocaml mutable> : string option;
} <ocaml field_prefix="stt_">
type setup_election = {
owner : user;
group : string;
......@@ -75,6 +88,10 @@ type setup_election = {
metadata <ocaml mutable> : metadata;
public_creds : string;
public_creds_received <ocaml mutable> : bool;
?threshold <ocaml mutable> : int option;
?threshold_trustees <ocaml mutable> : setup_threshold_trustee list option;
?threshold_parameters <ocaml mutable> : string option;
?threshold_error <ocaml mutable> : string option;
} <ocaml field_prefix="se_">
(** {1 OpenID Connect-related types} *)
......
......@@ -56,6 +56,14 @@ let election_setup_credentials_server = post_coservice ~fallback:election_setup
let election_setup_trustees = service ~path:["setup"; "trustees"] ~get_params:(uuid "uuid") ()
let election_setup_trustee = service ~path:["setup"; "trustee"] ~get_params:(string "token") ()
let election_setup_trustee_post = post_coservice ~fallback:election_setup_trustee ~post_params:(string "public_key") ()
let election_setup_threshold_trustees = service ~path:["setup"; "threshold-trustees"] ~get_params:(uuid "uuid") ()
let election_setup_threshold_trustee = service ~path:["setup"; "threshold-trustee"] ~get_params:(string "token") ()
let election_setup_threshold_trustee_post = post_coservice ~fallback:election_setup_threshold_trustee ~post_params:(string "data") ()
let election_setup_threshold_set = post_coservice ~fallback:election_setup_threshold_trustees ~post_params:(int "threshold") ()
let election_setup_threshold_trustee_add = post_coservice ~fallback:election_setup_threshold_trustees ~post_params:(string "id") ()
let election_setup_threshold_trustee_del = post_coservice ~fallback:election_setup_threshold_trustees ~post_params:(int "index") ()
let election_setup_confirm = service ~path:["setup"; "confirm"] ~get_params:(uuid "uuid") ()
let election_setup_create = post_coservice ~csrf_safe:true ~fallback:election_setup ~post_params:unit ()
let election_setup_auth_genpwd = post_coservice ~fallback:election_setup ~post_params:unit ()
......
......@@ -45,6 +45,9 @@ let election_stable = Ocsipersist.open_table "site_setup"
(* Table with tokens given to trustees. *)
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 credential authorities. *)
let election_credtokens = Ocsipersist.open_table "site_credtokens"
......@@ -327,6 +330,10 @@ let create_new_election owner cred auth =
se_metadata;
se_public_creds = token;
se_public_creds_received = false;
se_threshold = None;
se_threshold_trustees = None;
se_threshold_parameters = None;
se_threshold_error = None;
} in
let%lwt () = set_setup_election uuid_s se in
let%lwt () = Ocsipersist.add election_credtokens token uuid_s in
......@@ -369,6 +376,9 @@ let () = Html5.register ~service:election_setup
let () = Html5.register ~service:election_setup_trustees
(generic_setup_page T.election_setup_trustees)
let () = Html5.register ~service:election_setup_threshold_trustees
(generic_setup_page T.election_setup_threshold_trustees)
let () = Html5.register ~service:election_setup_credential_authority
(generic_setup_page T.election_setup_credential_authority)
......@@ -1512,3 +1522,228 @@ let () =
match cont with
| Some f -> f ()
| None -> Redirection.send home)
let () =
Any.register ~service:election_setup_threshold_set
(fun uuid threshold ->
if threshold < 0 then forbidden () else
let threshold = if threshold = 0 then None else Some threshold in
match%lwt Web_state.get_site_user () with
| Some u ->
let uuid_s = Uuidm.to_string uuid in
Lwt_mutex.with_lock election_setup_mutex (fun () ->
let%lwt se = get_setup_election uuid_s in
if se.se_owner = u
then (
(match se.se_threshold_trustees with
| None -> ()
| Some xs -> List.iter (fun x -> x.stt_step <- Some 1) xs
);
se.se_threshold <- threshold;
set_setup_election uuid_s se
) else forbidden ()
) >>
Redirection.send (preapply election_setup_threshold_trustees uuid)
| None -> forbidden ())
let () =
Any.register
~service:election_setup_threshold_trustee_add
(fun uuid stt_id ->
if is_email stt_id then
match%lwt Web_state.get_site_user () with
| Some u ->
let uuid_s = Uuidm.to_string uuid in
Lwt_mutex.with_lock election_setup_mutex (fun () ->
let%lwt se = get_setup_election uuid_s in
if se.se_owner = u
then (
let%lwt stt_token = generate_token () in
let trustee = {
stt_id; stt_token; stt_step = None;
stt_cert = None; stt_polynomial = None;
stt_vinput = None; stt_voutput = None;
} in
let trustees =
match se.se_threshold_trustees with
| None -> Some [trustee]
| Some t -> Some (t @ [trustee])
in
se.se_threshold_trustees <- trustees;
set_setup_election uuid_s se >>
Ocsipersist.add election_tpktokens stt_token uuid_s
) else forbidden ()
) >>
Redirection.send (preapply election_setup_threshold_trustees uuid)
| None -> forbidden ()
else
let msg = stt_id ^ " is not a valid e-mail address!" in
let service = preapply election_setup_threshold_trustees uuid in
T.generic_page ~title:"Error" ~service msg () >>= Html5.send
)
let () =
Redirection.register
~service:election_setup_threshold_trustee_del
(fun uuid index ->
match%lwt Web_state.get_site_user () with
| Some u ->
let uuid_s = Uuidm.to_string uuid in
Lwt_mutex.with_lock election_setup_mutex (fun () ->
let%lwt se = get_setup_election uuid_s in
if se.se_owner = u
then (
let trustees, old =
let trustees =
match se.se_threshold_trustees with
| None -> []
| Some x -> x
in
trustees |>
List.mapi (fun i x -> i, x) |>
List.partition (fun (i, _) -> i <> index) |>
(fun (x, y) -> List.map snd x, List.map snd y)
in
let trustees = match trustees with [] -> None | x -> Some x in
se.se_threshold_trustees <- trustees;
set_setup_election uuid_s se >>
Lwt_list.iter_s (fun {stt_token; _} ->
Ocsipersist.remove election_tpktokens stt_token
) old
) else forbidden ()
) >>
return (preapply election_setup_threshold_trustees uuid)
| None -> forbidden ()
)
let () =
Html5.register
~service:election_setup_threshold_trustee
(fun token () ->
let%lwt uuid = Ocsipersist.find election_tpktokens token in
let%lwt se = get_setup_election uuid in
let uuid = match Uuidm.of_string uuid with
| None -> failwith "invalid UUID extracted from pktokens"
| Some u -> u
in
T.election_setup_threshold_trustee token uuid se ()
)
let () =
Any.register
~service:election_setup_threshold_trustee_post
(fun token data ->
wrap_handler
(fun () ->
let%lwt uuid = Ocsipersist.find election_tpktokens token in
Lwt_mutex.with_lock election_setup_mutex
(fun () ->
let%lwt se = get_setup_election uuid in
let ts =
match se.se_threshold_trustees with
| None -> failwith "No threshold trustees"
| Some xs -> Array.of_list xs
in
let i, t =
match Array.findi (fun i x ->
if token = x.stt_token then Some (i, x) else None
) ts with
| Some (i, t) -> i, t
| None -> failwith "Trustee not found"
in
let get_certs () =
let certs = Array.map (fun x ->
match x.stt_cert with
| None -> failwith "Missing certificate"
| Some y -> y
) ts in
{certs}
in
let get_polynomials () =
Array.map (fun x ->
match x.stt_polynomial with
| None -> failwith "Missing polynomial"
| Some y -> y
) ts
in
let module G = (val Group.of_string se.se_group : GROUP) 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
(match t.stt_step with
| Some 1 ->
let cert = cert_of_string data in
if K.step1_check cert then (
t.stt_cert <- Some cert;
t.stt_step <- Some 2;
return_unit
) else (
failwith "Invalid certificate"
)
| Some 3 ->
let certs = get_certs () in
let polynomial = polynomial_of_string data in
if K.step3_check certs i polynomial then (
t.stt_polynomial <- Some polynomial;
t.stt_step <- Some 4;
return_unit
) else (
failwith "Invalid polynomial"
)
| Some 5 ->
let certs = get_certs () in
let polynomials = get_polynomials () in
let voutput = voutput_of_string G.read data in
if K.step5_check certs i polynomials voutput then (
t.stt_voutput <- Some data;
t.stt_step <- Some 6;
return_unit
) else (
failwith "Invalid voutput"
)
| _ -> failwith "Unknown step"
) >> (
if Array.forall (fun x -> x.stt_step = Some 2) ts then (
(try
K.step2 (get_certs ());
Array.iter (fun x -> x.stt_step <- Some 3) ts;
with e ->
se.se_threshold_error <- Some (Printexc.to_string e)
); return_unit
) else return_unit
) >> (
if Array.forall (fun x -> x.stt_step = Some 4) ts then (
(try
let certs = get_certs () in
let polynomials = get_polynomials () in
let vinputs = K.step4 certs polynomials in
for j = 0 to Array.length ts - 1 do
ts.(j).stt_vinput <- Some vinputs.(j)
done;
Array.iter (fun x -> x.stt_step <- Some 5) ts
with e ->
se.se_threshold_error <- Some (Printexc.to_string e)
); return_unit
) else return_unit
) >> (
if Array.forall (fun x -> x.stt_step = Some 6) ts then (
(try
let certs = get_certs () in
let polynomials = get_polynomials () in
let voutputs = Array.map (fun x ->
match x.stt_voutput with
| None -> failwith "Missing voutput"
| Some y -> voutput_of_string G.read y
) ts in
let p = K.step6 certs polynomials voutputs in
se.se_threshold_parameters <- Some (string_of_threshold_parameters G.write p);
Array.iter (fun x -> x.stt_step <- Some 7) ts
with e ->
se.se_threshold_error <- Some (Printexc.to_string e)
); return_unit
) else return_unit
) >> set_setup_election uuid se
) >>
Redirection.send (preapply election_setup_threshold_trustee token)
)
)
......@@ -587,6 +587,11 @@ let election_setup_trustees uuid se () =
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!"];
div [
pcdata "You can also set up the election so that only a ";
a ~service:election_setup_threshold_trustees [pcdata "threshold"] uuid;
pcdata " of trustees is needed to perform the decryption.";
];
br ();
trustees;
(if se.se_public_keys <> [] then
......@@ -616,6 +621,121 @@ let election_setup_trustees uuid se () =
let%lwt login_box = site_login_box () in
base ~title ?login_box ~content ()
let election_setup_threshold_trustees uuid se () =
let title = "Trustees for election " ^ se.se_questions.t_name in
let show_add_remove = se.se_threshold = None in
let form_trustees_add =
if show_add_remove then
post_form
~service:election_setup_threshold_trustee_add
(fun name ->
[
pcdata "Trustee's e-mail address: ";
string_input ~input_type:`Text ~name ();
string_input ~input_type:`Submit ~value:"Add" ();
]
) uuid
else pcdata ""
in
let mk_form_trustee_del value =
post_form
~service:election_setup_threshold_trustee_del
(fun name ->
[
int_input ~input_type:`Hidden ~name ~value ();
string_input ~input_type:`Submit ~value:"Remove" ();
]) uuid
in
let trustees = match se.se_threshold_trustees with
| None -> pcdata ""
| Some ts ->
table (
tr (
[
th [pcdata "Trustee"];
th [pcdata "Mail"];
th [pcdata "Link"];
th [pcdata "Step"];
] @ (if show_add_remove then [th [pcdata "Remove"]] else [])
) ::
List.mapi (fun i t ->
tr (
[
td [
pcdata t.stt_id;
];
td [
let uri = rewrite_prefix @@
Eliom_uri.make_string_uri
~absolute:true ~service:election_setup_threshold_trustee t.stt_token
in
let body = Printf.sprintf mail_trustee_generation uri in
let subject = "Link to generate the decryption key" in
a_mailto ~dest:t.stt_id ~subject ~body "Mail"
];
td [
a ~service:election_setup_threshold_trustee [pcdata "Link"] t.stt_token;
];
td [
pcdata (string_of_int (match t.stt_step with None -> 0 | Some x -> x));
];
] @ (if show_add_remove then [td [mk_form_trustee_del i]] else [])
)
) ts
)
in
let form_threshold =
div [
let value =
match se.se_threshold with
| None -> 0
| Some i -> i
in
post_form
~service:election_setup_threshold_set
(fun name ->
[
pcdata "Threshold: ";
int_input ~input_type:`Text ~name ~value ();
string_input ~input_type:`Submit ~value:"Set" ();
]
) uuid
]
in
let maybe_error =
match se.se_threshold_error with
| None -> pcdata ""
| Some e -> div [b [pcdata "ERROR: "]; pcdata e; br (); br ()]
in
let div_content =
div [
div [pcdata "On this page, you can configure a group of trustees such that only a threshold of them is needed to perform the decryption."];
br ();
form_threshold;
br ();
trustees;
(if se.se_threshold_trustees <> None then
div [
pcdata "There is one link per trustee. Send each trustee her link.";
br ();
br ();
maybe_error;
]
else pcdata "");
form_trustees_add;
]
in
let back_link = div [
a ~service:Web_services.election_setup
[pcdata "Go back to election setup"] uuid;
] in
let content = [
div_content;
back_link;
] in
let%lwt login_box = site_login_box () in
base ~title ?login_box ~content ()
let election_setup_credential_authority _ se () =
let title = "Credentials for election " ^ se.se_questions.t_name in
let content = [
......@@ -928,6 +1048,83 @@ let election_setup_trustee token uuid se () =
] in
base ~title ~content ()
let unsafe_textarea id contents =
Printf.ksprintf Unsafe.data
"<textarea id=\"%s\">%s</textarea>"
id contents
let election_setup_threshold_trustee token uuid se () =
let title = "Trustee for election " ^ se.se_questions.t_name in
let div_link =
let url = Eliom_uri.make_string_uri ~absolute:true
~service:election_home (uuid, ()) |> rewrite_prefix
in
div [
pcdata "The link to the election will be:";
ul [li [pcdata url]];
]
in
let%lwt trustee =
match se.se_threshold_trustees with
| None -> fail_http 404
| Some ts ->
try return (List.find (fun x -> x.stt_token = token) ts)
with Not_found -> fail_http 404
in
let%lwt certs =
match se.se_threshold_trustees with
| None -> fail_http 404
| Some ts ->
let certs = List.fold_left (fun accu x ->
match x.stt_cert with
| None -> accu
| Some c -> c :: accu
) [] ts |> Array.of_list
in return {certs}
in
let inputs =
div [
div [
pcdata "Step: ";
unsafe_textarea "step" (match trustee.stt_step with None -> "0" | Some x -> string_of_int x);
];
div [
pcdata "Group parameters: ";
unsafe_textarea "group" se.se_group;
];
div [
pcdata "Certificates: ";
unsafe_textarea "certs" (string_of_certs certs);
];
div [
pcdata "Vinput: ";
unsafe_textarea "vinput" (match trustee.stt_vinput with None -> "" | Some x -> string_of_vinput x);
];
]
in
let form =
post_form
~service:election_setup_threshold_trustee_post
(fun data ->
[
div [
div [
pcdata "Data: ";
textarea ~name:data ();
];
div [string_input ~input_type:`Submit ~value:"Submit" ()];
];
]
) token
in
let content = [
div_link;
inputs;
form;
]
in
base ~title ~content ()
let election_setup_importer ~service ~title uuid (elections, tallied, archived) () =
let format_election election =
let module W = (val election : ELECTION_DATA) in
......
......@@ -43,7 +43,9 @@ val election_setup_questions : Uuidm.t -> setup_election -> unit -> [> `Html ] E
val election_setup_credential_authority : Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_credentials : string -> Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_trustees : Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_threshold_trustees : Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_trustee : string -> Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_threshold_trustee : string -> Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_import : Uuidm.t -> setup_election -> (module ELECTION_DATA) list * (module ELECTION_DATA) list * (module ELECTION_DATA) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_import_trustees : Uuidm.t -> setup_election -> (module ELECTION_DATA) list * (module ELECTION_DATA) list * (module ELECTION_DATA) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_confirm : Uuidm.t -> setup_election -> 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