credgen.ml 7.51 KB
Newer Older
Stephane Glondu's avatar
Stephane Glondu committed
1
2
3
(**************************************************************************)
(*                                BELENIOS                                *)
(*                                                                        *)
Stephane Glondu's avatar
Stephane Glondu committed
4
(*  Copyright © 2012-2014 Inria                                           *)
Stephane Glondu's avatar
Stephane Glondu committed
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/>.                                       *)
(**************************************************************************)

Stephane Glondu's avatar
Stephane Glondu committed
22
open Signatures
Stephane Glondu's avatar
Stephane Glondu committed
23
24
open Util

Stephane Glondu's avatar
Stephane Glondu committed
25
26
27
28
29
30
31
32
33
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

34
let do_derive uuid x =
Stephane Glondu's avatar
Stephane Glondu committed
35
36
37
38
39
40
  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 |>
  transform_string (Hexa.encode ())

41
42
43
44
45
46
47
48
module type PARAMS = sig
  val group : (module Election.FF_GROUP)
  val uuid : Uuidm.t
  val count : int option ref
  val file : string option ref
  val derive : string option ref
  val dir : string ref
end
Stephane Glondu's avatar
Stephane Glondu committed
49

Stephane Glondu's avatar
Stephane Glondu committed
50
module GetParams (X : EMPTY) : PARAMS = struct
Stephane Glondu's avatar
Stephane Glondu committed
51
52
53
54
55
56
57
58

  (* Argument parsing *)

  let dir = ref (Sys.getcwd ())
  let uuid = ref None
  let count = ref None
  let file = ref None
  let derive = ref None
59
  let group = ref None
Stephane Glondu's avatar
Stephane Glondu committed
60
61
62
63
64
65
66

  let speclist = Arg.([
    "--dir", String (fun s -> dir := s), "directory where output will be written";
    "--uuid", String (fun s -> uuid := Some s), "UUID of the election";
    "--count", Int (fun i -> count := Some i), "number of credentials to generate";
    "--file", String (fun s -> file := Some s), "file with list of identities";
    "--derive", String (fun s -> derive := Some s), "derive public credential from given private one";
67
    "--group", String (fun s -> group := Some s), "file with group parameters";
Stephane Glondu's avatar
Stephane Glondu committed
68
69
70
71
72
73
74
  ])

  let usage_msg =
    Printf.sprintf "Usage: %s credgen [--dir <dir>] --uuid <uuid> {--count <n> | --file <file> | --derive <privcred>}" Sys.argv.(0)

  let anon_fun x =
    Printf.eprintf "I do not know what to do with %s!\n" x;
Stephane Glondu's avatar
Stephane Glondu committed
75
76
    exit 1

Stephane Glondu's avatar
Stephane Glondu committed
77
78
  let () = Arg.parse speclist anon_fun usage_msg

79
80
81
82
83
84
85
86
87
88
89
90
  let group = match !group with
    | None ->
      Printf.eprintf "--group is missing!\n";
      exit 1
    | Some fname ->
      let ic = open_in fname in
      let ls = Yojson.init_lexer () in
      let lb = Lexing.from_channel ic in
      let r = Serializable_j.read_ff_params ls lb in
      close_in ic;
      Election.finite_field r

Stephane Glondu's avatar
Stephane Glondu committed
91
92
93
  let uuid = match !uuid with
    | None ->
      Printf.eprintf "UUID is missing!\n";
94
      exit 1
Stephane Glondu's avatar
Stephane Glondu committed
95
96
    | Some u ->
      match Uuidm.of_string u with
Stephane Glondu's avatar
Stephane Glondu committed
97
        | Some u -> u
Stephane Glondu's avatar
Stephane Glondu committed
98
99
100
101
        | None ->
          Printf.eprintf "UUID is invalid!\n";
          exit 1

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
end

module RunCredgen (P : PARAMS) (G : Election.FF_GROUP) = 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

  let public_key_of_token uuid x =
    let hex = do_derive uuid x in
    let x = Z.(of_string_base 16 hex mod G.q) in
    let y = G.(g **~ x) in
    Z.to_string y

Stephane Glondu's avatar
Stephane Glondu committed
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
  let count, ids =
    match !count, !file, !derive with
      | Some i, None, None ->
        if i < 1 then (
          Printf.eprintf "You must generate at least one credential!\n";
          exit 1
        ); i, None
      | None, Some f, None ->
        let ic = open_in f in
        let rec loop accu =
          match (try Some (input_line ic) with End_of_file -> None) with
            | Some "" -> loop accu
            | Some x -> loop (x::accu)
            | None -> List.rev accu
        in
        let res = loop [] in
        close_in ic;
        List.length res, Some res
      | None, None, Some d ->
        print_endline (public_key_of_token uuid d);
        exit 0
      | None, None, None ->
        Printf.eprintf "Nothing to do: use --count, --file or --derive!\n";
        exit 1
      | _, _, _ ->
        Printf.eprintf "Conflicting options!\n";
        exit 1
  ;;

  (* The generation itself, if requested *)

  let prng = Cryptokit.Random.(pseudo_rng (string secure_rng 16))
  let random_char () = int_of_char (Cryptokit.Random.string prng 1).[0]

  let generate_raw_token () =
    let res = String.create token_length in
    let rec loop i accu =
      if i < token_length then (
        let digit = random_char () mod 58 in
        res.[i] <- digits.[digit];
        loop (i+1) Z.(n58 * accu + of_int digit)
      ) else (res, accu)
    in loop 0 Z.zero

  let generate_token () =
    let (raw, value) = generate_raw_token () in
    let checksum = 53 - Z.(to_int (value mod n53)) in
    raw ^ String.make 1 digits.[checksum]

  let private_credentials =
    let rec loop i accu =
      if i > 0 then loop (i-1) (generate_token () :: accu)
      else accu
    in loop count []

  let public_credentials =
    List.map (public_key_of_token uuid) private_credentials

  let hashed_credentials = option_map (fun ids ->
    List.map2 (fun id cred ->
      Printf.sprintf "%s %s" (sha256_hex cred) id
    ) ids public_credentials
  ) ids

  (* Save to files *)

  let timestamp = Printf.sprintf "%.0f" (Unix.time ())

  let pub =
    "public credentials",
191
    timestamp ^ ".pubcreds",
Stephane Glondu's avatar
Stephane Glondu committed
192
193
194
195
196
197
198
199
200
201
202
203
    0o444,
    List.sort compare public_credentials

  let priv =
    let kind, creds = match ids with
      | None -> "private credentials", private_credentials
      | Some ids -> "private credentials with ids",
        List.map2 (fun id cred ->
          Printf.sprintf "%s %s" cred id
        ) ids private_credentials
    in
    kind,
204
    timestamp ^ ".privcreds",
Stephane Glondu's avatar
Stephane Glondu committed
205
206
207
208
209
    0o400,
    List.sort compare creds

  let hashed = option_map (fun h ->
    "hashed credentials with ids",
210
    timestamp ^ ".hashcreds",
Stephane Glondu's avatar
Stephane Glondu committed
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
    0o400,
    List.sort compare h
  ) hashed_credentials

  let output_endline oc x =
    output_string oc x;
    output_char oc '\n'

  let save (kind, filename, perm, thing) =
    let full_filename = Filename.concat !dir filename in
    let oc = open_out_gen [
      Open_wronly; Open_creat; Open_excl
    ] perm full_filename in
    List.iter (output_endline oc) thing;
    close_out oc;
    Printf.printf "%d %s saved to %s\n%!" count kind full_filename;;

  save pub;;
  save priv;;
  ignore (option_map save hashed);;
231
232
233

end

234
let derive = do_derive
235

236
let main () =
237
238
239
  let module P = GetParams (struct end) in
  let module G = (val P.group : Election.FF_GROUP) in
  let module X = RunCredgen (P) (G) in
240
  ()