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

Auth_password: wait for upload of db when used in an election

When the login service is used for the first time, it asks for a
password database. For now, it is the administrator's responsibility
to do it before advertising the election.
parent de419e26
......@@ -40,6 +40,17 @@ module type CONFIG = sig
val db : string
end
let load_db name file =
(* FIXME: not cooperative *)
List.fold_left (fun accu line ->
match line with
| username :: salt :: password :: _ ->
SMap.add username (salt, password) accu
| _ -> failwith ("error while parsing db file for " ^ name)
) SMap.empty (Csv.load file)
let ( / ) = Filename.concat
module Make (C : CONFIG) (N : NAME) (T : LOGIN_TEMPLATES) : AUTH_HANDLERS = struct
let scope = Eliom_common.default_session_scope
......@@ -50,41 +61,80 @@ module Make (C : CONFIG) (N : NAME) (T : LOGIN_TEMPLATES) : AUTH_HANDLERS = stru
()
let db =
List.fold_left (fun accu line ->
match line with
| username :: salt :: password :: _ ->
SMap.add username (salt, password) accu
| _ -> failwith ("error while parsing db file for " ^ N.name)
) SMap.empty (Csv.load C.db)
ref @@ match N.kind with
| `Site -> `Production (load_db N.name C.db)
| `Election dir ->
(* hash the user-input name to avoid all kinds of injection *)
let fname = dir / sha256_hex C.db in
try
`Production (load_db N.name fname)
with _ ->
(* Maybe we should filter the kind of error...? *)
`Bootstrap fname
let login_cont = Eliom_reference.eref ~scope None
let production_service_handler db =
let post_params = Eliom_parameter.(
string "username" ** string "password"
) in
let service = Eliom_service.post_coservice
~csrf_safe:true
~csrf_scope:scope
~fallback:service
~post_params ()
in
let () = Eliom_registration.Any.register ~service ~scope
(fun () (user_name, password) ->
if (
try
let salt, hashed = SMap.find user_name db in
sha256_hex (salt ^ password) = hashed
with Not_found -> false
) then (
match_lwt Eliom_reference.get login_cont with
| Some cont ->
Eliom_reference.unset login_cont >>
cont user_name ()
| None -> fail_http 400
) else forbidden ())
in
T.password ~service ()
let bootstrap_service_handler () =
let post_params = Eliom_parameter.file "password_db" in
let upload_service = Eliom_service.post_coservice
~csrf_safe:true
~csrf_scope:scope
~fallback:service
~post_params ()
in
let () = Eliom_registration.Any.register ~service:upload_service ~scope
(fun () password_db ->
match !db with
| `Bootstrap db_fname ->
let fname = password_db.Ocsigen_extensions.tmp_filename in
let the_db = load_db N.name fname in
(* loading was successful, we copy the file for future reference *)
lwt () =
Lwt_io.(with_file Output db_fname (fun oc ->
with_file Input fname (fun ic ->
read_chars ic |> write_chars oc
)
))
in
db := `Production the_db;
Eliom_registration.Redirection.send service
| `Production _ -> forbidden ()
)
in
T.upload_password_db ~service:upload_service ()
let () = Eliom_registration.Html5.register ~service
(fun () () ->
let post_params = Eliom_parameter.(
string "username" ** string "password"
) in
let service = Eliom_service.post_coservice
~csrf_safe:true
~csrf_scope:scope
~fallback:service
~post_params ()
in
let () = Eliom_registration.Any.register ~service ~scope
(fun () (user_name, password) ->
if (
try
let salt, hashed = SMap.find user_name db in
sha256_hex (salt ^ password) = hashed
with Not_found -> false
) then (
match_lwt Eliom_reference.get login_cont with
| Some cont ->
Eliom_reference.unset login_cont >>
cont user_name ()
| None -> fail_http 400
) else forbidden ())
in T.password ~service ()
match !db with
| `Bootstrap _ -> bootstrap_service_handler ()
| `Production db -> production_service_handler db
)
let login cont () =
......
......@@ -312,6 +312,15 @@ module type LOGIN_TEMPLATES = sig
Eliom_service.service ->
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val upload_password_db :
service:(unit, 'a, [< Eliom_service.post_service_kind ],
[< Eliom_service.suff ], 'b,
[< Eliom_lib.file_info Eliom_parameter.setoneradio ]
Eliom_parameter.param_name,
[< Eliom_service.registrable ], 'c)
Eliom_service.service ->
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val choose :
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
......
......@@ -216,6 +216,26 @@ module Make (S : SITE_SERVICES) : TEMPLATES = struct
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 = [
h1 [pcdata title];
div [form];
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content
let choose () =
let auth_systems =
S.get_auth_systems () |>
......
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