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

Move auth-related pages to the end of Web_templates

parent f1eb6365
......@@ -167,98 +167,6 @@ let admin ~elections auth () =
lwt login_box = site_login_box auth () in
base ~title ~login_box ~content ()
let login_box auth links =
let module S = (val auth : AUTH_SERVICES) in
let style =
if S.auth_realm = "site" then admin_background else ""
in
make_login_box style auth links
let dummy ~service auth links () =
let title, field_name, input_type =
"Dummy login", "Username:", `Text
in
let form = post_form ~service
(fun name ->
[
tablex [tbody [
tr [
th [label ~a:[a_for name] [pcdata field_name]];
td [string_input ~a:[a_maxlength 50] ~input_type ~name ()];
]]
];
div [
string_input ~input_type:`Submit ~value:"Login" ();
]
]) ()
in
let content = [
form;
] in
lwt login_box = login_box auth links in
base ~title ~login_box ~content ()
let password ~service auth links () =
let form = post_form ~service
(fun (llogin, lpassword) ->
[
tablex [tbody [
tr [
th [label ~a:[a_for llogin] [pcdata "Username:"]];
td [string_input ~a:[a_maxlength 50] ~input_type:`Text ~name:llogin ()];
];
tr [
th [label ~a:[a_for lpassword] [pcdata "Password:"]];
td [string_input ~a:[a_maxlength 50] ~input_type:`Password ~name:lpassword ()];
];
]];
div [
string_input ~input_type:`Submit ~value:"Login" ();
]
]) ()
in
let content = [
form;
] in
lwt login_box = login_box auth links in
base ~title:"Password login" ~login_box ~content ()
let upload_password_db ~service auth links () =
let title = "Upload password database" in
let form = post_form ~service
(fun password_db ->
[
div [
pcdata "Password database (CSV format): ";
file_input ~name:password_db ();
];
div [string_input ~input_type:`Submit ~value:"Submit" ()];
]
) ()
in
let content = [
div [form];
] in
lwt login_box = login_box auth links in
base ~title ~login_box ~content ()
let choose auth links () =
let module S = (val auth : AUTH_SERVICES) in
let module L = (val links : AUTH_LINKS) in
let auth_systems =
S.get_auth_systems () |>
List.map (fun name ->
a ~service:(L.login (Some name)) [pcdata name] ()
) |> list_join (pcdata ", ")
in
let content = [
div [p (
[pcdata "Please log in: ["] @ auth_systems @ [pcdata "]"]
)]
] in
lwt login_box = login_box auth links in
base ~title:"Log in" ~login_box ~content ()
let format_date = Platform.format_datetime "%a, %d %b %Y %T %z"
let make_button ~service contents =
......@@ -985,3 +893,95 @@ let pretty_ballots w hashes () =
] in
lwt login_box = election_login_box w () in
base ~title ~login_box ~content ()
let login_box auth links =
let module S = (val auth : AUTH_SERVICES) in
let style =
if S.auth_realm = "site" then admin_background else ""
in
make_login_box style auth links
let dummy ~service auth links () =
let title, field_name, input_type =
"Dummy login", "Username:", `Text
in
let form = post_form ~service
(fun name ->
[
tablex [tbody [
tr [
th [label ~a:[a_for name] [pcdata field_name]];
td [string_input ~a:[a_maxlength 50] ~input_type ~name ()];
]]
];
div [
string_input ~input_type:`Submit ~value:"Login" ();
]
]) ()
in
let content = [
form;
] in
lwt login_box = login_box auth links in
base ~title ~login_box ~content ()
let password ~service auth links () =
let form = post_form ~service
(fun (llogin, lpassword) ->
[
tablex [tbody [
tr [
th [label ~a:[a_for llogin] [pcdata "Username:"]];
td [string_input ~a:[a_maxlength 50] ~input_type:`Text ~name:llogin ()];
];
tr [
th [label ~a:[a_for lpassword] [pcdata "Password:"]];
td [string_input ~a:[a_maxlength 50] ~input_type:`Password ~name:lpassword ()];
];
]];
div [
string_input ~input_type:`Submit ~value:"Login" ();
]
]) ()
in
let content = [
form;
] in
lwt login_box = login_box auth links in
base ~title:"Password login" ~login_box ~content ()
let upload_password_db ~service auth links () =
let title = "Upload password database" in
let form = post_form ~service
(fun password_db ->
[
div [
pcdata "Password database (CSV format): ";
file_input ~name:password_db ();
];
div [string_input ~input_type:`Submit ~value:"Submit" ()];
]
) ()
in
let content = [
div [form];
] in
lwt login_box = login_box auth links in
base ~title ~login_box ~content ()
let choose auth links () =
let module S = (val auth : AUTH_SERVICES) in
let module L = (val links : AUTH_LINKS) in
let auth_systems =
S.get_auth_systems () |>
List.map (fun name ->
a ~service:(L.login (Some name)) [pcdata name] ()
) |> list_join (pcdata ", ")
in
let content = [
div [p (
[pcdata "Please log in: ["] @ auth_systems @ [pcdata "]"]
)]
] in
lwt login_box = login_box auth links in
base ~title:"Log in" ~login_box ~content ()
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