Commit 0070f0d5 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Use Cmdliner for command-line parsing

Side-effects:
 - more uniform handling of --help and --version, automatic generation
   of Unix manpages
 - slight change in syntax (see demo.sh)
 - sub-commands of "election" (Tool_election) are now direct commands,
   "election" itself disappears
 - in Tool_election, concatenate with --dir option (if any) instead of
   calling chdir
parent d6c49fc7
......@@ -37,7 +37,7 @@ If you put these files in a directory `/path/to/election`, the following
command will perform all possible verifications, depending on existing
files:
belenios-tool election --dir /path/to/election verify
belenios-tool verify --dir /path/to/election
For example, during the election, you can check if some candidate
ballot is acceptable by putting it alone in `ballots.jsons`, and
......@@ -48,7 +48,7 @@ your choices in a file `/path/to/choices.json` (as an array of arrays
of 0/1 in JSON format), the following command will output a ballot
that can be directly submitted:
belenios-tool election --dir /path/to/election --privkey /path/to/credential vote /path/to/choices.json
belenios-tool vote --dir /path/to/election --privcred /path/to/credential --ballot /path/to/choices.json
Trustee's guide
......@@ -70,7 +70,7 @@ with extreme care.
To compute your decryption share, set `/path/to/election` up as
described in the _Voter's guide_ section above, and run:
belenios-tool election --dir /path/to/election --privkey /path/to/privkey decrypt > partial_decryption.json
belenios-tool decrypt --dir /path/to/election --privkey /path/to/privkey > partial_decryption.json
and send `partial_decryption.json` to the election
administrator.
......@@ -176,7 +176,7 @@ to be able to access the administration page specific to the election.
2. Concatenate the `partial_decryption.json` received from each
trustee into a `partial_decryptions.jsons`, in the same order as in
`public_keys.jsons`.
3. Run `belenios-tool election finalize`. It will create
3. Run `belenios-tool finalize`. It will create
`result.json`. Publish this file, along with the files listed in
the first step above. The whole set will enable universal
verifiability.
......
<**/*.{ml,mli,byte,native,odoc}>: debug, annot, thread, package(zarith), package(calendar), package(uuidm), package(cryptokit), package(atdgen), package(yojson)
<demo/**/*.{ml,mli,byte,native,odoc}>: package(lwt.unix), syntax(camlp4o), package(lwt.syntax)
<src/web/*.{ml,mli,byte,native,odoc}>: package(eliom.server), syntax(camlp4o), package(lwt.syntax), package(csv)
<src/tool/*>: binary
<src/tool/*>: binary, package(cmdliner)
<stuff/*>: binary
......@@ -42,7 +42,7 @@ belenios-tool mkelection $uuid $group --template $BELENIOS/demo/templates/electi
header "Simulate votes"
cat private_creds.txt | while read cred; do
belenios-tool election --privkey <(echo $cred) vote <(printf "[[0,0,0,0,0],[0,1,0,1,1,0],[0,0,1]]")
belenios-tool vote --privcred <(echo $cred) --ballot <(printf "[[0,0,0,0,0],[0,1,0,1,1,0],[0,0,1]]")
echo >&2
done > ballots.tmp
mv ballots.tmp ballots.jsons
......@@ -50,14 +50,14 @@ mv ballots.tmp ballots.jsons
header "Perform decryption"
for u in *.privkey; do
belenios-tool election --privkey $u decrypt
belenios-tool decrypt --privkey $u
echo >&2
done > partial_decryptions.tmp
mv partial_decryptions.tmp partial_decryptions.jsons
header "Finalize tally"
belenios-tool election finalize
belenios-tool finalize
echo
echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-="
......
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2014 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/>. *)
(**************************************************************************)
exception Cmdline_error of string
let failcmd fmt = Printf.ksprintf (fun x -> raise (Cmdline_error x)) fmt
let common_man = [
`S "MORE INFORMATION";
`P "This command is part of the Belenios command-line tool.";
`P "See $(i,http://belenios.gforge.inria.fr/).";
]
let get_mandatory_opt name = function
| Some x -> x
| None -> failcmd "%s is mandatory" name
let wrap_main f =
try
let () = f () in `Ok ()
with
| Cmdline_error e -> `Error (true, e)
| Failure e -> `Error (false, e)
| e -> `Error (false, Printexc.to_string e)
let group_c =
(fun fname ->
if Sys.file_exists fname then (
try
let ic = open_in fname in
let ls = Yojson.init_lexer () in
let lb = Lexing.from_channel ic in
let r = Group.read ls lb in
close_in ic;
`Ok (fname, r)
with e ->
let e = Printexc.to_string e and s = Printf.sprintf in
`Error (s "could not read group parameters from %s (%s)" fname e)
) else `Error (Printf.sprintf "file %s does not exist" fname)
), (fun fmt (fname, _) -> Format.pp_print_string fmt fname)
let uuid_c =
(fun u ->
match Uuidm.of_string u with
| Some uuid -> `Ok uuid
| None -> `Error (Printf.sprintf "%s is not a valid UUID" u)
), (fun fmt u -> Format.pp_print_string fmt (Uuidm.to_string u))
open Cmdliner
let group_t =
let doc = "Take group parameters from file $(docv)." in
Arg.(value & opt (some group_c) None & info ["group"] ~docv:"GROUP" ~doc)
let uuid_t =
let doc = "UUID of the election." in
Arg.(value & opt (some uuid_c) None & info ["uuid"] ~docv:"UUID" ~doc)
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2014 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/>. *)
(**************************************************************************)
exception Cmdline_error of string
val failcmd : ('a, unit, string, 'b) format4 -> 'a
val common_man : [> `Noblank | `P of string | `S of string ] list
val get_mandatory_opt : string -> 'a option -> 'a
val wrap_main : (unit -> unit) -> [> `Error of bool * string | `Ok of unit ]
val group_t : (string * (module Signatures.GROUP)) option Cmdliner.Term.t
val uuid_t : Uuidm.t option Cmdliner.Term.t
......@@ -38,82 +38,16 @@ let do_derive uuid x =
pbkdf2 ~prf:MAC.hmac_sha256 ~iterations:1000 ~size:1 ~salt x |>
transform_string (Hexa.encode ())
type generate_kind = Count of int | File of string
type action = Derive of string | Generate of generate_kind
module type PARAMS = sig
val uuid : Uuidm.t
val count : int option
val file : string option
val derive : string option
val action : action
val dir : string
module G : GROUP
end
let parse_args () = begin
(* Argument parsing *)
let dir = ref (Sys.getcwd ()) in
let uuid = ref None in
let count = ref None in
let file = ref None in
let derive = ref None in
let group = ref None in
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";
"--group", String (fun s -> group := Some s), "file with group parameters";
]) in
let usage_msg =
Printf.sprintf "Usage: %s credgen [--dir <dir>] --uuid <uuid> {--count <n> | --file <file> | --derive <privcred>}" Sys.argv.(0)
in
let anon_fun x =
Printf.eprintf "I do not know what to do with %s!\n" x;
exit 1
in
let () = Arg.parse speclist anon_fun usage_msg in
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 = Group.read ls lb in
close_in ic;
r
in
let module P = struct
let uuid = match !uuid with
| None ->
Printf.eprintf "UUID is missing!\n";
exit 1
| Some u ->
match Uuidm.of_string u with
| Some u -> u
| None ->
Printf.eprintf "UUID is invalid!\n";
exit 1
let count = !count
let file = !file
let derive = !derive
let dir = !dir
module G = (val group : GROUP)
end in
(module P : PARAMS)
end
module Run (P : PARAMS) : EMPTY = struct
open P
......@@ -131,122 +65,174 @@ module Run (P : PARAMS) : EMPTY = struct
let y = G.(g **~ x) in
G.to_string y
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 generate kind = begin
let count, ids = match kind with
| File f ->
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
| 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",
timestamp ^ ".pubcreds",
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
| Count i -> i, None
in
(* The generation itself *)
let prng = Cryptokit.Random.(pseudo_rng (string secure_rng 16)) in
let random_char () = int_of_char (Cryptokit.Random.string prng 1).[0] in
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
in
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]
in
let private_credentials =
let rec loop i accu =
if i > 0 then loop (i-1) (generate_token () :: accu)
else accu
in loop count []
in
let public_credentials =
List.map (public_key_of_token uuid) private_credentials
in
kind,
timestamp ^ ".privcreds",
0o400,
List.sort compare creds
let hashed = option_map (fun h ->
"hashed credentials with ids",
timestamp ^ ".hashcreds",
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);;
let hashed_credentials = option_map (fun ids ->
List.map2 (fun id cred ->
Printf.sprintf "%s %s" (sha256_hex cred) id
) ids public_credentials
) ids in
(* Save to files *)
let timestamp = Printf.sprintf "%.0f" (Unix.time ()) in
let pub =
"public credentials",
timestamp ^ ".pubcreds",
0o444,
List.sort compare public_credentials
in
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,
timestamp ^ ".privcreds",
0o400,
List.sort compare creds
in
let hashed = option_map (fun h ->
"hashed credentials with ids",
timestamp ^ ".hashcreds",
0o400,
List.sort compare h
) hashed_credentials in
let output_endline oc x =
output_string oc x;
output_char oc '\n'
in
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
in
save pub;
save priv;
ignore (option_map save hashed)
end
let () = match action with
| Derive d -> print_endline (public_key_of_token uuid d)
| Generate kind -> generate kind
end
let derive = do_derive
let main () =
let module P = (val parse_args () : PARAMS) in
let module X : EMPTY = Run (P) in
()
open Tool_common
let main group dir uuid count file derive =
wrap_main (fun () ->
let _, group = get_mandatory_opt "--group" group in
let module P : PARAMS = struct
module G = (val group : GROUP)
let uuid = get_mandatory_opt "--uuid" uuid
let dir = dir
let action =
match count, file, derive with
| Some n, None, None ->
if n < 1 then (
failcmd "the argument of --count must be a positive number"
) else Generate (Count n)
| None, Some f, None -> Generate (File f)
| None, None, Some c -> Derive c
| _, _, _ -> failcmd "--count, --file and --derive are mutually exclusive"
end in
let module X : EMPTY = Run (P) in ()
)
open Cmdliner
let dir_t =
let doc = "Save output files to $(docv)." in
let the_info = Arg.info ["dir"] ~docv:"DIR" ~doc in
Arg.(value & opt dir Filename.current_dir_name the_info)
let count_t =
let doc = "Generate $(docv) credentials." in
let the_info = Arg.info ["count"] ~docv:"N" ~doc in
Arg.(value & opt (some int) None the_info)
let file_t =
let doc = "Read identities from $(docv) and generate an additional $(i,T.hashcreds) with identities associated with hashed public credentials. These hashed public credentials are used by the hotline to update a public credential on the web server. One credential will be generated for each line of $(docv)." in
let the_info = Arg.info ["count"] ~docv:"FILE" ~doc in
Arg.(value & opt (some file) None the_info)
let derive_t =
let doc = "Derive the public key associated to a specific $(docv)." in
let the_info = Arg.info ["derive"] ~docv:"PRIVATE_CRED" ~doc in
Arg.(value & opt (some string) None the_info)
let credgen_cmd =
let doc = "generate credentials" in
let man = [
`S "DESCRIPTION";
`P "This command is run by a credential authority to generate credentials for a specific election. The generated private credentials are stored in $(i,T.privcreds), where $(i,T) is a timestamp. $(i,T.privcreds) contains one credential per line. Each voter must be sent a credential, and $(i,T.privcreds) must be destroyed after dispatching is done. The associated public keys are stored in $(i,T.pubcreds) and must be sent to the election administrator.";
] @ common_man in
Term.(ret (pure main $ group_t $ dir_t $ uuid_t $ count_t $ file_t $ derive_t)),
Term.info "credgen" ~doc ~man
let cmds = [credgen_cmd]
val derive : Uuidm.t -> string -> string
val main : unit -> unit
val cmds : (unit Cmdliner.Term.t * Cmdliner.Term.info) list
......@@ -26,6 +26,8 @@ open Common
(* Helpers *)
let ( / ) = Filename.concat
let load_from_file of_string filename =
if Sys.file_exists filename then (
Printf.eprintf "Loading %s...\n%!" filename;
......@@ -44,6 +46,7 @@ let load_from_file of_string filename =
module type PARAMS = sig
val dir : string
val sk_file : string option
val do_finalize : bool
val do_decrypt : bool
......@@ -51,86 +54,6 @@ module type PARAMS = sig
include ELECTION_PARAMS
end
let parse_args () = begin
(* Command-line arguments *)
let initial_dir = Sys.getcwd () in
let dir = ref initial_dir in
let sk_file = ref None in
let do_finalize = ref false in
let do_decrypt = ref false in
let ballot_file = ref None in
let speclist = Arg.([
"--dir", String (fun s -> dir := s), "path to election files";
"--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";
]) in
let usage_msg =
Printf.sprintf "Usage: %s election [--dir <dir>] [--privkey <privkey>] { vote <ballot> | verify | decrypt | finalize }" Sys.argv.(0)
in
let usage () =
Arg.usage speclist usage_msg;
exit 1
in
let anon_args = ref [] in
let anon_fun x =
anon_args := x :: !anon_args
in
let () = Arg.parse speclist anon_fun usage_msg in
let () = match List.rev !anon_args with
| [] -> usage ()
| ["vote"; f] ->
let f =
if Filename.is_relative f then Filename.concat initial_dir f else f