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 54d2bd75 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Simplifications in handling of ballot

We suppose any logged in user can vote; in preparation of a future
drop of the ACL system.
parent af5c6a3b
......@@ -844,96 +844,80 @@ let () =
)
) () ())
let ballot_received w user hash =
let module W = (val w : WEB_ELECTION) in
let can_vote = can_vote W.metadata user in
T.cast_confirmation (module W) ~can_vote hash ()
let () =
Any.register
~service:election_cast
(fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
(if_eligible w can_read
(fun user () ->
let cont () () =
Redirection.send
(Eliom_service.preapply
election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_services.cont cont >>
match_lwt Eliom_reference.get Web_services.ballot with
| Some b -> ballot_received w user (sha256_b64 b) >>= Html5.send
| None -> T.cast_raw (module W) () >>= Html5.send
)
) () ())
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let cont () () =
Redirection.send
(Eliom_service.preapply
election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_services.cont cont >>
match_lwt Eliom_reference.get Web_services.ballot with
| Some b -> T.cast_confirmation w (sha256_b64 b) () >>= Html5.send
| None -> T.cast_raw w () >>= Html5.send)
let () =
Any.register
~service:election_cast_post
(fun (uuid, ()) x ->
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
(if_eligible w can_read
(fun user (ballot_raw, ballot_file) ->
lwt the_ballot = match ballot_raw, ballot_file with
| Some ballot, None -> return ballot
| None, Some fi ->
let fname = fi.Ocsigen_extensions.tmp_filename in
Lwt_stream.to_string (Lwt_io.chars_of_file fname)
| _, _ -> fail_http 400
in
let cont () () =
Redirection.send
(Eliom_service.preapply
Web_services.election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_services.cont cont >>
Eliom_reference.set Web_services.ballot (Some the_ballot) >>
match user with
| None ->
Redirection.send
(Eliom_service.preapply
Web_services.election_login
((W.election.e_params.e_uuid, ()), None))
| Some u -> cont () ()
)
) () x)
(fun (uuid, ()) (ballot_raw, ballot_file) ->
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
lwt user = W.Auth.Services.get_user () in
lwt the_ballot = match ballot_raw, ballot_file with
| Some ballot, None -> return ballot
| None, Some fi ->
let fname = fi.Ocsigen_extensions.tmp_filename in
Lwt_stream.to_string (Lwt_io.chars_of_file fname)
| _, _ -> fail_http 400
in
let cont () () =
Redirection.send
(Eliom_service.preapply
Web_services.election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_services.cont cont >>
Eliom_reference.set Web_services.ballot (Some the_ballot) >>
match user with
| None ->
Redirection.send
(Eliom_service.preapply
Web_services.election_login
((W.election.e_params.e_uuid, ()), None))
| Some u -> cont () ())
let () =
Any.register
~service:election_cast_confirm
(fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
match_lwt Eliom_reference.get Web_services.ballot with
| Some the_ballot ->
begin
Eliom_reference.unset Web_services.ballot >>
match_lwt W.Auth.Services.get_user () with
| Some u ->
let b = check_acl W.metadata.e_voters u in
if b then (
let record = string_of_user u, now () in
lwt result =
try_lwt
lwt hash = W.B.cast the_ballot record in
return (`Valid hash)
with Error e -> return (`Error e)
in
Eliom_reference.unset Web_services.ballot >>
Eliom_reference.set Web_services.cast_confirmed (Some result) >>
Redirection.send
(Eliom_service.preapply
election_home (W.election.e_params.e_uuid, ()))
) else forbidden ()
| None -> forbidden ()
end
| None -> fail_http 404)
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
match_lwt Eliom_reference.get Web_services.ballot with
| Some the_ballot ->
begin
Eliom_reference.unset Web_services.ballot >>
match_lwt W.Auth.Services.get_user () with
| Some u ->
let record = string_of_user u, now () in
lwt result =
try_lwt
lwt hash = W.B.cast the_ballot record in
return (`Valid hash)
with Error e -> return (`Error e)
in
Eliom_reference.set Web_services.cast_confirmed (Some result) >>
Redirection.send
(Eliom_service.preapply
election_home (W.election.e_params.e_uuid, ()))
| None -> forbidden ()
end
| None -> fail_http 404)
let () =
Any.register
......
......@@ -855,13 +855,13 @@ let cast_raw w () =
lwt login_box = election_login_box w () in
base ~title:params.e_name ~login_box ~content ()
let cast_confirmation w ~can_vote hash () =
let cast_confirmation w hash () =
let module W = (val w : WEB_ELECTION) in
lwt user = W.Auth.Services.get_user () in
let params = W.election.e_params in
let name = params.e_name in
let user_div = match user with
| Some u when can_vote ->
| Some u ->
post_form ~service:election_cast_confirm (fun () -> [
p ~a:[a_style "text-align: center; padding: 10px;"] [
pcdata "I am ";
......@@ -873,10 +873,6 @@ let cast_confirmation w ~can_vote hash () =
pcdata ".";
]
]) (params.e_uuid, ())
| Some _ ->
div [
pcdata "You cannot vote in this election!";
]
| None ->
div [
pcdata "Please log in to confirm your vote.";
......
......@@ -39,7 +39,7 @@ val election_home : (module WEB_ELECTION) -> Web_persist.election_state -> unit
val election_admin : (module WEB_ELECTION) -> is_featured:bool -> Web_persist.election_state -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val update_credential : (module WEB_ELECTION) -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_raw : (module WEB_ELECTION) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_confirmation : (module WEB_ELECTION) -> can_vote:bool -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_confirmation : (module WEB_ELECTION) -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_confirmed : (module WEB_ELECTION) -> result:[< `Error of Web_common.error | `Valid of string ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val pretty_ballots : (module WEB_ELECTION) -> string list -> 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