MAJ terminée. Nous sommes passés en version 14.6.2 . Pour consulter les "releases notes" associées c'est ici :

https://about.gitlab.com/releases/2022/01/11/security-release-gitlab-14-6-2-released/
https://about.gitlab.com/releases/2022/01/04/gitlab-14-6-1-released/

election_tool.ml 9.12 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
25
26
27
28
29
30
31
32
33
34
35
open Util
open Serializable_t

(* Helpers *)

let load_from_file of_string filename =
  if Sys.file_exists filename then (
    Printf.eprintf "Loading %s...\n%!" filename;
    let ic = open_in filename in
    let lines =
      let rec loop lines =
        match (try Some (input_line ic) with End_of_file -> None) with
        | Some "" -> loop lines
Stephane Glondu's avatar
Stephane Glondu committed
36
        | Some line -> loop (of_string line::lines)
Stephane Glondu's avatar
Stephane Glondu committed
37
38
39
40
        | None -> lines
      in loop []
    in
    close_in ic;
Stephane Glondu's avatar
Stephane Glondu committed
41
    Some (List.rev lines)
Stephane Glondu's avatar
Stephane Glondu committed
42
43
44
45
  ) else None

let read_number = Serializable_builtin_j.read_number

46
47

module type PARAMS = sig
48
49
50
  val sk_file : string option
  val do_finalize : bool
  val do_decrypt : bool
Stephane Glondu's avatar
Stephane Glondu committed
51
  val ballot_file : string option
52
53
54
55
56
57
58
59
60
  val params : ff_pubkey params
  val election_fingerprint : string
  val group :  ff_params
  val y : number
end


module GetParams (X : sig end) : PARAMS = struct

Stephane Glondu's avatar
Stephane Glondu committed
61
  (* Command-line arguments *)
62

63
64
  let initial_dir = Sys.getcwd ()
  let dir = ref initial_dir
Stephane Glondu's avatar
Stephane Glondu committed
65
  let sk_file = ref None
66
67
  let do_finalize = ref false
  let do_decrypt = ref false
Stephane Glondu's avatar
Stephane Glondu committed
68
  let ballot_file = ref None
69

Stephane Glondu's avatar
Stephane Glondu committed
70
  let speclist = Arg.([
71
    "--dir", String (fun s -> dir := s), "path to election files";
72
73
74
75
76
    "--privkey", String (fun s ->
      let fname =
        if Filename.is_relative s then Filename.concat initial_dir s else s
      in sk_file := Some fname
    ), "path to private key";
Stephane Glondu's avatar
Stephane Glondu committed
77
  ])
78

Stephane Glondu's avatar
Stephane Glondu committed
79
  let usage_msg =
Stephane Glondu's avatar
Stephane Glondu committed
80
    Printf.sprintf "Usage: %s election [--dir <dir>] [--privkey <privkey>] { vote <ballot> | verify | decrypt | finalize }" Sys.argv.(0)
81

82
83
  let usage () =
    Arg.usage speclist usage_msg;
Stephane Glondu's avatar
Stephane Glondu committed
84
    exit 1
85

86
87
88
89
90
  let anon_args = ref []

  let anon_fun x =
    anon_args := x :: !anon_args

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

93
94
  let () = match List.rev !anon_args with
    | [] -> usage ()
Stephane Glondu's avatar
Stephane Glondu committed
95
96
97
98
99
100
101
    | ["vote"; f] ->
      let f =
        if Filename.is_relative f then Filename.concat initial_dir f else f
      in ballot_file := Some f
    | ["vote"] ->
      Printf.eprintf "ballot file is missing\n";
      exit 1
102
103
104
105
106
107
108
109
110
111
    | ["verify"] -> ()
    | ["finalize"] -> do_finalize := true
    | ["decrypt"] ->
      (match !sk_file with
      | None ->
        Printf.eprintf "--privkey is missing\n";
        exit 1
      | Some _ -> do_decrypt := true)
    | x :: _ -> usage ()

Stephane Glondu's avatar
Stephane Glondu committed
112
  let () = Sys.chdir !dir
Stephane Glondu's avatar
Stephane Glondu committed
113

Stephane Glondu's avatar
Stephane Glondu committed
114
  (* Load and check election *)
Stephane Glondu's avatar
Stephane Glondu committed
115

Stephane Glondu's avatar
Stephane Glondu committed
116
117
118
119
120
121
122
  let params, election_fingerprint =
    match (load_from_file (fun l ->
      Serializable_j.(params_of_string read_ff_pubkey l),
      sha256_b64 l
    ) "election.json") with
    | Some [e] -> e
    | _ -> failwith "invalid election file"
Stephane Glondu's avatar
Stephane Glondu committed
123

Stephane Glondu's avatar
Stephane Glondu committed
124
125
  let {ffpk_g = g; ffpk_p = p; ffpk_q = q; ffpk_y = y} = params.e_public_key
  let group = {g; p; q}
Stephane Glondu's avatar
Stephane Glondu committed
126

127
128
129
  let sk_file = !sk_file
  let do_finalize = !do_finalize
  let do_decrypt = !do_decrypt
Stephane Glondu's avatar
Stephane Glondu committed
130
  let ballot_file = !ballot_file
131

Stephane Glondu's avatar
Stephane Glondu committed
132
end
133
134


Stephane Glondu's avatar
Stephane Glondu committed
135
module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct
136

Stephane Glondu's avatar
Stephane Glondu committed
137
138
139
  open P
  module M = Election.MakeSimpleMonad(G)
  module E = Election.MakeElection(G)(M);;
Stephane Glondu's avatar
Stephane Glondu committed
140

Stephane Glondu's avatar
Stephane Glondu committed
141
  (* Load and check trustee keys, if present *)
Stephane Glondu's avatar
Stephane Glondu committed
142

Stephane Glondu's avatar
Stephane Glondu committed
143
  module KG = Election.MakeSimpleDistKeyGen(G)(M);;
Stephane Glondu's avatar
Stephane Glondu committed
144

Stephane Glondu's avatar
Stephane Glondu committed
145
146
147
148
  let public_keys_with_pok =
    load_from_file (
      Serializable_j.trustee_public_key_of_string read_number
    ) "public_keys.jsons" |> option_map Array.of_list
Stephane Glondu's avatar
Stephane Glondu committed
149

Stephane Glondu's avatar
Stephane Glondu committed
150
151
152
153
154
155
156
  let () =
    match public_keys_with_pok with
    | Some pks ->
      assert (Array.forall KG.check pks);
      let y' = KG.combine pks in
      assert (P.y =% y')
    | None -> ()
Stephane Glondu's avatar
Stephane Glondu committed
157

Stephane Glondu's avatar
Stephane Glondu committed
158
159
160
161
  let public_keys =
    option_map (
      Array.map (fun pk -> pk.trustee_public_key)
    ) public_keys_with_pok
Stephane Glondu's avatar
Stephane Glondu committed
162

Stephane Glondu's avatar
Stephane Glondu committed
163
  (* Finish setting up the election *)
Stephane Glondu's avatar
Stephane Glondu committed
164

Stephane Glondu's avatar
Stephane Glondu committed
165
166
167
  let pks = match public_keys with
    | Some pks -> pks
    | None -> failwith "missing public keys"
Stephane Glondu's avatar
Stephane Glondu committed
168

Stephane Glondu's avatar
Stephane Glondu committed
169
170
171
172
173
  let e = {
    e_params = { params with e_public_key = P.y };
    e_pks = Some pks;
    e_fingerprint = election_fingerprint;
  }
Stephane Glondu's avatar
Stephane Glondu committed
174

Stephane Glondu's avatar
Stephane Glondu committed
175
  (* Load ballots, if present *)
Stephane Glondu's avatar
Stephane Glondu committed
176

Stephane Glondu's avatar
Stephane Glondu committed
177
  module ZSet = Set.Make(Z)
Stephane Glondu's avatar
Stephane Glondu committed
178

Stephane Glondu's avatar
Stephane Glondu committed
179
180
181
182
183
184
185
  let public_creds =
    load_from_file Z.of_string "public_creds.txt" |>
    option_map (fun xs ->
      List.fold_left (fun accu x ->
        ZSet.add x accu
      ) ZSet.empty xs
    )
Stephane Glondu's avatar
Stephane Glondu committed
186

Stephane Glondu's avatar
Stephane Glondu committed
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
  let ballots =
    load_from_file (fun line ->
      Serializable_j.ballot_of_string read_number line,
      sha256_b64 line
    ) "ballots.jsons"

  let check_signature_present =
    match public_creds with
    | Some creds -> (fun b ->
      match b.signature with
      | Some s -> ZSet.mem s.s_public_key creds
      | None -> false
    )
    | None -> (fun _ -> true)

  let vote (b, hash) =
    if check_signature_present b && E.check_ballot e b
204
    then M.cast b ()
Stephane Glondu's avatar
Stephane Glondu committed
205
206
207
208
209
210
211
212
    else Printf.ksprintf failwith "ballot %s failed tests" hash

  let () = ballots |> option_map (List.iter vote) |> ignore

  let encrypted_tally = lazy (
    match ballots with
      | None -> failwith "ballots.jsons is missing"
      | Some _ ->
213
        M.fold (fun () b t ->
Stephane Glondu's avatar
Stephane Glondu committed
214
215
          M.return (E.combine_ciphertexts (E.extract_ciphertext b) t)
        ) (E.neutral_ciphertext e) ()
Stephane Glondu's avatar
Stephane Glondu committed
216
217
  )

Stephane Glondu's avatar
Stephane Glondu committed
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
  let () = match ballot_file with
    | None -> ()
    | Some fn ->
      (match load_from_file Serializable_j.plaintext_of_string fn with
      | Some [b] ->
        let sk =
          match sk_file with
          | Some fn ->
            (match load_from_file (fun x -> x) fn with
            | Some [cred] ->
              let hex = Credgen.derive e.e_params.e_uuid cred in
              Some Z.(of_string_base 16 hex mod G.q)
            | _ -> failwith "invalid credential file"
            )
          | None -> None
        in
        let b = E.create_ballot e ?sk (E.make_randomness e ()) b () in
        assert (E.check_ballot e b);
        print_endline (
          Serializable_j.string_of_ballot
            Serializable_builtin_j.write_number b
        )
      | _ -> failwith "invalid plaintext ballot file"
      )

243
244
  let () = if do_decrypt then
    match sk_file with
Stephane Glondu's avatar
Stephane Glondu committed
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
    | Some fn ->
      (match load_from_file (Serializable_builtin_j.number_of_string) fn with
        | Some [sk] ->
          let pk = G.(g **~ sk) in
          if Array.forall (fun x -> not (x =% pk)) pks then (
            Printf.eprintf "Warning: your key is not present in public_keys.jsons!\n";
          );
          let tally = Lazy.force encrypted_tally in
          let factor =
            E.compute_factor tally sk ()
          in
          assert (E.check_factor tally pk factor);
          print_endline (
            Serializable_j.string_of_partial_decryption
              Serializable_builtin_j.write_number
              factor
          )
        | _ -> failwith "invalid private key file"
      )
    | None -> ()
Stephane Glondu's avatar
Stephane Glondu committed
265

Stephane Glondu's avatar
Stephane Glondu committed
266
  (* Load or compute result, and check it *)
Stephane Glondu's avatar
Stephane Glondu committed
267

Stephane Glondu's avatar
Stephane Glondu committed
268
269
270
271
272
273
274
275
276
  let result =
    load_from_file (
      Serializable_j.result_of_string read_number
    ) "result.json"

  let () =
    match result with
    | Some [result] ->
      assert (E.check_result e result)
Stephane Glondu's avatar
Stephane Glondu committed
277
    | Some _ ->
Stephane Glondu's avatar
Stephane Glondu committed
278
279
280
281
282
283
284
      failwith "invalid result file"
    | None ->
      let factors = load_from_file (
        Serializable_j.partial_decryption_of_string read_number
      ) "partial_decryptions.jsons" |> option_map Array.of_list in
      match factors with
      | Some factors ->
Stephane Glondu's avatar
Stephane Glondu committed
285
        let tally = Lazy.force encrypted_tally in
Stephane Glondu's avatar
Stephane Glondu committed
286
        assert (Array.forall2 (E.check_factor tally) pks factors);
287
        let result = E.combine_factors (M.cardinal ()) tally factors in
Stephane Glondu's avatar
Stephane Glondu committed
288
        assert (E.check_result e result);
289
290
291
292
293
294
        if do_finalize then (
          save_to "result.json" (
            Serializable_j.write_result Serializable_builtin_j.write_number
          ) result;
          Printf.eprintf "result.json written\n%!"
        );
Stephane Glondu's avatar
Stephane Glondu committed
295
296
297
298
299
      | None -> ()

  (* The end *)

  let () = Printf.eprintf "All checks passed!\n%!"
300
301
302
303

end


304
let main () =
305
306
307
308
  let module P = GetParams(struct end) in
  let module G = (val Election.finite_field P.group : Election.FF_GROUP) in
  let module X = RunTool (G) (P) in
  ()