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

22
open Platform
23
open Serializable_j
24
open Tool_js_common
25 26 27 28 29

let install_handler (id, handler) =
  let f _ =
    begin try handler () with e ->
      let msg = "Unexpected error: " ^ Printexc.to_string e in
30
      alert msg
31 32 33 34 35 36 37
    end;
    Js._false
  in
  Js.Opt.iter
    (document##getElementById (Js.string id))
    (fun e -> e##onclick <- Dom_html.handler f)

38
module Tests = struct
39

40
  let unit_tests () =
41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
    let a = "13133254971699857128" and b = "31748915560162976106" in
    let c = Z.of_string a and d = Z.of_string b in
    let ntests = ref 0 in
    let check name f =
      if not (f ()) then Printf.ksprintf failwith "test %s failed" name;
      incr ntests
    in
    check "ZERO" (fun () -> Z.to_string Z.zero = "0");
    check "ONE" (fun () -> Z.to_string Z.one = "1");
    let string_roundtrip a c () = a = Z.to_string c in
    check "string_roundtrip_a" (string_roundtrip a c);
    check "string_roundtrip_b" (string_roundtrip b d);
    let operator op expected () = expected = Z.to_string (op c d) in
    check "add" (operator Z.( + ) "44882170531862833234");
    check "mul" (operator Z.( * ) "416966603126589360375328894595477783568");
    check "sub" (operator Z.( - ) "-18615660588463118978");
Stephane Glondu's avatar
Stephane Glondu committed
57 58 59 60 61 62 63
    let a = 132180439 and b = 41907500 in
    let c = Z.of_int a and d = Z.of_int b in
    let int_roundtrip a c () = a = Z.to_int c in
    check "int_roundtrip_a" (int_roundtrip a c);
    check "int_roundtrip_b" (int_roundtrip b d);
    let m = Z.of_int 181944121 in
    check "mod" (fun () -> Z.to_int Z.((c * d) mod m) = 30881634);
Stephane Glondu's avatar
Stephane Glondu committed
64
    check "erem" (fun () -> Z.to_int Z.((zero - c * d) mod m) = 151062487);
Stephane Glondu's avatar
Stephane Glondu committed
65 66 67
    check "powm" (fun () -> Z.to_int (Z.powm c d m) = 81171525);
    check "invert" (fun () -> Z.to_int (Z.invert c m) = 54455411);
    check "prime" (fun () -> Z.probab_prime m 5 > 0);
Stephane Glondu's avatar
Stephane Glondu committed
68 69 70 71
    check "eq" (fun () -> Z.(c =% c));
    check "neq" (fun () -> Z.(not (c =% d)));
    check "geq" (fun () -> Z.geq c d);
    check "lt" (fun () -> Z.lt d c);
72 73 74 75 76
    let i = Z.of_string "272660753928370030481696309961224617984" in
    check "bit_length" (fun () -> Z.bit_length i = 128);
    let j = Z.of_bits "\x81\xab\xd3\xed\x0b\x19\x2e\x40\x7a\xca" in
    let k = Z.of_string "956173156978067279948673" in
    check "of_bits" (fun () -> Z.(j =% k));
77 78 79 80 81 82 83
    let key = "0000000000000000000000000000000000000000000000000000000000000000" in
    let iv = "00000000000000000000000000000000" in
    check "AES" (fun () -> aes_hex ~key ~data:iv = "dc95c078a2408989ad48a21492842087");
    let plaintext = "Lorem ipsum dolor sit amet, consectetur adipiscing elit." in
    let ciphertext = "91f136cd65db6fa83b4943395e388089d4a8d0531b43a24a6498a1433559039ce5a18734752e13418718be1c2da5cca3d89e6e62fb729a81ec1cb3d1174e770c" in
    check "AES-CCM-encrypt" (fun () -> encrypt ~key ~iv ~plaintext = ciphertext);
    check "AES-CCM-decrypt" (fun () -> decrypt ~key ~iv ~ciphertext = plaintext);
84
    Printf.ksprintf alert "%d tests were successful!" !ntests
85

86
  let cmds = ["do_unit_tests", unit_tests]
87 88
end

89 90 91 92 93
module Tkeygen = struct
  open Tool_tkeygen

  let tkeygen () =
    let module P : PARAMS = struct
94
      let group = get_textarea "election_group"
95 96
    end in
    let module X = (val make (module P : PARAMS) : S) in
97 98 99 100 101
    let open X in
    let {id; priv; pub} = trustee_keygen () in
    set_textarea "tkeygen_id" id;
    set_textarea "tkeygen_secret" priv;
    set_textarea "tkeygen_public" pub
102 103 104 105

  let cmds = ["do_tkeygen", tkeygen]
end

106 107 108 109 110 111 112 113 114 115 116 117 118
let split_lines str =
  let str = str ^ "\n" in
  let n = String.length str in
  let rec loop accu i =
    if i < n
    then (
      let j = String.index_from str i '\n' in
      let line = String.sub str i (j-i) in
      let accu = if line = "" then accu else line :: accu in
      loop accu (j+1)
    ) else List.rev accu
  in loop [] 0

119 120 121 122 123
module Credgen = struct
  open Tool_credgen

  let derive () =
    let module P : PARAMS = struct
124 125
      let uuid = get_textarea "election_uuid"
      let group = get_textarea "election_group"
126 127 128 129 130
    end in
    let module X = (val make (module P : PARAMS) : S) in
    let cred = get_textarea "credgen_derive_input" in
    set_textarea "credgen_derive_output" (X.derive cred)

131 132
  let generate ids =
    let module P : PARAMS = struct
133 134
      let uuid = get_textarea "election_uuid"
      let group = get_textarea "election_group"
135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
    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
    set_textarea "credgen_generated_creds"
      (privs |> List.rev |> String.concat "\n");
    set_textarea "credgen_generated_pks"
      (pubs |> List.sort compare |> String.concat "\n");
    set_textarea "credgen_generated_hashed"
      (hashs |> List.rev |> String.concat "\n")

  let generate_n () =
    get_textarea "credgen_number" |>
    int_of_string |> generate_ids |> generate

  let generate_ids () =
156 157
    get_textarea "credgen_ids" ^ "\n" |>
    split_lines |> generate
158

159 160
  let cmds = [
    "do_credgen_derive", derive;
161 162
    "do_credgen_generate", generate_n;
    "do_credgen_ids", generate_ids;
163 164 165
  ]
end

166 167 168 169 170
module Mkelection = struct
  open Tool_mkelection

  let mkelection () =
    let module P : PARAMS = struct
171 172
      let uuid = get_textarea "election_uuid"
      let group = get_textarea "election_group"
173 174 175
      let template = get_textarea "mkelection_template"
      let get_public_keys () =
        Some (get_textarea "mkelection_pks" |> split_lines |> Array.of_list)
176
      let get_threshold () = None
177 178 179 180 181 182 183 184 185
    end in
    let module X = (val make (module P : PARAMS) : S) in
    set_textarea "mkelection_output" (X.mkelection ())

  let cmds = [
    "do_mkelection", mkelection;
  ]
end

186 187 188 189 190 191 192 193 194 195
module ToolElection = struct
  open Tool_election

  module Getters = struct

    let get_public_keys () =
      let raw = get_textarea "election_pks" |> split_lines in
      let pks = Array.of_list raw in
      if Array.length pks = 0 then None else Some pks

196 197
    let get_threshold () = None

198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260
    let get_public_creds () =
      let raw = get_textarea "election_pubcreds" |> split_lines in
      match raw with
      | [] -> None
      | _ -> Some (Stream.of_list raw)

    let get_ballots () =
      let raw = get_textarea "election_ballots" |> split_lines in
      match raw with
      | [] -> None
      | _ -> Some (Stream.of_list raw)

    let get_result () =
      let raw = get_textarea "election_result" |> split_lines in
      match raw with
      | [] -> None
      | [r] -> Some r
      | _ -> invalid_arg "invalid result"

    let print_msg x = alert x
  end

  let get_election () =
    let raw = get_textarea "election_params" in
    match split_lines raw with
    | [e] -> e
    | _ -> invalid_arg "invalid election parameters"


  let create_ballot () =
    let module P : PARAMS = struct
      let election = get_election ()
      include Getters
    end in
    let choices = get_textarea "election_choices" |> plaintext_of_string in
    let privcred = get_textarea "election_privcred" in
    let module X = (val make (module P : PARAMS) : S) in
    set_textarea "election_ballot" (X.vote (Some privcred) choices)

  let verify () =
    let module P : PARAMS = struct
      let election = get_election ()
      include Getters
    end in
    let module X = (val make (module P : PARAMS) : S) in
    X.verify ()

  let decrypt () =
    let module P : PARAMS = struct
      let election = get_election ()
      include Getters
    end in
    let module X = (val make (module P : PARAMS) : S) in
    let privkey = get_textarea "election_privkey" in
    set_textarea "election_pd" (X.decrypt privkey)

  let finalize () =
    let module P : PARAMS = struct
      let election = get_election ()
      include Getters
    end in
    let module X = (val make (module P : PARAMS) : S) in
    let factors = get_textarea "election_factors" |> split_lines in
261
    set_textarea "election_result" (X.finalize factors)
262 263 264 265 266 267 268 269 270 271

  let cmds = [
    "do_encrypt", create_ballot;
    "do_verify", verify;
    "do_decrypt", decrypt;
    "do_finalize", finalize;
  ]

end

272 273 274 275 276 277 278 279 280 281 282 283
let int_of_quad str =
  let ( ! ) x = int_of_char str.[x] in
  (((((!0 lsl 8) lor !1) lsl 8) lor !2) lsl 8) lor !3

let new_uuid () =
  let seed = Array.init 16 (fun _ ->
    random_string secure_rng 4 |> int_of_quad
  ) in
  let s = Random.State.make seed in
  let uuid = Uuidm.v4_gen s () in
  set_textarea "election_uuid" (Uuidm.to_string uuid)

284
let cmds =
285
  ["new_uuid", new_uuid] @
286 287 288 289 290
  Tests.cmds @
  Tkeygen.cmds @
  Credgen.cmds @
  Mkelection.cmds @
  ToolElection.cmds
291 292 293 294 295 296 297 298 299

let install_handlers () =
  List.iter install_handler cmds

let () =
  Dom_html.window##onload <- Dom_html.handler (fun _ ->
    install_handlers ();
    Js._false
  )