Commit 99196ee3 authored by Stephane Glondu's avatar Stephane Glondu

Move credential operations to a single module

This avoids duplication...
parent 93eb4aea
......@@ -97,10 +97,8 @@ let encryptBallot params cred plaintext () =
let module P = (val params : ELECTION_DATA) in
let module G = P.G in
let module E = Election.MakeElection (G) (LwtJsRandom) in
let sk =
let hex = derive_cred P.election.e_params.e_uuid cred in
Z.(of_string_base 16 hex mod G.q)
in
let module CD = Credential.MakeDerive (G) in
let sk = CD.derive P.election.e_params.e_uuid cred in
lwt randomness = E.make_randomness P.election () in
lwt b = E.create_ballot P.election ~sk randomness plaintext () in
let s = string_of_ballot G.write b in
......@@ -276,33 +274,13 @@ let addQuestions sk params qs =
Dom.appendChild e div
)
(* Beware: the following must be changed in accordance with tool_credgen.ml! *)
let digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
let token_length = 14
let n58 = Z.of_int 58
let n53 = Z.of_int 53
let checkCredential x =
String.length x = token_length + 1 &&
let rec loop i accu =
if i < token_length then (
let digit = String.index digits x.[i] in
loop (i+1) Z.(n58 * accu + of_int digit)
) else accu
in
try
let n = loop 0 Z.zero in
let checksum = String.index digits x.[token_length] in
Z.((n + of_int checksum) mod n53 =% zero)
with Not_found -> false
let createStartButton params intro_div qs =
let b = document##createElement (Js.string "button") in
b##setAttribute (Js.string "style", Js.string "font-size:20px;");
let t = document##createTextNode (Js.string "here") in
b##onclick <- Dom_html.handler (fun _ ->
(match prompt "Please enter your credential:" with
| Some cred when checkCredential cred ->
| Some cred when Credential.check cred ->
intro_div##style##display <- Js.string "none";
setDisplayById "question_div" "block";
Dom_html.window##onbeforeunload <- Dom_html.handler (fun _ ->
......
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2016 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 Signatures
let digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
let token_length = 14
let n58 = Z.of_int 58
let n53 = Z.of_int 53
module MakeGenerate (M : RANDOM) = struct
let get_random_digit () =
M.bind (M.random n58) (fun x -> M.return (Z.to_int x))
let generate_raw_token () =
let res = Bytes.create token_length in
let rec loop i accu =
if i < token_length then (
M.bind (get_random_digit ()) (fun digit ->
Bytes.set res i digits.[digit];
loop (i+1) Z.(n58 * accu + of_int digit)
)
) else M.return (Bytes.to_string res, accu)
in loop 0 Z.zero
let add_checksum (raw, value) =
let checksum = 53 - Z.(to_int (value mod n53)) in
M.return (raw ^ String.make 1 digits.[checksum])
let generate () =
M.bind (generate_raw_token ()) add_checksum
end
let check x =
String.length x = token_length + 1 &&
let rec loop i accu =
if i < token_length then (
let digit = String.index digits x.[i] in
loop (i+1) Z.(n58 * accu + of_int digit)
) else accu
in
try
let n = loop 0 Z.zero in
let checksum = String.index digits x.[token_length] in
Z.((n + of_int checksum) mod n53 =% zero)
with Not_found -> false
let remove_dashes x =
let n = String.length x in
let res = Buffer.create n in
for i = 0 to n-1 do
let c = x.[i] in
if c <> '-' then Buffer.add_char res c;
done;
Buffer.contents res
module MakeDerive (G : GROUP) = struct
let derive uuid x =
let salt = remove_dashes (Uuidm.to_string uuid) in
let derived = pbkdf2_hex ~iterations:1000 ~salt x in
Z.(of_string_base 16 derived mod G.q)
end
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2016 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 Signatures
module MakeGenerate (M : RANDOM) : sig
val generate : unit -> string M.t
end
val check : string -> bool
module MakeDerive (G : GROUP) : sig
val derive : Uuidm.t -> string -> Z.t
end
......@@ -7,3 +7,4 @@ Common
Group_field
Group
Election
Credential
......@@ -21,11 +21,10 @@
val sha256_hex : string -> string
val sha256_b64 : string -> string
val pbkdf2_hex : iterations:int -> salt:string -> string -> string
val b64_encode_compact : string -> string
val derive_cred : Uuidm.t -> string -> string
type rng
val secure_rng : rng
val pseudo_rng : string -> rng
......
......@@ -40,25 +40,15 @@ let sha256_b64 x =
let b64_encode_compact _ = assert false
let remove_dashes x =
let n = String.length x in
let res = Buffer.create n in
for i = 0 to n-1 do
let c = x.[i] in
if c <> '-' then Buffer.add_char res c;
done;
Buffer.contents res
let derive_cred uuid x =
let uuid = remove_dashes (Uuidm.to_string uuid) in
let pbkdf2_hex ~iterations ~salt x =
let salt = Js.Unsafe.meth_call sjcl "codec.hex.toBits"
[| Js.string uuid |> Js.Unsafe.inject |]
[| Js.string salt |> Js.Unsafe.inject |]
in
let derived = Js.Unsafe.meth_call sjcl "misc.pbkdf2"
[|
Js.string x |> Js.Unsafe.inject;
salt;
Js.Unsafe.inject 1000;
Js.Unsafe.inject iterations;
Js.Unsafe.inject 256;
|]
in
......
......@@ -66,20 +66,10 @@ let pbkdf2 ~prf ~salt ~iterations ~size password =
done;
Bytes.to_string result
let remove_dashes x =
let n = String.length x in
let res = Buffer.create n in
for i = 0 to n-1 do
let c = x.[i] in
if c <> '-' then Buffer.add_char res c;
done;
Buffer.contents res
let derive_cred uuid x =
let pbkdf2_hex ~iterations ~salt x =
let open Cryptokit in
let uuid = remove_dashes (Uuidm.to_string uuid) in
let salt = transform_string (Hexa.decode ()) uuid in
pbkdf2 ~prf:MAC.hmac_sha256 ~iterations:1000 ~size:1 ~salt x |>
let salt = transform_string (Hexa.decode ()) salt in
pbkdf2 ~prf:MAC.hmac_sha256 ~iterations ~size:1 ~salt x |>
transform_string (Hexa.encode ())
type rng = Cryptokit.Random.rng
......
......@@ -52,46 +52,21 @@ let parse_params p =
module Make (P : PARSED_PARAMS) : S = struct
open P
(* Some helpers *)
(* Beware: the following must be changed in accordance with the booth! *)
let digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
let token_length = 14
let n58 = Z.of_int 58
let n53 = Z.of_int 53
module CG = Credential.MakeGenerate (Election.MakeSimpleMonad (G))
module CD = Credential.MakeDerive (G)
let derive x =
let hex = derive_cred uuid x in
let x = Z.(of_string_base 16 hex mod G.q) in
let x = CD.derive uuid x in
let y = G.(g **~ x) in
G.to_string y
let prng = lazy (pseudo_rng (random_string secure_rng 16))
let random_char () =
int_of_char (random_string (Lazy.force prng) 1).[0]
let generate_raw_token () =
let res = Bytes.create token_length in
let rec loop i accu =
if i < token_length then (
let digit = random_char () mod 58 in
Bytes.set res i digits.[digit];
loop (i+1) Z.(n58 * accu + of_int digit)
) else (Bytes.to_string res, accu)
in loop 0 Z.zero
let add_checksum (raw, value) =
let checksum = 53 - Z.(to_int (value mod n53)) in
raw ^ String.make 1 digits.[checksum]
let compute_pub_and_hash priv =
let pub = derive priv in
let hashed = sha256_hex pub in
priv, pub, hashed
let generate () =
generate_raw_token () |> add_checksum |> compute_pub_and_hash
CG.generate () () |> compute_pub_and_hash
end
......
......@@ -144,8 +144,8 @@ module Make (P : PARSED_PARAMS) : S = struct
let vote privcred ballot =
let sk =
privcred |> option_map (fun cred ->
let hex = derive_cred election.e_params.e_uuid cred in
Z.(of_string_base 16 hex mod G.q)
let module CD = Credential.MakeDerive (G) in
CD.derive election.e_params.e_uuid cred
)
in
let b = E.create_ballot election ?sk (E.make_randomness election ()) ballot () in
......
......@@ -6,6 +6,7 @@ Common
Group_field
Group
Election
Credential
Web_serializable_j
Web_common
......
......@@ -712,48 +712,7 @@ let () =
let s = Lwt_io.chars_of_file creds.Ocsigen_extensions.tmp_filename in
wrap_handler (fun () -> handle_credentials_post token s))
module Credgen = struct
module String = PString
(* FIXME: duplicate of Tool_credgen *)
let get_random_char =
let prng = Lazy.from_fun (Lwt_preemptive.detach (fun () ->
pseudo_rng (random_string secure_rng 16)
)) in
let mutex = Lwt_mutex.create () in
fun () ->
Lwt_mutex.with_lock mutex (fun () ->
lwt prng = Lazy.force prng in
let s = random_string prng 1 in
return @@ s.[0]
)
(* Beware: the following must be changed in accordance with the booth! *)
let digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
let token_length = 14
let n58 = Z.of_int 58
let n53 = Z.of_int 53
let generate_raw_token () =
let res = Bytes.create token_length in
let rec loop i accu =
if i < token_length then (
lwt digit = get_random_char () in
let digit = int_of_char digit mod 58 in
Bytes.set res i digits.[digit];
loop (i+1) Z.(n58 * accu + of_int digit)
) else return (Bytes.to_string res, accu)
in loop 0 Z.zero
let add_checksum (raw, value) =
let checksum = 53 - Z.(to_int (value mod n53)) in
return (raw ^ String.make 1 digits.[checksum])
let generate () =
generate_raw_token () >>= add_checksum
end
module CG = Credential.MakeGenerate (LwtRandom)
let () =
Any.register
......@@ -771,13 +730,13 @@ let () =
in
let module S = Set.Make (PString) in
let module G = (val Group.of_string se.se_group : GROUP) in
let module CD = Credential.MakeDerive (G) in
lwt creds =
Lwt_list.fold_left_s (fun accu v ->
let email, login = split_identity v.sv_id in
lwt cred = Credgen.generate () in
let priv_cred = derive_cred uuid cred in
lwt cred = CG.generate () in
let pub_cred =
let x = Z.(of_string_base 16 priv_cred mod G.q) in
let x = CD.derive uuid cred in
let y = G.(g **~ x) in
G.to_string y
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