Commit 010c6a65 authored by Stephane Glondu's avatar Stephane Glondu

Do no longer rely on Ocsipersist for draft elections

parent 72f1ebf2
......@@ -291,6 +291,10 @@ let write_file ?uuid x lines =
)
) >> Lwt_unix.rename fname_new fname
let cleanup_file f =
try%lwt Lwt_unix.unlink f
with _ -> return_unit
let rmdir dir =
let command = "rm", [| "rm"; "-rf"; dir |] in
let%lwt _ = Lwt_process.exec command in
......
......@@ -109,6 +109,8 @@ val extract_email : string -> string option
val file_exists : string -> bool Lwt.t
val read_file : ?uuid:uuid -> string -> string list option Lwt.t
val write_file : ?uuid:uuid -> string -> string list -> unit Lwt.t
val cleanup_file : string -> unit Lwt.t
val rmdir : string -> unit Lwt.t
val compile_auth_config : auth_config -> string * (string * string list)
......
......@@ -21,6 +21,7 @@
open Lwt
open Platform
open Signatures
open Serializable_builtin_t
open Serializable_j
open Common
......@@ -29,6 +30,14 @@ open Web_common
let ( / ) = Filename.concat
let get_draft_election uuid =
match%lwt read_file ~uuid "draft.json" with
| Some [x] -> return @@ Some (draft_election_of_string x)
| _ -> return_none
let set_draft_election uuid se =
write_file ~uuid "draft.json" [string_of_draft_election se]
let get_election_result uuid =
match%lwt read_file ~uuid "result.json" with
| Some [x] -> return (Some (result_of_string Yojson.Safe.read_json x))
......@@ -125,23 +134,61 @@ let get_auth_config uuid =
| None -> return []
| Some x -> return (List.map compile_auth_config x)
type election_kind =
[ `Draft
| `Validated
| `Tallied
| `Archived
]
let get_elections_by_owner user =
Lwt_unix.files_of_directory !spool_dir |>
Lwt_stream.filter_map_s
Lwt_stream.to_list >>=
Lwt_list.filter_map_p
(fun x ->
if x = "." || x = ".." then
return None
else (
try
let uuid = uuid_of_raw_string x in
let%lwt metadata = get_election_metadata uuid in
match metadata.e_owner with
| Some o when o = user -> return (Some uuid)
| _ -> return None
match%lwt get_draft_election uuid with
| None ->
(
let%lwt metadata = get_election_metadata uuid in
match metadata.e_owner with
| Some o when o = user ->
(
match%lwt get_raw_election uuid with
| None -> return_none
| Some election ->
let election = Election.of_string election in
let%lwt kind, date =
match%lwt get_election_state uuid with
| `Open | `Closed | `EncryptedTally _ ->
let%lwt date = get_election_date `Validation uuid in
let date = Option.get date default_validation_date in
return (`Validated, date)
| `Tallied ->
let%lwt date = get_election_date `Tally uuid in
let date = Option.get date default_tally_date in
return (`Tallied, date)
| `Archived ->
let%lwt date = get_election_date `Archive uuid in
let date = Option.get date default_archive_date in
return (`Archived, date)
in
return @@ Some (kind, uuid, date, election.e_params.e_name)
)
| _ -> return_none
)
| Some se ->
if se.se_owner = user then
let date = Option.get se.se_creation_date default_creation_date in
return @@ Some (`Draft, uuid, date, se.se_questions.t_name)
else return_none
with _ -> return None
)
) |>
Lwt_stream.to_list
)
let get_voters uuid =
read_file ~uuid "voters.txt"
......
......@@ -23,6 +23,9 @@ open Serializable_t
open Common
open Web_serializable_t
val get_draft_election : uuid -> draft_election option Lwt.t
val set_draft_election : uuid -> draft_election -> unit Lwt.t
val get_election_state : uuid -> election_state Lwt.t
val set_election_state : uuid -> election_state -> unit Lwt.t
......@@ -45,7 +48,13 @@ val get_raw_election : uuid -> string option Lwt.t
val get_election_metadata : uuid -> metadata Lwt.t
val get_election_result : uuid -> Yojson.Safe.json result option Lwt.t
val get_elections_by_owner : user -> uuid list Lwt.t
type election_kind =
[ `Draft
| `Validated
| `Tallied
| `Archived
]
val get_elections_by_owner : user -> (election_kind * uuid * datetime * string) list Lwt.t
val get_voters : uuid -> string list option Lwt.t
val get_passwords : uuid -> (string * string) SMap.t option Lwt.t
......
This diff is collapsed.
......@@ -169,13 +169,6 @@ let base ~title ?login_box ~content ?(footer = div []) ?uuid () =
]]
]))
let format_election election =
let e = election.e_params in
let service = election_admin in
li [
a ~service [pcdata e.e_name] (e.e_uuid, ());
]
let admin_gdpr () =
let title = site_title ^ " — Personal data processing notice" in
let content =
......@@ -197,6 +190,16 @@ let admin_gdpr () =
in
base ~title ~content ()
let format_election (uuid, name) =
li [
a ~service:election_admin [pcdata name] (uuid, ());
]
let format_draft_election (uuid, name) =
li [
a ~service:election_draft [pcdata name] uuid;
]
let admin ~elections () =
let title = site_title ^ " — Administration" in
match elections with
......@@ -220,7 +223,12 @@ let admin ~elections () =
] in
let%lwt login_box = site_login_box () in
base ~title ?login_box ~content ()
| Some (elections, tallied, archived, draft_elections) ->
| Some (draft, elections, tallied, archived) ->
let draft =
match draft with
| [] -> p [pcdata "You own no such elections!"]
| _ -> ul @@ List.map format_draft_election draft
in
let elections =
match elections with
| [] -> p [pcdata "You own no such elections!"]
......@@ -236,14 +244,6 @@ let admin ~elections () =
| [] -> p [pcdata "You own no such elections!"]
| _ -> ul @@ List.map format_election archived
in
let draft_elections =
match draft_elections with
| [] -> p [pcdata "You own no such elections!"]
| _ -> ul @@
List.map (fun (k, title) ->
li [a ~service:election_draft [pcdata title] k]
) draft_elections
in
let content = [
div [
div [
......@@ -253,7 +253,7 @@ let admin ~elections () =
];
div [br ()];
h2 [pcdata "Elections being prepared"];
draft_elections;
draft;
div [br ()];
h2 [pcdata "Elections you can administer"];
elections;
......@@ -1339,18 +1339,21 @@ let election_draft_threshold_trustee token uuid se () =
base ~title ~content ()
let election_draft_importer ~service ~title uuid (elections, tallied, archived) () =
let format_election election =
let name = election.e_params.e_name in
let uuid_s = raw_string_of_uuid election.e_params.e_uuid in
let format_election (from_uuid, name) =
let form = post_form ~service
(fun from ->
[
div [pcdata name; pcdata " ("; pcdata uuid_s; pcdata ")"];
div [
pcdata name;
pcdata " (";
pcdata (raw_string_of_uuid from_uuid);
pcdata ")"
];
div [
user_type_input raw_string_of_uuid
~input_type:`Hidden
~name:from
~value:election.e_params.e_uuid ();
~value:from_uuid ();
string_input ~input_type:`Submit ~value:"Import from this election" ();
]
]
......
......@@ -24,7 +24,7 @@ open Web_serializable_t
open Signatures
val admin_gdpr : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val admin : elections:('a election list * 'a election list * 'a election list * (uuid * string) list) option -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val admin : elections:((uuid * string) list * (uuid * string) list * (uuid * string) list * (uuid * string) list) option -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val new_election_failure : [ `Exists | `Exception of exn ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
......@@ -47,8 +47,8 @@ val election_draft_trustees : uuid -> draft_election -> unit -> [> `Html ] Eliom
val election_draft_threshold_trustees : uuid -> draft_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_draft_trustee : string -> uuid -> draft_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_draft_threshold_trustee : string -> uuid -> draft_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_draft_import : uuid -> draft_election -> 'a election list * 'a election list * 'a election list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_draft_import_trustees : uuid -> draft_election -> 'a election list * 'a election list * 'a election list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_draft_import : uuid -> draft_election -> (uuid * string) list * (uuid * string) list * (uuid * string) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_draft_import_trustees : uuid -> draft_election -> (uuid * string) list * (uuid * string) list * (uuid * string) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_draft_confirm : uuid -> draft_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_home : 'a election -> election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
......
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