Commit 8abd5757 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Click-oriented auth config + password generation and mailing

parent 1f3908c0
......@@ -241,3 +241,9 @@ let string_of_user {user_domain; user_name} =
let underscorize x =
String.map (function '-' -> '_' | c -> c) x
let send_email from to_ subject body =
let contents =
"From: " ^ from ^ "\nTo: " ^ to_ ^ "\nSubject: " ^ subject ^ "\n\n" ^ body
in
Lwt_process.pwrite ("sendmail", [|"sendmail"; to_|]) contents
......@@ -110,3 +110,5 @@ val generate_token : unit -> string Lwt.t
val string_of_user : user -> string
val underscorize : string -> string
val send_email : string -> string -> string -> string -> unit Lwt.t
......@@ -54,6 +54,9 @@ let election_setup_credentials_post_file = post_coservice ~fallback:election_set
let election_setup_trustee = service ~path:["setup"; "trustee"] ~get_params:(string "token") ()
let election_setup_trustee_post = post_coservice ~fallback:election_setup_trustee ~post_params:(string "public_key") ()
let election_setup_create = post_coservice ~csrf_safe:true ~fallback:election_setup ~post_params:unit ()
let election_setup_auth = post_coservice ~fallback:election_setup ~post_params:(radio string "system") ()
let election_setup_auth_cas = post_coservice ~fallback:election_setup ~post_params:(string "server") ()
let election_setup_auth_genpwd = post_coservice ~fallback:election_setup ~post_params:unit ()
let election_home = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "")) ()
let election_admin = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "admin")) ()
......
......@@ -403,6 +403,77 @@ let () =
if metadata.e_owner <> Some u then failwith "wrong owner";
se.se_metadata <- metadata) election_setup)
let () =
Any.register
~service:election_setup_auth
(handle_setup
(fun se auth_system _ _ ->
match auth_system with
| Some (("dummy" | "password") as auth_system) ->
se.se_metadata <- {
se.se_metadata with
e_auth_config = Some [{
auth_system;
auth_instance = auth_system;
auth_config = []
}]
}
| Some "cas" ->
se.se_metadata <- {
se.se_metadata with
e_auth_config = Some [{
auth_system = "cas";
auth_instance = "cas";
auth_config = ["server", ""];
}]
}
| Some x -> failwith ("unknown authentication system: "^x)
| None -> failwith "no authentication system was given"
) election_setup)
let () =
Any.register
~service:election_setup_auth_cas
(handle_setup
(fun se server _ _ ->
se.se_metadata <- {
se.se_metadata with
e_auth_config = Some [{
auth_system = "cas";
auth_instance = "cas";
auth_config = ["server", server];
}]
}) election_setup)
let () =
Any.register
~service:election_setup_auth_genpwd
(handle_setup
(fun se () _ uuid ->
let table =
"password_" ^
let u = Uuidm.to_string uuid in
underscorize u
in
let table = Ocsipersist.open_table table in
Lwt_list.iter_s (fun v ->
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 =
"Username: " ^ v ^ "\nPassword: " ^ password ^ "\n"
in
let subject =
"Your password for election " ^ Uuidm.to_string uuid
in
lwt () = send_email "noreply@belenios.org" v subject body in
Ocsigen_messages.debug (fun () ->
Printf.sprintf "----- Password for %s is %s" v password
);
return ()
) se.se_voters) election_setup)
let () =
Html5.register
~service:election_setup_questions
......
......@@ -264,6 +264,74 @@ 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_dummy ~name ~value:"dummy" ();
pcdata "Dummy";
];
div [
string_radio ~checked:checked_password ~name ~value:"password" ();
pcdata "Password";
];
div [
string_radio ~checked:checked_cas ~name ~value:"cas" ();
pcdata "CAS";
];
div [
string_input ~input_type:`Submit ~value:"Submit" ();
];
])
uuid
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 ""
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 and mail passwords" ()
]]
) uuid
| _ -> pcdata "")
| _ -> pcdata ""
in
let div_questions =
div
[h2 [pcdata "Questions"];
......@@ -349,6 +417,12 @@ let election_setup uuid se () =
div_credentials;
form_group;
form_metadata;
div [
h2 [pcdata "Authentication"];
form_auth;
form_cas;
form_password;
];
div_questions;
form_create;
] in
......
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