Commit 91b9bbb2 authored by Stephane Glondu's avatar Stephane Glondu

Do no longer rely on Ocsipersist for ballot management

Instead, we use a subdirectory "ballots/" of the election directory.
parent 0d3a5781
......@@ -302,6 +302,9 @@ let rmdir dir =
let compile_auth_config {auth_system; auth_instance; auth_config} =
auth_instance, (auth_system, List.map snd auth_config)
let urlize = String.map (function '+' -> '-' | '/' -> '_' | c -> c)
let unurlize = String.map (function '-' -> '+' | '_' -> '/' | c -> c)
let default_contact = "Name <user@example.org>"
let default_questions =
......
......@@ -115,6 +115,9 @@ val rmdir : string -> unit Lwt.t
val compile_auth_config : auth_config -> string * (string * string list)
val urlize : string -> string
val unurlize : string -> string
val default_contact : string
val default_questions : question array
val default_name : string
......
......@@ -38,7 +38,6 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
module G = E.G
let uuid_u = underscorize uuid
let ballots_table = Ocsipersist.open_table ("ballots_" ^ uuid_u)
let records_table = Ocsipersist.open_table ("records_" ^ uuid_u)
let cred_table = Ocsipersist.open_table ("creds_" ^ uuid_u)
......@@ -110,7 +109,7 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
if b then (
let hash = sha256_b64 rawballot in
Ocsipersist.add cred_table credential (Some hash) >>
Ocsipersist.add ballots_table hash rawballot >>
Web_persist.add_ballot uuid hash rawballot >>
Ocsipersist.add records_table user (date, credential) >>
send_confirmation_email false login email hash >>
return hash
......@@ -122,10 +121,10 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
if credential = old_credential then (
let%lwt b = Lwt_preemptive.detach E.check_ballot ballot in
if b then (
Ocsipersist.remove ballots_table h >>
Web_persist.remove_ballot uuid h >>
let hash = sha256_b64 rawballot in
Ocsipersist.add cred_table credential (Some hash) >>
Ocsipersist.add ballots_table hash rawballot >>
Web_persist.add_ballot uuid hash rawballot >>
Ocsipersist.add records_table user (date, credential) >>
send_confirmation_email true login email hash >>
return hash
......@@ -163,11 +162,7 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
Lwt_io.(with_file ~mode:Output (!spool_dir / raw_string_of_uuid uuid / string_of_election_file f))
let do_write_ballots () =
do_write ESBallots (fun oc ->
Ocsipersist.iter_step (fun _ x ->
Lwt_io.write_line oc x
) ballots_table
)
Web_persist.dump_ballots uuid
let do_write_creds () =
do_write ESCreds (fun oc ->
......@@ -207,21 +202,4 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
do_write_creds ()
)
let compute_encrypted_tally () =
let%lwt num_tallied, tally =
Ocsipersist.fold_step
(fun _ rawballot (n, accu) ->
let ballot = ballot_of_string G.read rawballot in
let ciphertext = E.extract_ciphertext ballot in
return (n + 1, E.combine_ciphertexts accu ciphertext))
ballots_table (0, E.neutral_ciphertext ())
in
let tally = string_of_encrypted_tally G.write tally in
Lwt_mutex.with_lock mutex (fun () ->
do_write ESETally (fun oc ->
Lwt_io.write oc tally
)
) >>
return (num_tallied, sha256_b64 tally, tally)
end
......@@ -210,10 +210,11 @@ let get_ballot_hashes uuid =
let%lwt ballots = archived_ballots_cache#find uuid in
Ballots.bindings ballots |> List.map fst |> return
| _ ->
let table = Ocsipersist.open_table ("ballots_" ^ underscorize uuid) in
Ocsipersist.fold_step (fun hash _ accu ->
return (hash :: accu)
) table [] >>= (fun x -> return @@ List.rev x)
let uuid_s = raw_string_of_uuid uuid in
let ballots = Lwt_unix.files_of_directory (!spool_dir / uuid_s / "ballots") in
let%lwt ballots = Lwt_stream.to_list ballots in
let ballots = List.filter (fun x -> x <> "." && x <> "..") ballots in
return (List.rev_map unurlize ballots)
let get_ballot_by_hash uuid hash =
match%lwt get_election_state uuid with
......@@ -221,9 +222,53 @@ let get_ballot_by_hash uuid hash =
let%lwt ballots = archived_ballots_cache#find uuid in
(try Some (Ballots.find hash ballots) with Not_found -> None) |> return
| _ ->
let table = Ocsipersist.open_table ("ballots_" ^ underscorize uuid) in
try%lwt Ocsipersist.find table hash >>= (fun x -> return @@ Some x)
with Not_found -> return_none
let%lwt ballot = read_file ~uuid ("ballots" / urlize hash) in
match ballot with
| Some [x] -> return (Some x)
| _ -> return_none
let add_ballot uuid hash ballot =
let ballots_dir = !spool_dir / raw_string_of_uuid uuid / "ballots" in
let%lwt () = try%lwt Lwt_unix.mkdir ballots_dir 0o755 with _ -> return_unit in
write_file (ballots_dir / urlize hash) [ballot]
let remove_ballot uuid hash =
let ballots_dir = !spool_dir / raw_string_of_uuid uuid / "ballots" in
try%lwt Lwt_unix.unlink (ballots_dir / urlize hash) with _ -> return_unit
let load_ballots uuid =
let ballots_dir = !spool_dir / raw_string_of_uuid uuid / "ballots" in
let ballots = Lwt_unix.files_of_directory ballots_dir in
let%lwt ballots = Lwt_stream.to_list ballots in
Lwt_list.filter_map_p (fun x ->
match%lwt read_file (ballots_dir / x) with
| Some [x] -> return (Some x)
| _ -> return_none
) ballots
let dump_ballots uuid =
let%lwt ballots = load_ballots uuid in
write_file ~uuid "ballots.jsons" ballots
let compute_encrypted_tally uuid =
let%lwt election = get_raw_election uuid in
match election with
| None -> Lwt.fail Not_found
| Some election ->
let election = Election.of_string election in
let module W = (val Election.get_group election) in
let module E = Election.Make (W) (LwtRandom) in
let%lwt ballots = load_ballots uuid in
let num_tallied, tally =
List.fold_left (fun (n, accu) rawballot ->
let ballot = ballot_of_string E.G.read rawballot in
let ciphertext = E.extract_ciphertext ballot in
n + 1, E.combine_ciphertexts accu ciphertext
) (0, E.neutral_ciphertext ()) ballots
in
let tally = string_of_encrypted_tally E.G.write tally in
let%lwt () = write_file ~uuid (string_of_election_file ESETally) [tally] in
return (num_tallied, sha256_b64 tally, tally)
let has_voted uuid user =
let uuid_u = underscorize uuid in
......
......@@ -64,4 +64,9 @@ val get_threshold : uuid -> string option Lwt.t
val get_ballot_hashes : uuid -> string list Lwt.t
val get_ballot_by_hash : uuid -> string -> string option Lwt.t
val add_ballot : uuid -> string -> string -> unit Lwt.t
val remove_ballot : uuid -> string -> unit Lwt.t
val dump_ballots : uuid -> unit Lwt.t
val compute_encrypted_tally : uuid -> (int * string * string) Lwt.t
val has_voted : uuid -> user -> bool Lwt.t
......@@ -61,8 +61,4 @@ module type WEB_BALLOT_BOX = sig
val inject_cred : string -> unit Lwt.t
val update_files : unit -> unit Lwt.t
val update_cred : old:string -> new_:string -> unit Lwt.t
val compute_encrypted_tally : unit -> (int * string * string) Lwt.t
(** Computes and writes to disk the encrypted tally. Returns the
number of ballots and the hash of the encrypted tally. *)
end
......@@ -258,7 +258,7 @@ let delete_sensitive_data uuid =
let%lwt () = cleanup_table ~uuid_s "election_pds" in
let%lwt () = cleanup_table ("records_" ^ uuid_u) in
let%lwt () = cleanup_table ("creds_" ^ uuid_u) in
let%lwt () = cleanup_table ("ballots_" ^ uuid_u) in
let%lwt () = rmdir (!spool_dir / uuid_s / "ballots") in
let%lwt () = cleanup_file (!spool_dir / uuid_s / "private_key.json") in
let%lwt () = cleanup_file (!spool_dir / uuid_s / "private_keys.jsons") in
return_unit
......@@ -1773,14 +1773,13 @@ let () =
let%lwt metadata = Web_persist.get_election_metadata uuid in
let module W = (val Election.get_group election) in
let module E = Election.Make (W) (LwtRandom) in
let module B = Web_election.Make (E) in
if metadata.e_owner = Some u then (
let%lwt () =
match%lwt Web_persist.get_election_state uuid with
| `Closed -> return ()
| _ -> forbidden ()
in
let%lwt nb, hash, tally = B.compute_encrypted_tally () in
let%lwt nb, hash, tally = Web_persist.compute_encrypted_tally uuid in
let%lwt npks =
match%lwt Web_persist.get_threshold uuid with
| Some tp ->
......
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