Commit 46c15a7d authored by Stephane Glondu's avatar Stephane Glondu

Add Tool_js_credgen

parent 9d6742dd
......@@ -4,3 +4,4 @@ src/web/server.cma
src/static/belenios-tool.html.otarget
src/static/vote.html.otarget
src/static/tool_js_tkeygen.js
src/static/tool_js_credgen.js
......@@ -117,5 +117,6 @@ let () = dispatch & function
copy_rule "vote.html" "src/booth/vote.html" "src/static/vote.html";
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";
| _ -> ()
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2014 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
let document = Dom_html.window##document
let alert s : unit =
let open Js.Unsafe in
fun_call (variable "alert") [| s |> Js.string |> inject |]
let get_textarea id =
let res = ref None in
Js.Opt.iter
(document##getElementById (Js.string id))
(fun e ->
Js.Opt.iter
(Dom_html.CoerceTo.textarea e)
(fun x -> res := Some (Js.to_string (x##value)))
);
match !res with
| None -> raise Not_found
| Some x -> x
let set_textarea id z =
Js.Opt.iter
(document##getElementById (Js.string id))
(fun e ->
Js.Opt.iter
(Dom_html.CoerceTo.textarea e)
(fun x -> x##value <- Js.string z)
)
open Tool_credgen
let generate _ =
let number = get_textarea "number" |> int_of_string in
let ids = generate_ids number in
let module P : PARAMS = struct
let uuid = get_textarea "uuid"
let group = get_textarea "group"
end in
let module X = (val make (module P : PARAMS) : S) in
let privs, pubs, hashs =
List.fold_left
(fun (privs, pubs, hashs) id ->
let priv, pub, hash = X.generate () in
let priv = id ^ " " ^ priv and hash = id ^ " " ^ hash in
priv::privs, pub::pubs, hash::hashs
) ([], [], []) ids
in
let text_pks = pubs |> List.sort compare |> String.concat "\n" in
set_textarea "pks" text_pks;
let text_creds = privs |> List.rev |> String.concat "\n" in
let data_creds = (Js.string "data:text/plain,")##concat (Js.encodeURI (Js.string text_creds)) in
ignore (Dom_html.window##open_ (data_creds, Js.string "creds", Js.null));
let text_hashed = hashs |> List.rev |> String.concat "\n" in
let data_hashed = (Js.string "data:text/plain,")##concat (Js.encodeURI (Js.string text_hashed)) in
ignore (Dom_html.window##open_ (data_hashed, Js.string "hashed", Js.null));
alert "New windows (or tabs) were open with private credentials and credential hashes. Please save them before submitting public credentials!";
Js._false
let fill_interactivity _ =
Js.Opt.iter
(document##getElementById (Js.string "interactivity"))
(fun e ->
let x = document##createElement (Js.string "div") in
let t = document##createTextNode (Js.string "Number of credentials to generate: ") in
Dom.appendChild x t;
let y = document##createElement (Js.string "textarea") in
y##setAttribute (Js.string "id", Js.string "number");
y##setAttribute (Js.string "rows", Js.string "1");
y##setAttribute (Js.string "cols", Js.string "5");
Dom.appendChild x y;
Dom.appendChild e x;
let b = document##createElement (Js.string "button") in
let t = document##createTextNode (Js.string "Generate credentials") in
b##onclick <- Dom_html.handler generate;
Dom.appendChild b t;
Dom.appendChild e b;
);
Js._false
let () =
Dom_html.window##onload <- Dom_html.handler fill_interactivity;
......@@ -451,8 +451,8 @@ let make_login_box style auth links =
~service:election_setup_credentials_post
(fun name ->
[div
[h2 [pcdata "Submit by copy/paste"];
div [textarea ~a:[a_rows 5; a_cols 40] ~name ()];
[div [pcdata "Public credentials:"];
div [textarea ~a:[a_id "pks"; a_rows 5; a_cols 40] ~name ()];
div [string_input ~input_type:`Submit ~value:"Submit" ()]]])
token
in
......@@ -467,14 +467,38 @@ let make_login_box style auth links =
token
in
let div_download =
div [a ~service:election_setup_credentials_download
p [a ~service:election_setup_credentials_download
[pcdata "Download current file"]
token]
in
let group =
let name : 'a Eliom_parameter.param_name = Obj.magic "group" in
let value = se.se_group in
div
~a:[a_style "display:none;"]
[
div [pcdata "UUID:"];
div [textarea ~a:[a_id "uuid"; a_rows 1; a_cols 40; a_readonly `ReadOnly] ~name ~value:uuid ()];
div [pcdata "Group parameters:"];
div [textarea ~a:[a_id "group"; a_rows 5; a_cols 40; a_readonly `ReadOnly] ~name ~value ()];
]
in
let interactivity =
div
~a:[a_id "interactivity"]
[
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_credgen.js"))] (pcdata "");
]
in
let div_textarea = div [group; interactivity; form_textarea] in
let content = [
h1 [pcdata title];
div_download;
form_textarea;
div_textarea;
form_file;
] in
let login_box = pcdata "" in
......
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