Une MAJ de sécurité est nécessaire sur notre version actuelle. Elle sera effectuée lundi 02/08 entre 12h30 et 13h. L'interruption de service devrait durer quelques minutes (probablement moins de 5 minutes).

Commit 4d30236f authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Do no longer use legacy datatypes in web

parent 40f66509
......@@ -36,7 +36,7 @@ type ff_pubkey = {
p : number;
q : number;
y : number;
} <ocaml field_prefix="ff_">
}
<doc text="Parameters for a multiplicative subgroup of a finite field, with a public key.">
type question = {
......@@ -82,3 +82,10 @@ type 'a result = {
partial_decryptions : 'a partial_decryption list <ocaml repr="array">;
result : int list <ocaml repr="array"> list <ocaml repr="array">;
}
(** {1 Other datastructures} *)
type randomness = {
randomness : string;
}
<doc text="Randomness generated by the server sent to the client.">
......@@ -132,9 +132,3 @@ type 'a partial_decryption = {
}
type raw_result = int list <ocaml repr="array"> list <ocaml repr="array">
(** {1 Other basic datastructures} *)
type randomness = {
randomness : string;
}
open Lwt
open Util
open Serializable_compat_t
open Serializable_t
type user = {
user_name : string;
user_type : string;
}
type 'a result = {
encrypted_tally : 'a encrypted_tally;
partial_decryptions : 'a partial_decryption array;
result : raw_result;
}
type election_data = {
raw : string;
fingerprint : string;
election : Z.t election;
election : ff_pubkey election;
public_keys : Z.t trustee_public_key array;
election_result : Z.t result option;
admin : user;
private_p : bool;
featured_p : bool;
state : election_state;
}
let enforce_single_element s =
......@@ -59,39 +52,23 @@ let load_elections_and_votes dirname =
Lwt_io.lines_of_file |>
enforce_single_element
in
let election = Serializable_compat_j.election_of_string
Serializable_builtin_j.read_number raw
let election = Serializable_j.election_of_string
Serializable_j.read_ff_pubkey raw
in
(assert_lwt (Uuidm.equal uuid election.e_uuid)) >>
lwt public_keys =
data "public_keys.jsons" |>
Lwt_io.lines_of_file |>
Lwt_stream.map (fun x ->
Serializable_compat_j.trustee_public_key_of_string Serializable_builtin_j.read_number x
Serializable_j.trustee_public_key_of_string Serializable_builtin_j.read_number x
) |>
Lwt_stream.to_list >>= wrap1 Array.of_list
in
lwt election_result, state =
match (
try Some (
data "result.json" |>
load_from_file Serializable_compat_j.read_raw_result
) with Sys_error _ -> None
) with
| Some result ->
let encrypted_tally =
data "encrypted_tally.json" |>
load_from_file (Serializable_compat_j.read_encrypted_tally Serializable_builtin_j.read_number)
in
lwt partial_decryptions =
data "partial_decryptions.jsons" |>
Lwt_io.lines_of_file |>
Lwt_stream.map (fun x ->
Serializable_compat_j.partial_decryption_of_string Serializable_builtin_j.read_number x
) |>
Lwt_stream.to_list >>= wrap1 Array.of_list
in return (Some { encrypted_tally; partial_decryptions; result }, `Finished)
| None -> return (None, `Started)
let election_result =
try Some (
data "result.json" |>
load_from_file (Serializable_j.read_result Serializable_builtin_j.read_number)
) with Sys_error _ -> None
in
let fingerprint = hashB raw in
let ballots =
......@@ -99,7 +76,7 @@ let load_elections_and_votes dirname =
if Sys.file_exists file then (
Lwt_io.lines_of_file file |>
Lwt_stream.map (fun x ->
let v = Serializable_compat_j.ballot_of_string Serializable_builtin_j.read_number x in
let v = Serializable_j.ballot_of_string Serializable_builtin_j.read_number x in
assert (Uuidm.equal uuid v.election_uuid);
x, v
)
......@@ -114,7 +91,6 @@ let load_elections_and_votes dirname =
admin = { user_name = "admin"; user_type = "dummy" };
private_p = false;
featured_p = true;
state;
} in
Lwt.return (Some (election_data, ballots))
| None -> assert false
......
open Serializable_compat_t
open Serializable_t
type user = {
user_name : string;
user_type : string;
}
type 'a result = {
encrypted_tally : 'a encrypted_tally;
partial_decryptions : 'a partial_decryption array;
result : raw_result;
}
type election_data = {
raw : string;
fingerprint : string;
election : Z.t election;
election : ff_pubkey election;
public_keys : Z.t trustee_public_key array;
election_result : Z.t result option;
admin : user;
private_p : bool;
featured_p : bool;
state : election_state;
}
val hashB : string -> string
......
open Util
open Serializable_compat_t
open Serializable_t
open Lwt
(* The following should be in configuration file... but
......@@ -115,7 +115,7 @@ let () = Eliom_registration.String.register
let uuid_underscored = String.map (function '-' -> '_' | c -> c) (Uuidm.to_string uuid) in
let table = Ocsipersist.open_table ("ballots_" ^ uuid_underscored) in
lwt ballots = Ocsipersist.fold_step (fun hash v res ->
let s = Serializable_compat_j.string_of_ballot Serializable_builtin_j.write_number v ^ "\n" in
let s = Serializable_j.string_of_ballot Serializable_builtin_j.write_number v ^ "\n" in
return (s :: res)
) table [] in
let result = String.concat "" ballots in
......@@ -129,7 +129,7 @@ let () = Eliom_registration.String.register
(* FIXME: DoS/entropy exhaustion vulnerability *)
Lwt_preemptive.detach (fun () -> Cryptokit.Random.(string secure_rng 32)) () >>=
wrap1 Cryptokit.(transform_string (Base64.encode_compact ())) >>=
(fun x -> return (Serializable_compat_j.string_of_randomness { randomness=x })) >>=
(fun x -> return (Serializable_j.string_of_randomness { randomness=x })) >>=
(fun x -> return (x, "application/json"))
)
......@@ -165,21 +165,21 @@ let () = Eliom_registration.Html5.register
(fun uuid election user raw_ballot ->
let result =
try
let ballot = Serializable_compat_j.ballot_of_string Serializable_builtin_j.read_number raw_ballot in
let ballot = Serializable_j.ballot_of_string Serializable_builtin_j.read_number raw_ballot in
let {g; p; q; y} = election.Common.election.e_public_key in
let module P = struct
module G = (val Election.finite_field ~p ~q ~g : Signatures.GROUP with type t = Z.t)
let public_keys = Array.map (fun x ->
x.trustee_public_key.y
x.trustee_public_key
) election.Common.public_keys
let params = Serializable_compat.election election.Common.election
let params = { election.Common.election with e_public_key = y }
let fingerprint = assert false
end in
let module M = Election.MakeSimpleMonad(P.G) in
let module E = Election.MakeElection(P)(M) in
if
Uuidm.equal uuid ballot.election_uuid &&
E.check_ballot (Serializable_compat.ballot ballot)
E.check_ballot ballot
then `Valid (Common.hashB raw_ballot)
else `Invalid
with e -> `Malformed
......
Util
Serializable_builtin_j
Serializable_compat_j
Serializable_j
Serializable_compat
Common
Election
Services
......
open Util
open Serializable_compat_t
open Serializable_t
open Eliom_service
open Eliom_parameter
......
open Util
open Serializable_compat_t
open Serializable_t
open Eliom_content.Html5.F
(* FIXME: these pages should be redesigned *)
......@@ -136,7 +136,7 @@ let format_election_result e r =
) answers
in
{ question; answers }
) (r.Common.result : int array array) |>
) r.result |>
Array.to_list
let format_one_election e =
......@@ -228,7 +228,7 @@ let election_view ~election ~user =
let service = Services.(preapply_uuid election_raw election) in
let booth = Services.make_booth election.Common.election.e_uuid in
lwt eligibility =
if not election.Common.private_p && election.Common.election.e_openreg then (
if not election.Common.private_p then (
Lwt.return [
pcdata "Anyone can vote in this election.";
]
......@@ -303,8 +303,8 @@ let election_view ~election ~user =
div ~a:[a_style "margin-bottom: 25px;margin-left: 15px; border-left: 1px solid #aaa; padding-left: 5px; font-size:1.3em;"] [pcdata election.Common.election.e_description];
(* NOTE: administration things removed from here! *)
br ();
] @ (match election.Common.state, election.Common.election_result with
| `Finished, Some r ->
] @ (match election.Common.election_result with
| Some r ->
let result = format_election_result election.Common.election r in
[
span ~a:[a_class ["highlight-box"; "round"]] [
......@@ -340,14 +340,7 @@ let election_view ~election ~user =
]
) result
)
| `Stopped, _ ->
[
span ~a:[a_class ["highlight-box"; "round"]] [
pcdata "Election closed. Tally will be computed soon.";
];
br ();
]
| `Started, _ ->
| None ->
[
span ~a:[
a_class ["highlight-box"; "round"];
......@@ -364,13 +357,6 @@ let election_view ~election ~user =
pcdata "This election ends at the administrator's discretion.";
br ();
]
| _ ->
[
span ~a:[a_class ["highlight-box"; "round"]] [
pcdata "FIXME";
];
br ();
]
) @ eligibility @ [
div ~a:[
a_style "background: lightyellow; padding:5px; padding-left: 10px; margin-top: 15px; border: 1px solid #aaa; width: 720px;";
......
......@@ -33,7 +33,7 @@
<static dir="_SRCDIR_/media/booth" />
</site>
<eliom module="_build/src/web/server.cma">
<load dir="tests/legacy"/>
<load dir="tests/data"/>
</eliom>
</host>
......
......@@ -141,7 +141,7 @@ let list_save_to filename writer xs =
let save_to_disk () =
let election = { election with
e_public_key = { ff_g = g; ff_p = p; ff_q = q; ff_y = y }
e_public_key = { g; p; q; y }
} in
let ballots = Array.of_list (M.fold (fun x xs () -> x::xs) [] ()) in
let dir = Printf.sprintf "tests/data/{%s}"
......
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