Commit 20987480 authored by Stephane Glondu's avatar Stephane Glondu

Trustees can compute and submit their decryption factors

parent 8fa8209d
......@@ -2,5 +2,4 @@
<src/platform/native/*>: package(zarith), package(calendar), package(cryptokit)
<src/web/*.{ml,mli,byte,native,odoc}>: thread, package(eliom.server), syntax(camlp4o), package(lwt.syntax), package(csv)
<src/tool/tool_cmdline.*>: package(zarith), package(calendar), package(cryptokit), package(cmdliner), use_platform-native
<src/tool/tool_js*> or <src/platform/js/*> or <src/booth/*>: package(js_of_ocaml), syntax(camlp4o), package(js_of_ocaml.syntax), use_platform-js
<src/booth/*>: package(lwt.syntax)
<src/tool/tool_js*> or <src/platform/js/*> or <src/booth/*>: package(js_of_ocaml), syntax(camlp4o), package(js_of_ocaml.syntax), package(lwt.syntax), use_platform-js
......@@ -6,3 +6,4 @@ src/static/vote.html.otarget
src/static/tool_js_tkeygen.js
src/static/tool_js_credgen.js
src/static/tool_js_questions.js
src/static/tool_js_pd.js
......@@ -123,6 +123,7 @@ let () = dispatch & function
copy_rule "tool_js_tkeygen.js" "src/tool/tool_js_tkeygen.js" "src/static/tool_js_tkeygen.js";
copy_rule "tool_js_credgen.js" "src/tool/tool_js_credgen.js" "src/static/tool_js_credgen.js";
copy_rule "tool_js_questions.js" "src/tool/tool_js_questions.js" "src/static/tool_js_questions.js";
copy_rule "tool_js_pd.js" "src/tool/tool_js_pd.js" "src/static/tool_js_pd.js";
List.iter
copy_static
......
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2015 Inria *)
(* *)
(* This program is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Affero General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version, with the additional *)
(* exemption that compiling, linking, and/or using OpenSSL is allowed. *)
(* *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
(* Affero General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Affero General Public *)
(* License along with this program. If not, see *)
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Platform
open Serializable_j
open Tool_js_common
let election = ref None
let encrypted_tally = ref None
let ( >>= ) = Js.Opt.bind
let wrap f x =
(try
Js.Opt.case (f x)
(fun () -> failwith "Unexpected error")
(fun () -> ())
with
| Failure s -> alert s
| e ->
Printf.ksprintf
alert "Unexpected error: %s" (Printexc.to_string e)
); Js._false
let compute_partial_decryption _ =
Js.Opt.option !election >>= fun e ->
let election = Group.election_params_of_string e in
let module P = (val election) in
let module M = Election.MakeSimpleMonad (P.G) in
let module E = Election.MakeElection (P.G) (M) in
Js.Opt.option !encrypted_tally >>= fun e ->
let encrypted_tally = encrypted_tally_of_string P.G.read e in
document##getElementById (Js.string "private_key") >>= fun e ->
Dom_html.CoerceTo.input e >>= fun e ->
let pk_str = Js.to_string e##value in
let private_key =
try number_of_string pk_str
with e ->
Printf.ksprintf
failwith "Error in format of private key: %s" (Printexc.to_string e)
in
let factor = E.compute_factor encrypted_tally private_key () in
set_textarea "pd" (string_of_partial_decryption P.G.write factor);
Js.some ()
let compute_hash () =
let _ =
Js.Opt.option !encrypted_tally >>= fun e ->
let hash = sha256_b64 e in
document##getElementById (Js.string "hash") >>= fun e ->
let t = document##createTextNode (Js.string hash) in
Dom.appendChild e t;
Js.null
in Js._false
let main _ =
let _ =
document##getElementById (Js.string "compute") >>= fun e ->
Dom_html.CoerceTo.button e >>= fun e ->
e##onclick <- Dom_html.handler (wrap compute_partial_decryption);
Js.null
in
let _ =
Lwt.async (fun () ->
let open XmlHttpRequest in
lwt e = get "../encrypted_tally.json" in
encrypted_tally := Some e.content;
lwt e = get "../election.json" in
election := Some e.content;
Lwt.return (compute_hash ()))
in
Js._false
let () =
Dom_html.window##onload <- Dom_html.handler main
......@@ -76,3 +76,12 @@ let set_main_election x =
let unset_main_election () =
Ocsipersist.set main_election None
let election_pds = Ocsipersist.open_table "election_pds"
let get_partial_decryptions x =
try_lwt Ocsipersist.find election_pds x
with Not_found -> return []
let set_partial_decryptions x pds =
Ocsipersist.add election_pds x pds
......@@ -35,3 +35,6 @@ val add_featured_election : string -> unit Lwt.t
val remove_featured_election : string -> unit Lwt.t
val is_featured_election : string -> bool Lwt.t
val get_featured_elections : unit -> string list Lwt.t
val get_partial_decryptions : string -> (int * string) list Lwt.t
val set_partial_decryptions : string -> (int * string) list -> unit Lwt.t
......@@ -68,9 +68,12 @@ let election_cast_post = post_service ~fallback:election_cast ~post_params:(opt
let election_cast_confirm = post_coservice ~csrf_safe:true ~fallback:election_cast ~post_params:unit ()
let election_pretty_ballots = service ~path:["elections"] ~get_params:(suffix_prod (uuid "uuid" ** suffix_const "ballots") (int "start")) ()
let election_pretty_ballot = service ~path:["elections"] ~get_params:(suffix_prod (uuid "uuid" ** suffix_const "ballot") (string "hash")) ()
let election_dir = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** election_file "file")) ()
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_post = post_service ~fallback:election_tally_trustees ~post_params:(string "partial_decryption") ()
let election_dir = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** election_file "file")) ()
let scope = Eliom_common.default_session_scope
......
......@@ -976,6 +976,67 @@ let () =
(fun x -> return @@ cast_unknown_content_kind x)
) else forbidden ())
let () =
Any.register
~service:election_tally_trustees
(fun (uuid, ((), trustee_id)) () ->
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
lwt () =
match_lwt Web_persist.get_election_state uuid_s with
| `EncryptedTally _ -> return ()
| _ -> fail_http 404
in
T.tally_trustees w trustee_id () >>= Html5.send)
let () =
Any.register
~service:election_tally_trustees_post
(fun (uuid, ((), trustee_id)) partial_decryption ->
let uuid_s = Uuidm.to_string uuid in
lwt () =
match_lwt Web_persist.get_election_state uuid_s with
| `EncryptedTally _ -> return ()
| _ -> forbidden ()
in
lwt pds = Web_persist.get_partial_decryptions uuid_s in
lwt () =
if List.mem_assoc trustee_id pds then forbidden () else return ()
in
lwt () =
if trustee_id > 0 then return () else fail_http 404
in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let pks = W.dir / string_of_election_file ESKeys in
let pks = Lwt_io.lines_of_file pks in
lwt () = Lwt_stream.njunk (trustee_id-1) pks in
lwt pk = Lwt_stream.peek pks in
lwt () = Lwt_stream.junk_while (fun _ -> true) pks in
lwt pk =
match pk with
| None -> fail_http 404
| Some x -> return x
in
let pk = trustee_public_key_of_string W.G.read pk in
let pk = pk.trustee_public_key in
let pd = partial_decryption_of_string W.G.read partial_decryption in
let et = W.dir / string_of_election_file ESETally in
lwt et = Lwt_io.chars_of_file et |> Lwt_stream.to_string in
let et = encrypted_tally_of_string W.G.read et in
if W.E.check_factor et pk pd then (
let pds = (trustee_id, partial_decryption) :: pds in
lwt () = Web_persist.set_partial_decryptions uuid_s pds in
T.generic_error_page
"Your partial decryption has been received and checked!" () >>=
Html5.send
) else (
T.generic_error_page
"The partial decryption didn't pass validation!" () >>=
Html5.send
))
let content_type_of_file = function
| ESRaw | ESKeys | ESBallots | ESETally -> "application/json"
| ESCreds | ESRecords -> "text/plain"
......
......@@ -939,6 +939,56 @@ let pretty_ballots w hashes () =
lwt login_box = election_login_box w () in
base ~title ~login_box ~content ()
let tally_trustees w trustee_id () =
let module W = (val w : WEB_ELECTION) in
let params = W.election.e_params in
let title =
params.e_name ^ " — Partial decryption #" ^ string_of_int trustee_id
in
let content = [
p [pcdata "It is now time to compute your partial decryption factors."];
p [
pcdata "The hash of the encrypted tally is ";
b [span ~a:[a_id "hash"] []];
pcdata "."
];
div ~a:[a_id "input_private_key"] [
p [pcdata "Please enter your private key:"];
input
~a:[a_id "private_key"; a_size 80]
~input_type:`Text
();
button
~a:[a_id "compute"]
~button_type:`Button
[pcdata "Compute decryption factors"];
];
div ~a:[a_id "pd_done"] [
post_form
~service:election_tally_trustees_post
(fun pd ->
[
div [
textarea
~a:[a_rows 5; a_cols 40; a_id "pd"]
~name:pd
();
];
div [string_input ~input_type:`Submit ~value:"Submit" ()];
]
) (params.e_uuid, ((), trustee_id));
];
div [
script ~a:[a_src (uri_of_string (fun () -> "../../../static/sjcl.js"))] (pcdata "");
script ~a:[a_src (uri_of_string (fun () -> "../../../static/jsbn.js"))] (pcdata "");
script ~a:[a_src (uri_of_string (fun () -> "../../../static/jsbn2.js"))] (pcdata "");
script ~a:[a_src (uri_of_string (fun () -> "../../../static/random.js"))] (pcdata "");
script ~a:[a_src (uri_of_string (fun () -> "../../../static/tool_js_pd.js"))] (pcdata "");
]
] in
let login_box = pcdata "" in
base ~title ~login_box ~content ()
let login_box auth links =
let module S = (val auth : AUTH_SERVICES) in
let style =
......
......@@ -43,6 +43,8 @@ val cast_confirmation : (module WEB_ELECTION) -> can_vote:bool -> string -> unit
val cast_confirmed : (module WEB_ELECTION) -> result:[< `Error of Web_common.error | `Valid of string ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val pretty_ballots : (module WEB_ELECTION) -> string list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val tally_trustees : (module WEB_ELECTION) -> int -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val dummy :
service:(unit, 'a, [< Eliom_service.post_service_kind ],
[< Eliom_service.suff ], 'b,
......
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