Commit 9d6742dd authored by Stephane Glondu's avatar Stephane Glondu

Add Tool_js_tkeygen

parent f4cb7aa7
...@@ -2,5 +2,5 @@ ...@@ -2,5 +2,5 @@
<src/platform/native/*>: package(zarith), package(calendar), package(cryptokit) <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/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_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/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/booth/*>: package(lwt.syntax)
...@@ -3,3 +3,4 @@ src/lib/lib.cma ...@@ -3,3 +3,4 @@ src/lib/lib.cma
src/web/server.cma src/web/server.cma
src/static/belenios-tool.html.otarget src/static/belenios-tool.html.otarget
src/static/vote.html.otarget src/static/vote.html.otarget
src/static/tool_js_tkeygen.js
...@@ -116,4 +116,6 @@ let () = dispatch & function ...@@ -116,4 +116,6 @@ let () = dispatch & function
copy_rule "booth.js" "src/booth/booth.js" "src/static/booth.js"; copy_rule "booth.js" "src/booth/booth.js" "src/static/booth.js";
copy_rule "vote.html" "src/booth/vote.html" "src/static/vote.html"; 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";
| _ -> () | _ -> ()
(**************************************************************************)
(* 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_tkeygen
let tkeygen _ =
let module P : PARAMS = struct
let group = get_textarea "group"
end in
let module X = (val make (module P : PARAMS) : S) in
let open X in
let {id; priv; pub} = trustee_keygen () in
let data_uri = (Js.string "data:application/json,")##concat (Js.encodeURI (Js.string priv)) in
ignore (Dom_html.window##open_ (data_uri, Js.string id, Js.null));
set_textarea "pk" pub;
alert "The private key has been open in a new window (or tab). Please save it before submitting the public key!";
Js._false
let fill_interactivity _ =
Js.Opt.iter
(document##getElementById (Js.string "interactivity"))
(fun e ->
let b = document##createElement (Js.string "button") in
let t = document##createTextNode (Js.string "Generate a new keypair") in
b##onclick <- Dom_html.handler tkeygen;
Dom.appendChild b t;
Dom.appendChild e b;
);
Js._false
let () =
Dom_html.window##onload <- Dom_html.handler fill_interactivity;
...@@ -491,14 +491,37 @@ let make_login_box style auth links = ...@@ -491,14 +491,37 @@ let make_login_box style auth links =
[ [
div [ div [
div [pcdata "Public key:"]; div [pcdata "Public key:"];
div [textarea ~a:[a_rows 5; a_cols 40] ~name ~value ()]; div [textarea ~a:[a_rows 5; a_cols 40; a_id "pk"] ~name ~value ()];
div [string_input ~input_type:`Submit ~value:"Submit" ()]; div [string_input ~input_type:`Submit ~value:"Submit" ()];
] ]
] ]
) () ) ()
in 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 "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_tkeygen.js"))] (pcdata "");
]
in
let content = [ let content = [
h1 [pcdata title]; h1 [pcdata title];
group;
interactivity;
form; form;
] in ] in
let login_box = pcdata "" 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