Maj terminée. Pour consulter la release notes associée voici le lien :
https://about.gitlab.com/releases/2021/07/07/critical-security-release-gitlab-14-0-4-released/

Commit b71d90c6 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

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
......@@ -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") ()
......
......@@ -323,17 +323,23 @@ let () = String.register
let generate_uuid = Uuidm.v4_gen (Random.State.make_self_init ())
let () = Redirection.register ~service:election_setup_new
(fun () () ->
match_lwt Web_auth_state.get_site_user () with
| Some u ->
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 u;
e_auth_config = Some [{auth_system = "password"; auth_instance = "password"; auth_config = []}];
e_cred_authority = None;
e_owner = Some owner;
e_auth_config;
e_cred_authority;
} in
let question = {
q_answers = [| "Answer 1"; "Answer 2"; "Blank" |];
......@@ -348,7 +354,7 @@ let () = Redirection.register ~service:election_setup_new
t_short_name = "short_name";
} in
let se = {
se_owner = u;
se_owner = owner;
se_group = "{\"g\":\"14887492224963187634282421537186040801304008017743492304481737382571933937568724473847106029915040150784031882206090286938661464458896494215273989547889201144857352611058572236578734319505128042602372864570426550855201448111746579871811249114781674309062693442442368697449970648232621880001709535143047913661432883287150003429802392229361583608686643243349727791976247247948618930423866180410558458272606627111270040091203073580238905303994472202930783207472394578498507764703191288249547659899997131166130259700604433891232298182348403175947450284433411265966789131024573629546048637848902243503970966798589660808533\",\"p\":\"16328632084933010002384055033805457329601614771185955389739167309086214800406465799038583634953752941675645562182498120750264980492381375579367675648771293800310370964745767014243638518442553823973482995267304044326777047662957480269391322789378384619428596446446984694306187644767462460965622580087564339212631775817895958409016676398975671266179637898557687317076177218843233150695157881061257053019133078545928983562221396313169622475509818442661047018436264806901023966236718367204710755935899013750306107738002364137917426595737403871114187750804346564731250609196846638183903982387884578266136503697493474682071\",\"q\":\"61329566248342901292543872769978950870633559608669337131139375508370458778917\"}";
se_voters = [];
se_questions;
......@@ -359,8 +365,27 @@ let () = Redirection.register ~service:election_setup_new
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 ()
)
let () = Html5.register ~service:election_setup_pre
(fun () () -> T.election_setup_pre ())
let () = Redirection.register ~service:election_setup_new
(fun () (credmgmt, (auth, cas_server)) ->
match_lwt Web_auth_state.get_site_user () with
| Some u ->
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
......
......@@ -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 ->
[
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 div_auth =
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 ""
in
let form_password =
match se.se_metadata.e_auth_config with
| Some [x] ->
(match x.auth_system with
| "password" ->
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
| _ -> pcdata "")
| _ -> pcdata ""
| `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 ".";
];
if has_credentials then (
post_form ~service:election_setup_credentials_server
(fun () ->
[string_input ~input_type:`Submit ~value:"Generate on server" ()]
) uuid;
) 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 [
......
......@@ -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