election_tool.ml 8.26 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
51 52 53 54 55 56 57 58 59
  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
60
  (* Command-line arguments *)
61

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

Stephane Glondu's avatar
Stephane Glondu committed
68
  let speclist = Arg.([
69
    "--dir", String (fun s -> dir := s), "path to election files";
70 71 72 73 74
    "--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
75
  ])
76

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

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

84 85 86 87 88
  let anon_args = ref []

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

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

91 92 93 94 95 96 97 98 99 100 101 102
  let () = match List.rev !anon_args with
    | [] -> usage ()
    | ["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
103
  let () = Sys.chdir !dir
Stephane Glondu's avatar
Stephane Glondu committed
104

Stephane Glondu's avatar
Stephane Glondu committed
105
  (* Load and check election *)
Stephane Glondu's avatar
Stephane Glondu committed
106

Stephane Glondu's avatar
Stephane Glondu committed
107 108 109 110 111 112 113
  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
114

Stephane Glondu's avatar
Stephane Glondu committed
115 116 117
  let {ffpk_g = g; ffpk_p = p; ffpk_q = q; ffpk_y = y} = params.e_public_key
  let group = {g; p; q}
  let () = assert (Election.check_finite_field group)
Stephane Glondu's avatar
Stephane Glondu committed
118

119 120 121 122
  let sk_file = !sk_file
  let do_finalize = !do_finalize
  let do_decrypt = !do_decrypt

Stephane Glondu's avatar
Stephane Glondu committed
123
end
124 125


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

Stephane Glondu's avatar
Stephane Glondu committed
128 129 130
  open P
  module M = Election.MakeSimpleMonad(G)
  module E = Election.MakeElection(G)(M);;
Stephane Glondu's avatar
Stephane Glondu committed
131

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

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

Stephane Glondu's avatar
Stephane Glondu committed
136 137 138 139
  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
140

Stephane Glondu's avatar
Stephane Glondu committed
141 142 143 144 145 146 147
  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
148

Stephane Glondu's avatar
Stephane Glondu committed
149 150 151 152
  let public_keys =
    option_map (
      Array.map (fun pk -> pk.trustee_public_key)
    ) public_keys_with_pok
Stephane Glondu's avatar
Stephane Glondu committed
153

Stephane Glondu's avatar
Stephane Glondu committed
154
  (* Finish setting up the election *)
Stephane Glondu's avatar
Stephane Glondu committed
155

Stephane Glondu's avatar
Stephane Glondu committed
156 157 158 159 160
  let metadata =
    match (load_from_file Serializable_j.metadata_of_string "metadata.json") with
    | Some [m] -> Some m
    | Some _ -> failwith "invalid metadata.json"
    | None -> None
Stephane Glondu's avatar
Stephane Glondu committed
161

Stephane Glondu's avatar
Stephane Glondu committed
162 163 164
  let pks = match public_keys with
    | Some pks -> pks
    | None -> failwith "missing public keys"
Stephane Glondu's avatar
Stephane Glondu committed
165

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

Stephane Glondu's avatar
Stephane Glondu committed
173
  (* Load ballots, if present *)
Stephane Glondu's avatar
Stephane Glondu committed
174

Stephane Glondu's avatar
Stephane Glondu committed
175
  module ZSet = Set.Make(Z)
Stephane Glondu's avatar
Stephane Glondu committed
176

Stephane Glondu's avatar
Stephane Glondu committed
177 178 179 180 181 182 183
  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
184

Stephane Glondu's avatar
Stephane Glondu committed
185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213
  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
    then M.cast b "anonymous" ()
    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 _ ->
        M.fold_ballots (fun b t ->
          M.return (E.combine_ciphertexts (E.extract_ciphertext b) t)
        ) (E.neutral_ciphertext e) ()
Stephane Glondu's avatar
Stephane Glondu committed
214 215
  )

216 217
  let () = if do_decrypt then
    match sk_file with
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
    | 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
238

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

Stephane Glondu's avatar
Stephane Glondu committed
241 242 243 244 245 246 247 248 249
  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
250
    | Some _ ->
Stephane Glondu's avatar
Stephane Glondu committed
251 252 253 254 255 256 257
      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
258
        let tally = Lazy.force encrypted_tally in
Stephane Glondu's avatar
Stephane Glondu committed
259 260 261
        assert (Array.forall2 (E.check_factor tally) pks factors);
        let result = E.combine_factors (M.turnout ()) tally factors in
        assert (E.check_result e result);
262 263 264 265 266 267
        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
268 269 270 271 272
      | None -> ()

  (* The end *)

  let () = Printf.eprintf "All checks passed!\n%!"
273 274 275 276

end


277
let main () =
278 279 280 281
  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
  ()