Commit 82980ca4 authored by Stephane Glondu's avatar Stephane Glondu

Add the notion of "deleted" elections

So-called "deleted" elections are invisible in the web
interface. However, some data is kept for statistical purposes.
parent 82b4db59
......@@ -102,6 +102,26 @@ type setup_election = {
?creation_date : datetime option;
} <ocaml field_prefix="se_">
(** {1 Types related to deleted elections} *)
type authentication_method = [ CAS | Password | Unknown ]
type credential_method = [ Automatic | Manual ]
type deleted_election = {
uuid : uuid;
template : template;
owner : user;
nb_voters : int;
nb_ballots : int;
date : datetime;
tallied : bool;
authentication_method : authentication_method;
credential_method : credential_method;
nb_trustees : int;
?trustees_threshold : int option;
server_is_trustee : bool;
} <ocaml field_prefix="de_">
(** {1 OpenID Connect-related types} *)
type oidc_configuration = {
......
......@@ -85,6 +85,7 @@ let election_login = service ~path:["elections"] ~get_params:(suffix_prod (uuid
let election_open = post_coservice ~fallback:election_admin ~post_params:unit ()
let election_close = post_coservice ~fallback:election_admin ~post_params:unit ()
let election_archive = post_coservice ~fallback:election_admin ~post_params:unit ()
let election_delete = post_coservice ~fallback:election_admin ~post_params:unit ()
let election_update_credential = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "update-cred")) ()
let election_update_credential_post = post_service ~fallback:election_update_credential ~post_params:(string "old_credential" ** string "new_credential") ()
let election_vote = service ~path:["vote.html"] ~get_params:unit ()
......
......@@ -290,7 +290,7 @@ let cleanup_file f =
try%lwt Lwt_unix.unlink f
with _ -> return_unit
let archive_election uuid =
let delete_sensitive_data uuid =
let uuid_s = raw_string_of_uuid uuid in
let uuid_u = underscorize uuid in
let%lwt () = cleanup_table ~uuid_s "election_states" in
......@@ -303,9 +303,109 @@ let archive_election uuid =
let%lwt () = cleanup_table ("ballots_" ^ uuid_u) 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
let archive_election uuid =
let%lwt () = delete_sensitive_data uuid in
let%lwt () = Web_persist.set_election_date `Archive uuid (now ()) in
return_unit
let delete_election uuid =
let uuid_s = raw_string_of_uuid uuid in
let%lwt () = delete_sensitive_data uuid in
let%lwt election = raw_find_election uuid in
let%lwt metadata = Web_persist.get_election_metadata uuid in
let de_template = {
t_description = "";
t_name = election.e_params.e_name;
t_questions =
Array.map (fun q ->
{
q_answers = Array.map (fun _ -> "") q.q_answers;
q_blank = q.q_blank;
q_min = q.q_min;
q_max = q.q_max;
q_question = "";
}
) election.e_params.e_questions
}
in
let de_owner = match metadata.e_owner with
| None -> Printf.ksprintf failwith "election %s has no owner" uuid_s
| Some x -> x
in
let%lwt de_date =
let%lwt date = Web_persist.get_election_date `Tally uuid in
match date with
| Some x -> return x
| None ->
let%lwt date = Web_persist.get_election_date `Finalization uuid in
match date with
| Some x -> return x
| None ->
let%lwt date = Web_persist.get_election_date `Creation uuid in
match date with
| Some x -> return x
| None -> return default_finalization_date
in
let de_authentication_method = match metadata.e_auth_config with
| Some [{auth_system = "cas"; _}] -> `CAS
| Some [{auth_system = "password"; _}] -> `Password
| _ -> `Unknown
in
let de_credential_method = match metadata.e_cred_authority with
| Some "server" -> `Automatic
| _ -> `Manual
in
let%lwt de_trustees_threshold =
let%lwt threshold = Web_persist.get_threshold uuid in
match threshold with
| None -> return None
| Some x ->
let x = threshold_parameters_of_string Yojson.Safe.read_json x in
return (Some x.t_threshold)
in
let%lwt pks = Web_persist.get_public_keys uuid in
let%lwt voters = Web_persist.get_voters uuid in
let%lwt ballots = Web_persist.get_ballot_hashes uuid in
let%lwt result = Web_persist.get_election_result uuid in
let de = {
de_uuid = uuid;
de_template;
de_owner;
de_nb_voters = (match voters with None -> 0 | Some x -> List.length x);
de_nb_ballots = List.length ballots;
de_date;
de_tallied = result <> None;
de_authentication_method;
de_credential_method;
de_nb_trustees = (match pks with None -> 0 | Some x -> List.length x);
de_trustees_threshold;
de_server_is_trustee = metadata.e_server_is_trustee = Some true;
}
in
let%lwt () = write_file ~uuid "deleted.json" [string_of_deleted_election de] in
let files_to_delete = [
"election.json";
"ballots.jsons";
"dates.json";
"encrypted_tally.json";
"metadata.json";
"passwords.csv";
"public_creds.txt";
"public_keys.jsons";
"threshold.json";
"records";
"result.json";
"voters.txt";
]
in
let%lwt () = Lwt_list.iter_p (fun x ->
cleanup_file (!spool_dir / uuid_s / x)
) files_to_delete
in
return_unit
let () = Any.register ~service:home
(fun () () ->
Eliom_reference.unset Web_state.cont >>
......@@ -1015,35 +1115,37 @@ let () =
)
)
let destroy_election uuid se =
let uuid_s = raw_string_of_uuid uuid in
(* clean up credentials *)
let%lwt () =
let fname = !spool_dir / uuid_s ^ ".public_creds.txt" in
try%lwt Lwt_unix.unlink fname
with _ -> return_unit
in
(* clean up setup database *)
let%lwt () = Ocsipersist.remove election_credtokens se.se_public_creds in
let%lwt () =
Lwt_list.iter_s (fun {st_token; _} ->
if st_token <> "" then
Ocsipersist.remove election_pktokens st_token
else return_unit
) se.se_public_keys
in
let%lwt () = match se.se_threshold_trustees with
| None -> return_unit
| Some ts ->
Lwt_list.iter_s (fun {stt_token; _} ->
Ocsipersist.remove election_tpktokens stt_token
) ts
in
Ocsipersist.remove election_stable uuid_s
let () =
Any.register ~service:election_setup_destroy
(fun uuid () ->
with_setup_election ~save:false uuid (fun se ->
let uuid_s = raw_string_of_uuid uuid in
(* clean up credentials *)
let%lwt () =
let fname = !spool_dir / uuid_s ^ ".public_creds.txt" in
try%lwt Lwt_unix.unlink fname
with _ -> return_unit
in
(* clean up setup database *)
let%lwt () = Ocsipersist.remove election_credtokens se.se_public_creds in
let%lwt () =
Lwt_list.iter_s (fun {st_token; _} ->
if st_token <> "" then
Ocsipersist.remove election_pktokens st_token
else return_unit
) se.se_public_keys
in
let%lwt () = match se.se_threshold_trustees with
| None -> return_unit
| Some ts ->
Lwt_list.iter_s (fun {stt_token; _} ->
Ocsipersist.remove election_tpktokens stt_token
) ts
in
let%lwt () = Ocsipersist.remove election_stable uuid_s in
Redirection.send admin
destroy_election uuid se >> Redirection.send admin
)
)
......@@ -1289,6 +1391,17 @@ let () =
)
)
let () =
Any.register ~service:election_delete
(fun (uuid, ()) () ->
with_site_user (fun u ->
let%lwt metadata = Web_persist.get_election_metadata uuid in
if metadata.e_owner = Some u then (
delete_election uuid >> redir_preapply admin () ()
) else forbidden ()
)
)
let () =
Any.register ~service:election_update_credential
(fun (uuid, ()) () ->
......
......@@ -1870,6 +1870,18 @@ let election_admin election metadata state get_tokens_decrypt () =
) (uuid, ());
]
in
let div_delete =
div [
br ();
hr ();
post_form ~service:election_delete (fun () ->
[
string_input ~input_type:`Submit ~value:"Delete election" ();
pcdata " Warning: this action is irreversible.";
]
) (uuid, ());
]
in
let update_credential =
match metadata.e_cred_authority with
| Some "server" ->
......@@ -1908,6 +1920,7 @@ let election_admin election metadata state get_tokens_decrypt () =
div_regenpwd;
div [state_div];
div_archive;
div_delete;
] in
let%lwt login_box = site_login_box () in
base ~title ?login_box ~content ()
......
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