Skip to content

GitLab

B
belenios
Commit b71d90c6 authored by Stephane Glondu's avatar Stephane Glondu
Browse files
Options

Add a pre-setup page 

On this page, the user can choose how credential will be managed, and
the authentication scheme. The goal is to simplify the workflow
afterwards.
parent 129f7270
Hide whitespace changes
Inline Side-by-side
Showing with 157 additions and 126 deletions
src/web/web_services.ml
View file @ b71d90c6
......@@ -35,7 +35,8 @@ let get_randomness = service ~path:["get-randomness"] ~get_params:unit ()
let tool = preapply (static_dir ()) ["static"; "belenios-tool.html"]
let election_setup_new = post_coservice ~csrf_safe:true ~fallback:admin ~post_params:unit ()
let election_setup_new = post_coservice ~csrf_safe:true ~fallback:admin ~post_params:(radio string "credmgmt" ** radio string "auth" ** string "cas_server") ()
let election_setup_pre = service ~path:["setup"; "new"] ~get_params:unit ()
let election_setup = service ~path:["setup"; "election"] ~get_params:(uuid "uuid") ()
let election_setup_group = post_coservice ~fallback:election_setup ~post_params:(string "group") ()
let election_setup_metadata = post_coservice ~fallback:election_setup ~post_params:(string "metadata") ()
......
src/web/web_site.ml
View file @ b71d90c6
......@@ -323,44 +323,69 @@ let () = String.register
let generate_uuid = Uuidm.v4_gen (Random.State.make_self_init ())
let create_new_election owner cred auth =
let e_cred_authority = match cred with
| `Automatic -> Some "server"
| `Manual -> None
in
let e_auth_config = match auth with
| `Password -> Some [{auth_system = "password"; auth_instance = "password"; auth_config = []}]
| `Dummy -> Some [{auth_system = "dummy"; auth_instance = "dummy"; auth_config = []}]
| `CAS server -> Some [{auth_system = "cas"; auth_instance = "cas"; auth_config = ["server", server]}]
in
let uuid = generate_uuid () in
let uuid_s = Uuidm.to_string uuid in
lwt token = generate_token () in
let se_metadata = {
e_owner = Some owner;
e_auth_config;
e_cred_authority;
} in
let question = {
q_answers = [| "Answer 1"; "Answer 2"; "Blank" |];
q_min = 1;
q_max = 1;
q_question = "Question 1?";
} in
let se_questions = {
t_description = "Description of the election.";
t_name = "Name of the election";
t_questions = [| question |];
t_short_name = "short_name";
} in
let se = {
se_owner = owner;
se_group = "{\"g\":\"14887492224963187634282421537186040801304008017743492304481737382571933937568724473847106029915040150784031882206090286938661464458896494215273989547889201144857352611058572236578734319505128042602372864570426550855201448111746579871811249114781674309062693442442368697449970648232621880001709535143047913661432883287150003429802392229361583608686643243349727791976247247948618930423866180410558458272606627111270040091203073580238905303994472202930783207472394578498507764703191288249547659899997131166130259700604433891232298182348403175947450284433411265966789131024573629546048637848902243503970966798589660808533\",\"p\":\"16328632084933010002384055033805457329601614771185955389739167309086214800406465799038583634953752941675645562182498120750264980492381375579367675648771293800310370964745767014243638518442553823973482995267304044326777047662957480269391322789378384619428596446446984694306187644767462460965622580087564339212631775817895958409016676398975671266179637898557687317076177218843233150695157881061257053019133078545928983562221396313169622475509818442661047018436264806901023966236718367204710755935899013750306107738002364137917426595737403871114187750804346564731250609196846638183903982387884578266136503697493474682071\",\"q\":\"61329566248342901292543872769978950870633559608669337131139375508370458778917\"}";
se_voters = [];
se_questions;
se_public_keys = [];
se_metadata;
se_public_creds = token;
} in
lwt () = Ocsipersist.add election_stable uuid_s se in
lwt () = Ocsipersist.add election_credtokens token uuid_s in
return (preapply election_setup uuid)
let () = Html5.register ~service:election_setup_pre
(fun () () -> T.election_setup_pre ())
let () = Redirection.register ~service:election_setup_new
(fun () () ->
(fun () (credmgmt, (auth, cas_server)) ->
match_lwt Web_auth_state.get_site_user () with
| Some u ->
let uuid = generate_uuid () in
let uuid_s = Uuidm.to_string uuid in
lwt token = generate_token () in
let se_metadata = {
e_owner = Some u;
e_auth_config = Some [{auth_system = "password"; auth_instance = "password"; auth_config = []}];
e_cred_authority = None;
} in
let question = {
q_answers = [| "Answer 1"; "Answer 2"; "Blank" |];
q_min = 1;
q_max = 1;
q_question = "Question 1?";
} in
let se_questions = {
t_description = "Description of the election.";
t_name = "Name of the election";
t_questions = [| question |];
t_short_name = "short_name";
} in
let se = {
se_owner = u;
se_group = "{\"g\":\"14887492224963187634282421537186040801304008017743492304481737382571933937568724473847106029915040150784031882206090286938661464458896494215273989547889201144857352611058572236578734319505128042602372864570426550855201448111746579871811249114781674309062693442442368697449970648232621880001709535143047913661432883287150003429802392229361583608686643243349727791976247247948618930423866180410558458272606627111270040091203073580238905303994472202930783207472394578498507764703191288249547659899997131166130259700604433891232298182348403175947450284433411265966789131024573629546048637848902243503970966798589660808533\",\"p\":\"16328632084933010002384055033805457329601614771185955389739167309086214800406465799038583634953752941675645562182498120750264980492381375579367675648771293800310370964745767014243638518442553823973482995267304044326777047662957480269391322789378384619428596446446984694306187644767462460965622580087564339212631775817895958409016676398975671266179637898557687317076177218843233150695157881061257053019133078545928983562221396313169622475509818442661047018436264806901023966236718367204710755935899013750306107738002364137917426595737403871114187750804346564731250609196846638183903982387884578266136503697493474682071\",\"q\":\"61329566248342901292543872769978950870633559608669337131139375508370458778917\"}";
se_voters = [];
se_questions;
se_public_keys = [];
se_metadata;
se_public_creds = token;
} in
lwt () = Ocsipersist.add election_stable uuid_s se in
lwt () = Ocsipersist.add election_credtokens token uuid_s in
return (preapply election_setup uuid)
| None -> forbidden ()
)
lwt credmgmt = match credmgmt with
| Some "auto" -> return `Automatic
| Some "manual" -> return `Manual
| _ -> fail_http 400
in
lwt auth = match auth with
| Some "password" -> return `Password
| Some "dummy" -> return `Dummy
| Some "cas" -> return @@ `CAS cas_server
| _ -> fail_http 400
in
create_new_election u credmgmt auth
| None -> forbidden ())
let generic_setup_page f uuid () =
match_lwt Web_auth_state.get_site_user () with
......
src/web/web_templates.ml
View file @ b71d90c6
......@@ -195,13 +195,6 @@ let admin ~elections () =
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
| Some (elections, tallied, setup_elections) ->
let setup_form = post_form ~service:election_setup_new
(fun () ->
[
div [string_input ~a:[a_style "font-size:24px;"] ~input_type:`Submit ~value:"Prepare a new election" ()]
]
) ()
in
let elections =
match elections with
| [] -> p [pcdata "You own no such elections!"]
......@@ -222,7 +215,11 @@ let admin ~elections () =
in
let content = [
div [
div [setup_form];
div [
a ~service:election_setup_pre [
pcdata "Prepare a new election";
] ();
];
div [br ()];
h2 [pcdata "Elections being prepared"];
setup_elections;
......@@ -269,6 +266,53 @@ let generic_page ~title message () =
let login_box = pcdata "" in
base ~title ~login_box ~content ()
let election_setup_pre () =
let title = "Prepare a new election" in
let form =
post_form ~service:election_setup_new
(fun (credmgmt, (auth, cas_server)) ->
[
fieldset
~legend:(legend [pcdata "Credential management"])
[
div [
string_radio ~checked:true ~name:credmgmt ~value:"auto" ();
pcdata " Automatic (degraded mode)";
];
div [
string_radio ~name:credmgmt ~value:"manual" ();
pcdata " Manual (safe mode)";
];
];
fieldset
~legend:(legend [pcdata "Authentication"])
[
div [
string_radio ~checked:true ~name:auth ~value:"password" ();
pcdata " Password (passwords will be emailed to voters)";
];
div [
string_radio ~name:auth ~value:"dummy" ();
pcdata " Dummy (typically for a test election)";
];
div [
string_radio ~name:auth ~value:"cas" ();
pcdata " CAS (external authentication server), server address: ";
string_input ~input_type:`Text ~name:cas_server ();
];
];
div [
string_input ~input_type:`Submit ~value:"Proceed" ();
];
]
) ()
in
let content = [
form
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let election_setup uuid se () =
let title = "Preparation of election " ^ se.se_questions.t_name in
let make_form ?a service value title =
......@@ -324,73 +368,38 @@ let election_setup uuid se () =
(Eliom_service.preapply election_setup_metadata uuid)
value "Election metadata"
in
let form_auth =
let checked_dummy, checked_password, checked_cas =
match se.se_metadata.e_auth_config with
| Some [x] ->
(match x.auth_system with
| "dummy" -> true, false, false
| "password" -> false, true, false
| "cas" -> false, false, true
| _ -> false, false, false)
| _ -> false, false, false
in
post_form ~service:election_setup_auth
(fun name ->
[
div [
string_radio ~checked:checked_password ~name ~value:"password" ();
pcdata "Password (passwords will be emailed to voters)";
];
div [
string_radio ~checked:checked_dummy ~name ~value:"dummy" ();
pcdata "Dummy (typically for a test election)";
];
div [
string_radio ~checked:checked_cas ~name ~value:"cas" ();
pcdata "CAS (external authentication server)";
];
div [
string_input ~input_type:`Submit ~value:"Change authentication mode" ();
];
])
uuid
let has_credentials = match se.se_metadata.e_cred_authority with
| None -> false
| Some _ -> true
in
let form_cas =
match se.se_metadata.e_auth_config with
| Some [x] ->
(match x.auth_system with
| "cas" ->
let value =
match x.auth_config with
| ["server", x] -> x
| _ -> ""
in
post_form ~service:election_setup_auth_cas
(fun name ->
[
div [
pcdata "CAS server address: ";
string_input ~name ~input_type:`Text ~a:[a_size 40] ~value ();
string_input ~input_type:`Submit ~value:"Submit" ();
]
]) uuid
| _ -> pcdata "")
| _ -> pcdata ""
let auth = match se.se_metadata.e_auth_config with
| Some [{auth_system = "password"; _}] -> `Password
| Some [{auth_system = "dummy"; _}] -> `Dummy
| Some [{auth_system = "cas"; auth_config = ["server", server]; _}] -> `CAS server
| _ -> failwith "unknown authentication scheme in election_setup"
in
let form_password =
match se.se_metadata.e_auth_config with
| Some [x] ->
(match x.auth_system with
| "password" ->
post_form ~service:election_setup_auth_genpwd
(fun () ->
[div [
string_input ~input_type:`Submit ~value:"Generate passwords" ()
]]
) uuid
| _ -> pcdata "")
| _ -> pcdata ""
let div_auth =
div [
h2 [pcdata "Authentication"];
match auth with
| `Password ->
post_form ~service:election_setup_auth_genpwd
(fun () ->
[div [
pcdata "Authentication scheme: password ";
string_input ~input_type:`Submit ~value:"Generate passwords" ()
]]
) uuid
| `Dummy ->
div [
pcdata "Authentication scheme: dummy"
]
| `CAS server ->
div [
pcdata "Authentication scheme: CAS with server ";
pcdata server;
]
]
in
let div_questions =
div [
......@@ -429,15 +438,16 @@ let election_setup uuid se () =
let div_credentials =
div [
h2 [pcdata "Credentials"];
div [
pcdata "The server may generate and email the credentials to the voters. If you prefer to delegate this task to another authority, click ";
a ~service:election_setup_credential_authority [pcdata "here"] uuid;
pcdata ".";
];
post_form ~service:election_setup_credentials_server
(fun () ->
[string_input ~input_type:`Submit ~value:"Generate on server" ()]
) uuid;
if has_credentials then (
post_form ~service:election_setup_credentials_server
(fun () ->
[string_input ~input_type:`Submit ~value:"Generate on server" ()]
) uuid
) else (
div [
a ~service:election_setup_credential_authority [pcdata "Credential management"] uuid;
]
)
]
in
let form_create =
......@@ -460,12 +470,7 @@ let election_setup uuid se () =
hr ();
form_group;
form_metadata;
div [
h2 [pcdata "Authentication"];
form_auth;
form_cas;
form_password;
];
div_auth;
hr ();
div_trustees;
hr ();
......@@ -524,8 +529,7 @@ let election_setup_credential_authority uuid se () =
let title = "Credentials for election " ^ se.se_questions.t_name in
let content = [
div [
pcdata "If you wish the credentials to be generated and managed by ";
pcdata "an external authority, please send her the following link:";
pcdata "Please send the credential authority the following link:";
];
ul [
li [
......
src/web/web_templates.mli
View file @ b71d90c6
......@@ -28,6 +28,7 @@ val new_election_failure : [ `Exists | `Exception of exn ] -> unit -> [> `Html ]
val generic_page : title:string -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_pre : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup : Uuidm.t -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_voters : Uuidm.t -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_questions : Uuidm.t -> Web_common.setup_election -> 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