Commit 199a023e authored by Stephane Glondu's avatar Stephane Glondu

Check that voter's login is on the voters list

parent 347654be
......@@ -81,6 +81,7 @@ type error =
| WrongCredential
| UsedCredential
| CredentialNotFound
| UnauthorizedVoter
exception Error of error
......@@ -98,6 +99,7 @@ let explain_error = function
| WrongCredential -> "you are not allowed to vote with this credential"
| UsedCredential -> "the credential has already been used"
| CredentialNotFound -> "the credential has not been found"
| UnauthorizedVoter -> "you are not allowed to vote"
let security_logfile = ref None
......@@ -243,3 +245,11 @@ let send_email from to_ subject body =
in
let sendmail = "/usr/sbin/sendmail" in
Lwt_process.pwrite (sendmail, [|sendmail; "-f"; from; to_|]) contents
let split_identity x =
let n = String.length x in
try
let i = String.index x ',' in
String.sub x 0 i, String.sub x (i+1) (n-i-1)
with Not_found ->
x, x
......@@ -49,6 +49,7 @@ type error =
| WrongCredential
| UsedCredential
| CredentialNotFound
| UnauthorizedVoter
exception Error of error
......@@ -112,3 +113,5 @@ val string_of_user : user -> string
val underscorize : string -> string
val send_email : string -> string -> string -> string -> unit Lwt.t
val split_identity : string -> string * string
......@@ -72,6 +72,14 @@ module Make (D : WEB_ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB
Ocsipersist.add cred_table cred None
let do_cast rawballot (user, date) =
let voters = Lwt_io.lines_of_file (!spool_dir / uuid / "voters.txt") in
lwt voters = Lwt_stream.to_list voters in
let voter_ok = List.exists (fun x ->
let _, login = split_identity x in
login = user.user_name
) voters in
if not voter_ok then fail UnauthorizedVoter else return () >>
let user = string_of_user user in
lwt state = Web_persist.get_election_state uuid in
let voting_open = state = `Open in
if not voting_open then fail ElectionClosed else return () >>
......
......@@ -70,7 +70,7 @@ module type WEB_BALLOT_BOX = sig
and type elt = datetime * string
and type key = string
val cast : string -> string * datetime -> string Lwt.t
val cast : string -> user * datetime -> string Lwt.t
val inject_cred : string -> unit Lwt.t
val update_files : unit -> unit Lwt.t
val update_cred : old:string -> new_:string -> unit Lwt.t
......
......@@ -502,14 +502,15 @@ counts.
--
Belenios"
let generate_password table title url v =
let generate_password table title url id =
let email, login = split_identity id in
lwt salt = generate_token () in
lwt password = generate_token () in
let hashed = sha256_hex (salt ^ password) in
lwt () = Ocsipersist.add table v (salt, hashed) in
let body = Printf.sprintf template_password title v password url in
lwt () = Ocsipersist.add table login (salt, hashed) in
let body = Printf.sprintf template_password title login password url in
let subject = "Your password for election " ^ title in
send_email "noreply@belenios.org" v subject body
send_email "noreply@belenios.org" email subject body
let () =
Any.register
......@@ -606,7 +607,7 @@ let () =
(* see http://www.regular-expressions.info/email.html *)
let email_rex = Pcre.regexp
~flags:[`CASELESS]
"^[A-Z0-9._%+-]+@[A-Z0-9.-]+\\.[A-Z]{2,7}$"
"^[A-Z0-9._%+-]+@[A-Z0-9.-]+\\.[A-Z]{2,7}(,[A-Z0-9._%+-]+)?$"
let is_email x =
try ignore (Pcre.pcre_exec ~rex:email_rex x); true
......@@ -819,7 +820,8 @@ let () =
let module S = Set.Make (PString) in
let module G = (val Group.of_string se.se_group : GROUP) in
lwt creds =
Lwt_list.fold_left_s (fun accu id ->
Lwt_list.fold_left_s (fun accu identity ->
let email, login = split_identity identity in
lwt cred = Credgen.generate () in
let priv_cred = derive_cred uuid cred in
let pub_cred =
......@@ -827,9 +829,9 @@ let () =
let y = G.(g **~ x) in
G.to_string y
in
let body = Printf.sprintf template_credential title id cred url in
let body = Printf.sprintf template_credential title login cred url in
let subject = "Your credential for election " ^ title in
lwt () = send_email "noreply@belenios.org" id subject body in
lwt () = send_email "noreply@belenios.org" email subject body in
return @@ S.add pub_cred accu
) S.empty se.se_voters
in
......@@ -1165,7 +1167,7 @@ let () =
Eliom_reference.unset Web_services.ballot >>
match_lwt Web_auth_state.get_election_user uuid with
| Some u ->
let record = string_of_user u, now () in
let record = u, now () in
lwt result =
try_lwt
lwt hash = B.cast the_ballot record in
......@@ -1235,7 +1237,8 @@ let () =
in
let module S = Set.Make (PString) in
lwt voters = Lwt_stream.fold (fun v accu ->
S.add v accu
let _, login = split_identity v in
S.add login accu
) voters S.empty in
let records = Lwt_io.lines_of_file
(W.dir / string_of_election_file ESRecords)
......
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