Commit 0b42e316 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Add credential checking (server-side)

parent 77b45349
......@@ -7,7 +7,6 @@ open Lwt
let () = Ocsigen_config.set_maxrequestbodysizeinmemory 128000
module EMap = Map.Make(Uuidm)
module SSet = Set.Make(String)
let ( / ) = Filename.concat
......@@ -71,16 +70,23 @@ lwt election_table =
(fun x -> return (Some x))
) else return None
in
let fn_public_creds = path/"public_creds.txt" in
lwt public_creds =
Lwt_io.lines_of_file fn_public_creds |>
populate Web_common.SSet.empty (fun c accu ->
return (Web_common.SSet.add c accu)
)
in
let can_vote = match metadata with
| None -> Web_common.Any
| Some m -> match m.e_voters_list with
| None -> Web_common.Any
| Some voters ->
let set = List.fold_left (fun accu u ->
SSet.add u accu
) SSet.empty voters in
Web_common.SSet.add u accu
) Web_common.SSet.empty voters in
Web_common.Restricted (fun u ->
return (SSet.mem (Web_common.string_of_user u) set)
return (Web_common.SSet.mem (Web_common.string_of_user u) set)
)
in
let election_data = Web_common.({
......@@ -88,6 +94,8 @@ lwt election_table =
fingerprint;
election;
fn_public_keys;
public_creds;
fn_public_creds;
featured_p = true;
can_read = Any;
can_vote;
......@@ -112,6 +120,7 @@ lwt election_table =
module B = Web_common.MakeBallotBox(P)(E)
let data = election_data
end in
X.B.inject_creds public_creds >>
let uuid = election.e_uuid in
return (EMap.add uuid (module X : Web_common.WEB_ELECTION) accu)
) else return accu
......@@ -264,6 +273,16 @@ let () = Eliom_registration.File.register
)
)
let () = Eliom_registration.File.register
~service:Services.election_public_creds
~content_type:"text/plain"
(if_eligible can_read
(fun uuid election user () ->
let module X = (val election : Web_common.WEB_ELECTION) in
return X.data.Web_common.fn_public_creds
)
)
let () = Eliom_registration.Streamlist.register
~service:Services.election_ballots
(if_eligible can_read
......@@ -360,10 +379,7 @@ let do_cast election uuid () =
try_lwt
X.B.cast ballot record >>
return (`Valid (sha256_b64 ballot))
with
| Serialization e -> return (`Malformed e)
| ProofCheck -> return `Invalid
| ElectionClosed -> return `Closed
with Error e -> return (`Error e)
in
Eliom_reference.unset Services.ballot >>
Templates.do_cast_ballot ~election:X.data ~result
......
......@@ -88,6 +88,11 @@ let election_public_keys = service
~get_params:uuid
()
let election_public_creds = service
~path:["election"; "public_creds.txt"]
~get_params:uuid
()
let election_vote = service
~path:["election"; "vote"]
~get_params:uuid
......
......@@ -198,6 +198,10 @@ let election_view ~election ~user =
pcdata "Election data: ";
a ~service [ pcdata "parameters" ] ();
pcdata ", ";
a ~service:Services.(preapply_uuid election_public_creds election) [
pcdata "public credentials"
] ();
pcdata ", ";
a ~service:Services.(preapply_uuid election_public_keys election) [
pcdata "trustee public keys"
] ();
......@@ -276,9 +280,7 @@ let do_cast_ballot ~election ~result =
em [pcdata name];
(match result with
| `Valid hash -> pcdata (" has been accepted, its hash is " ^ hash ^ ".")
| `Invalid -> pcdata " is invalid!"
| `Malformed e -> Printf.ksprintf pcdata " is malformed! (%s)" (Printexc.to_string e)
| `Closed -> pcdata " cannot be accepted because the election is closed!"
| `Error e -> pcdata (" is rejected, because " ^ Web_common.explain_error e ^ ".")
);
];
p [
......
......@@ -24,11 +24,15 @@ type acl =
| Any
| Restricted of (user -> bool Lwt.t)
module SSet = Set.Make(String)
type election_data = {
fn_election : string;
fingerprint : string;
election : ff_pubkey election;
fn_public_keys : string;
public_creds : SSet.t;
fn_public_creds : string;
featured_p : bool;
can_read : acl;
can_vote : acl;
......@@ -68,9 +72,28 @@ module MakeLwtRandom (G : Signatures.GROUP) = struct
end
exception Serialization of exn
exception ProofCheck
exception ElectionClosed
type error =
| Serialization of exn
| ProofCheck
| ElectionClosed
| MissingCredential
| InvalidCredential
| RevoteNotAllowed
| ReusedCredential
exception Error of error
let fail e = Lwt.fail (Error e)
let explain_error = function
| Serialization e ->
Printf.sprintf "your ballot has a syntax error (%s)" (Printexc.to_string e)
| ProofCheck -> "some proofs failed verification"
| ElectionClosed -> "the election is closed"
| MissingCredential -> "a credential is missing"
| InvalidCredential -> "your credential is invalid"
| RevoteNotAllowed -> "you are not allowed to revote"
| ReusedCredential -> "your credential has already been used"
module type LWT_ELECTION = Signatures.ELECTION
with type elt = Z.t
......@@ -81,6 +104,8 @@ module type WEB_BBOX = sig
with type 'a m := 'a Lwt.t
and type ballot = string
and type record = string * datetime
val inject_creds : SSet.t -> unit Lwt.t
end
module MakeBallotBox (P : Signatures.ELECTION_PARAMS) (E : LWT_ELECTION) = struct
......@@ -94,10 +119,30 @@ module MakeBallotBox (P : Signatures.ELECTION_PARAMS) (E : LWT_ELECTION) = struc
let ballot_table = Ocsipersist.open_table ("ballots" ^ suffix)
let record_table = Ocsipersist.open_table ("records" ^ suffix)
let cred_table = Ocsipersist.open_table ("creds" ^ suffix)
type ballot = string
type record = string * Serializable_builtin_t.datetime
let inject_creds creds =
lwt existing_creds = Ocsipersist.fold_step (fun k v x ->
return (SSet.add k x)
) cred_table SSet.empty in
if SSet.is_empty existing_creds then (
Ocsigen_messages.debug (fun () ->
"-- injecting credentials"
);
SSet.fold (fun x unit ->
unit >> Ocsipersist.add cred_table x None
) creds (return ())
) else (
if SSet.(is_empty (diff creds existing_creds)) then (
Lwt.return ()
) else (
Lwt.fail (Invalid_argument "Existing credentials do not match")
)
)
let cast rawballot (user, date) =
let voting_open = match P.metadata with
| Some m ->
......@@ -112,15 +157,46 @@ module MakeBallotBox (P : Signatures.ELECTION_PARAMS) (E : LWT_ELECTION) = struc
try Lwt.return (
Serializable_j.ballot_of_string
Serializable_builtin_j.read_number rawballot
) with e -> Lwt.fail (Serialization e)
) with e -> fail (Serialization e)
in
if E.check_ballot ballot then (
Ocsipersist.add ballot_table (sha256_b64 rawballot) rawballot >>
Ocsipersist.add record_table user date
) else (
Lwt.fail ProofCheck
)
lwt credential =
match ballot.signature with
| Some s -> Lwt.return (Z.to_string s.s_commitment)
| None -> fail MissingCredential
in
lwt cred =
try_lwt Ocsipersist.find cred_table credential
with Not_found -> fail InvalidCredential
and old_record =
try_lwt
lwt x = Ocsipersist.find record_table user in
Lwt.return (Some x)
with Not_found -> Lwt.return None
in
match cred, old_record with
| None, None ->
(* first vote *)
if E.check_ballot ballot then (
let hash = sha256_b64 rawballot in
Ocsipersist.add cred_table credential (Some hash) >>
Ocsipersist.add ballot_table hash rawballot >>
Ocsipersist.add record_table user date
) else (
fail ProofCheck
)
| Some h, Some _ ->
(* revote *)
if E.check_ballot ballot then (
Ocsipersist.remove ballot_table h >>
let hash = sha256_b64 rawballot in
Ocsipersist.add cred_table credential (Some hash) >>
Ocsipersist.add ballot_table hash rawballot >>
Ocsipersist.add record_table user date
) else (
fail ProofCheck
)
| None, Some _ -> fail RevoteNotAllowed
| Some _, None -> fail ReusedCredential
let fold_ballots f x =
Ocsipersist.fold_step (fun k v x -> f v x) ballot_table x
......
......@@ -15,11 +15,15 @@ type acl =
| Any
| Restricted of (user -> bool Lwt.t)
module SSet : Set.S with type elt = string
type election_data = {
fn_election : string;
fingerprint : string;
election : ff_pubkey election;
fn_public_keys : string;
public_creds : SSet.t;
fn_public_creds : string;
featured_p : bool;
can_read : acl;
can_vote : acl;
......@@ -39,9 +43,18 @@ module MakeLwtRandom (G : Signatures.GROUP) : sig
end
(** Lwt-compatible random number generation. *)
exception Serialization of exn
exception ProofCheck
exception ElectionClosed
type error =
| Serialization of exn
| ProofCheck
| ElectionClosed
| MissingCredential
| InvalidCredential
| RevoteNotAllowed
| ReusedCredential
exception Error of error
val explain_error : error -> string
module type LWT_ELECTION = Signatures.ELECTION
with type elt = Z.t
......@@ -52,6 +65,8 @@ module type WEB_BBOX = sig
with type 'a m := 'a Lwt.t
and type ballot = string
and type record = string * datetime
val inject_creds : SSet.t -> unit Lwt.t
end
module MakeBallotBox (P : Signatures.ELECTION_PARAMS) (E : LWT_ELECTION) : WEB_BBOX
......
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