Attention une mise à jour du serveur va être effectuée le lundi 17 mai entre 13h et 13h30. Cette mise à jour va générer une interruption du service de quelques minutes.

tool_js_credgen.ml 3.5 KB
Newer Older
Stephane Glondu's avatar
Stephane Glondu committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
(**************************************************************************)
(*                                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/>.                                       *)
(**************************************************************************)

Stephane Glondu's avatar
Stephane Glondu committed
22
open Tool_js_common
Stephane Glondu's avatar
Stephane Glondu committed
23 24 25
open Tool_credgen

let generate _ =
26 27 28 29 30 31 32 33 34 35
  let ids =
    let raw = get_textarea "voters" in
    let rec loop i accu =
      if i >= 0 then
        let j = try String.rindex_from raw i '\n' with Not_found -> -1 in
        loop (j-1) (String.sub raw (j+1) (i-j) :: accu)
      else
        accu
    in loop (String.length raw - 1) []
  in
Stephane Glondu's avatar
Stephane Glondu committed
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
  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
     Dom.appendChild e x;
     let b = document##createElement (Js.string "button") in
67
     let t = document##createTextNode (Js.string "Generate") in
Stephane Glondu's avatar
Stephane Glondu committed
68 69
     b##onclick <- Dom_html.handler generate;
     Dom.appendChild b t;
70
     Dom.appendChild x b;
Stephane Glondu's avatar
Stephane Glondu committed
71 72 73 74 75
    );
  Js._false

let () =
  Dom_html.window##onload <- Dom_html.handler fill_interactivity;