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

Fix indentation in Web_templates

parent 21ce63f9
......@@ -75,887 +75,887 @@ let make_login_box style auth links =
)
let site_login_box =
let auth = (module Web_site_auth : AUTH_SERVICES) in
let module L = struct
let login x = Eliom_service.preapply site_login x
let logout = Eliom_service.preapply site_logout ()
end in
let links = (module L : AUTH_LINKS) in
fun () -> make_login_box admin_background auth links
let base ~title ~login_box ~content ?(footer = div []) () =
Lwt.return (html ~a:[a_dir `Ltr; a_xml_lang "en"]
(head (Eliom_content.Html5.F.title (pcdata title)) [
script (pcdata "window.onbeforeunload = function () {};");
link ~rel:[`Stylesheet] ~href:(uri_of_string (fun () -> "/static/site.css")) ();
])
(body [
div ~a:[a_id "wrapper"] [
div ~a:[a_id "header"] [
div [
div ~a:[a_style "float: left;"] [
a ~service:home [pcdata site_title] ();
];
login_box;
div ~a:[a_style "clear: both;"] [];
let site_login_box =
let auth = (module Web_site_auth : AUTH_SERVICES) in
let module L = struct
let login x = Eliom_service.preapply site_login x
let logout = Eliom_service.preapply site_logout ()
end in
let links = (module L : AUTH_LINKS) in
fun () -> make_login_box admin_background auth links
let base ~title ~login_box ~content ?(footer = div []) () =
Lwt.return (html ~a:[a_dir `Ltr; a_xml_lang "en"]
(head (Eliom_content.Html5.F.title (pcdata title)) [
script (pcdata "window.onbeforeunload = function () {};");
link ~rel:[`Stylesheet] ~href:(uri_of_string (fun () -> "/static/site.css")) ();
])
(body [
div ~a:[a_id "wrapper"] [
div ~a:[a_id "header"] [
div [
div ~a:[a_style "float: left;"] [
a ~service:home [pcdata site_title] ();
];
h1 ~a:[a_style "text-align: center;"] [pcdata title];
login_box;
div ~a:[a_style "clear: both;"] [];
];
div ~a:[a_id "main"] content;
div ~a:[a_id "footer"; a_style "text-align: center;" ] [
div ~a:[a_id "bottom"] [
footer;
pcdata "Powered by ";
a ~service:source_code [pcdata "Belenios"] ();
pcdata ". ";
a ~service:admin [pcdata "Administer elections"] ();
pcdata ".";
]
]]
]))
let format_election kind election =
let module W = (val election : WEB_ELECTION) in
let e = W.election.e_params in
let service =
match kind with
| `Home -> election_home
| `Admin -> election_admin
in
li [
h3 [
a ~service [pcdata e.e_name] (e.e_uuid, ());
h1 ~a:[a_style "text-align: center;"] [pcdata title];
];
p [pcdata e.e_description];
]
let home ~featured () =
let featured_box = match featured with
| _::_ ->
div [
h2 [pcdata "Current featured elections"];
ul (List.map (format_election `Home) featured);
]
| [] ->
div [
pcdata "No featured elections at the moment.";
div ~a:[a_id "main"] content;
div ~a:[a_id "footer"; a_style "text-align: center;" ] [
div ~a:[a_id "bottom"] [
footer;
pcdata "Powered by ";
a ~service:source_code [pcdata "Belenios"] ();
pcdata ". ";
a ~service:admin [pcdata "Administer elections"] ();
pcdata ".";
]
in
let content = [
]]
]))
let format_election kind election =
let module W = (val election : WEB_ELECTION) in
let e = W.election.e_params in
let service =
match kind with
| `Home -> election_home
| `Admin -> election_admin
in
li [
h3 [
a ~service [pcdata e.e_name] (e.e_uuid, ());
];
p [pcdata e.e_description];
]
let home ~featured () =
let featured_box = match featured with
| _::_ ->
div [
pcdata welcome_message;
featured_box;
];
] in
let login_box = pcdata "" in
base ~title:site_title ~login_box ~content ()
let admin ~elections () =
let title = site_title ^ " — Administration" in
let elections =
match elections with
| [] -> p [pcdata "You cannot administer any elections!"]
| _ -> ul @@ List.map (format_election `Admin) elections
in
let content = [
h2 [pcdata "Current featured elections"];
ul (List.map (format_election `Home) featured);
]
| [] ->
div [
div [a ~service:new_election [pcdata "Create a new election"] ()];
div [a ~service:election_setup_index [pcdata "Elections being prepared"] ()];
h2 [pcdata "Elections you can administer"];
elections;
];
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
pcdata "No featured elections at the moment.";
]
in
let content = [
div [
pcdata welcome_message;
featured_box;
];
] in
let login_box = pcdata "" in
base ~title:site_title ~login_box ~content ()
let admin ~elections () =
let title = site_title ^ " — Administration" in
let elections =
match elections with
| [] -> p [pcdata "You cannot administer any elections!"]
| _ -> ul @@ List.map (format_election `Admin) elections
in
let content = [
div [
div [a ~service:new_election [pcdata "Create a new election"] ()];
div [a ~service:election_setup_index [pcdata "Elections being prepared"] ()];
h2 [pcdata "Elections you can administer"];
elections;
];
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
module Login (S : AUTH_SERVICES) (L : AUTH_LINKS) : LOGIN_TEMPLATES = struct
module Login (S : AUTH_SERVICES) (L : AUTH_LINKS) : LOGIN_TEMPLATES = struct
let login_box =
let auth = (module S : AUTH_SERVICES) in
let links = (module L : AUTH_LINKS) in
let style =
if S.auth_realm = "site" then admin_background else ""
in
fun () -> make_login_box style auth links
let login_box =
let auth = (module S : AUTH_SERVICES) in
let links = (module L : AUTH_LINKS) in
let style =
if S.auth_realm = "site" then admin_background else ""
in
fun () -> make_login_box style auth links
let dummy ~service () =
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 () in
base ~title ~login_box ~content ()
let password ~service () =
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 () in
base ~title:"Password login" ~login_box ~content ()
let upload_password_db ~service () =
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 = site_login_box () in
base ~title ~login_box ~content ()
let choose () =
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 () in
base ~title:"Log in" ~login_box ~content ()
end
let format_date = Platform.format_datetime "%a, %d %b %Y %T %z"
let make_button ~service contents =
let uri = Eliom_uri.make_string_uri ~service () in
Printf.ksprintf Unsafe.data (* FIXME: unsafe *)
"<button onclick=\"location.href='%s';\" style=\"font-size:35px;\">%s</button>"
uri
contents
let new_election () =
let title = "Create new election" in
lwt body =
let form = post_form ~service:new_election_post
(fun (election, (metadata, (public_keys, public_creds))) ->
[
h2 [pcdata "Import prepared election"];
p [
pcdata "This section assumes you have already prepared election files offline using either the command-line tool or its ";
a ~service:tool [pcdata "web version"] ();
pcdata ".";
];
div [
pcdata "Public election parameters: ";
file_input ~name:election ();
];
div [
pcdata "Optional metadata: ";
file_input ~name:metadata ()
];
div [
pcdata "Trustee public keys: ";
file_input ~name:public_keys ()
];
div [
pcdata "Public credentials: ";
file_input ~name:public_creds ()
];
div [string_input ~input_type:`Submit ~value:"Submit" ()];
let dummy ~service () =
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 setup_form = post_form ~service:election_setup_new
(fun () ->
[
h2 [pcdata "Prepare a new election"];
div [string_input ~input_type:`Submit ~value:"Prepare a new election" ()]
]
) ()
in
return [form; setup_form]
]) ()
in
let content = [
div body;
form;
] in
lwt login_box = site_login_box () in
lwt login_box = login_box () in
base ~title ~login_box ~content ()
let new_election_failure reason () =
let title = "Create new election" in
let reason =
match reason with
| `Exists -> pcdata "An election with the same UUID already exists."
| `Exception e -> pcdata @@ Printexc.to_string e
let password ~service () =
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 = [
div [
p [pcdata "The creation failed."];
p [reason];
]
form;
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
lwt login_box = login_box () in
base ~title:"Password login" ~login_box ~content ()
let election_setup_index uuids () =
let service = election_setup in
let title = "Elections being prepared" in
let uuids =
List.map (fun k ->
li [a ~service [pcdata (Uuidm.to_string k)] k]
) uuids
in
let list =
match uuids with
| [] -> div [pcdata "You own no such elections."]
| us -> ul us
let upload_password_db ~service () =
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 [list];
div [form];
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let generic_error_page message () =
let title = "Error" in
let content = [
p [pcdata message];
] in
let login_box = pcdata "" in
base ~title ~login_box ~content ()
let election_setup uuid se () =
let title = "Preparation of election " ^ Uuidm.to_string uuid in
let make_form ?a service value title =
post_form ?a ~service
(fun name ->
[
div [
h2 [pcdata title];
div [textarea ~a:[a_rows 5; a_cols 80] ~name ~value ()];
div [string_input ~input_type:`Submit ~value:"Submit" ()];
]
]
) ()
in
let form_group =
make_form
~a:[a_style "display: none;"]
(Eliom_service.preapply election_setup_group uuid)
se.se_group "Group parameters"
in
let form_metadata =
let value = string_of_metadata se.se_metadata in
make_form
(Eliom_service.preapply election_setup_metadata uuid)
value "Election metadata"
in
let div_questions =
div
[h2 [pcdata "Questions"];
a
~service:election_setup_questions
[pcdata "Manage questions"]
uuid]
in
let form_trustees =
post_form
~service:election_setup_trustee_add
(fun () ->
[div
[h2 [pcdata "Trustees"];
ol
(List.rev_map
(fun (token, pk) ->
li
[a ~service:election_setup_trustee [pcdata token] token]
) se.se_public_keys
);
string_input ~input_type:`Submit ~value:"Add" ()]]) uuid
in
let div_credentials =
div
[h2 [pcdata "Credentials"];
a
~service:election_setup_credentials
[pcdata "Manage credentials"]
se.se_public_creds]
in
let form_create =
post_form
~service:election_setup_create
(fun () ->
[div
[h2 [pcdata "Finalize creation"];
string_input ~input_type:`Submit ~value:"Create election" ()]]
) uuid
let choose () =
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 = [
form_trustees;
div_credentials;
form_group;
form_metadata;
div_questions;
form_create;
div [p (
[pcdata "Please log in: ["] @ auth_systems @ [pcdata "]"]
)]
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
lwt login_box = login_box () in
base ~title:"Log in" ~login_box ~content ()
let election_setup_questions uuid se () =
let title = "Questions for election " ^ Uuidm.to_string uuid in
let form =
let value = string_of_template se.se_questions in
post_form
~service:election_setup_questions_post
(fun name ->
[
div [pcdata "Questions:"];
div [textarea ~a:[a_id "questions"; a_rows 5; a_cols 80] ~name ~value ()];
div [string_input ~input_type:`Submit ~value:"Submit" ()]])
uuid
in
let link =
let service = Web_services.election_setup in
div [a ~service [pcdata "Go back to election preparation"] uuid]
in
let interactivity =
div
~a:[a_id "interactivity"]
[
script ~a:[a_src (uri_of_string (fun () -> "../static/sjcl.js"))] (pcdata "");
script ~a:[a_src (uri_of_string (fun () -> "../static/jsbn.js"))] (pcdata "");
script ~a:[a_src (uri_of_string (fun () -> "../static/jsbn2.js"))] (pcdata "");
script ~a:[a_src (uri_of_string (fun () -> "../static/random.js"))] (pcdata "");
script ~a:[a_src (uri_of_string (fun () -> "../static/tool_js_questions.js"))] (pcdata "");
]
in
let content = [
interactivity;
form;
link;
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
end
let election_setup_credentials token uuid se () =
let title = "Credentials for election " ^ uuid in
let form_textarea =
post_form
~service:election_setup_credentials_post
(fun name ->
[div
[div [pcdata "Public credentials:"];
div [textarea ~a:[a_id "pks"; a_rows 5; a_cols 40] ~name ()];
div [string_input ~input_type:`Submit ~value:"Submit" ()]]])
token
in
let disclaimer =
p
[
b [pcdata "Note:"];
pcdata " submitting a large (> 200) number of credentials using the above form may fail; in this case, you have to use the command-line tool and the form below.";
]
in
let form_file =
post_form
~service:election_setup_credentials_post_file
(fun name ->
[div
[h2 [pcdata "Submit by file"];
div [pcdata "Use this form to upload public credentials generated with the command-line tool."];
div [file_input ~name ()];
div [string_input ~input_type:`Submit ~value:"Submit" ()]]])
token
in
let div_download =
p [a ~service:election_setup_credentials_download
[pcdata "Download current file"]
token]
in
let group =
let name : 'a Eliom_parameter.param_name = Obj.magic "group" in
let value = se.se_group in
div
~a:[a_style "display:none;"]