Commit 3ae20596 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Drop AUTH_SERVICES argument of Web_auth.Make.configure

parent 001ab016
......@@ -73,7 +73,40 @@ module Make (N : NAME) = struct
(* Forward reference, will be set to eponymous template *)
let login_choose = ref (fun () -> assert false)
let configure auth_services xs =
let user = Eliom_reference.eref ~scope None
let do_login_using user_domain cont =
try
let user_handlers = Hashtbl.find auth_instances user_domain in
let cont user_name () =
let user_user = {user_domain; user_name} in
let logged_user = {user_user; user_handlers} in
security_log (fun () ->
Printf.sprintf "[%s] %s logged in"
N.name (string_of_user user_user)
) >>
Eliom_reference.set user (Some logged_user) >>
cont () ()
in
let module A = (val user_handlers : AUTH_HANDLERS) in
A.login cont ()
with Not_found -> fail_http 404
module Services : AUTH_SERVICES = struct
let auth_realm = N.name
let get_auth_systems () = !auth_instance_names
let get_user () =
match_lwt Eliom_reference.get user with
| Some u -> return (Some u.user_user)
| None -> return None
end
let configure xs =
let auth_services = (module Services : AUTH_SERVICES) in
login_choose := Web_templates.choose auth_services links;
List.iter
(fun auth_instance ->
......@@ -105,46 +138,13 @@ module Make (N : NAME) = struct
let path = N.path @ ["auth"; instance]
let kind = N.kind
end in
let module S = (val auth_services : AUTH_SERVICES) in
let module A = (val auth : AUTH_SERVICE) (N) (S) in
let module A = (val auth : AUTH_SERVICE) (N) (Services) in
let i = (module A : AUTH_HANDLERS) in
Hashtbl.add auth_instances instance i;
auth_instance_names := instance :: !auth_instance_names
)
) xs
let user = Eliom_reference.eref ~scope None
let do_login_using user_domain cont =
try
let user_handlers = Hashtbl.find auth_instances user_domain in
let cont user_name () =
let user_user = {user_domain; user_name} in
let logged_user = {user_user; user_handlers} in
security_log (fun () ->
Printf.sprintf "[%s] %s logged in"
N.name (string_of_user user_user)
) >>
Eliom_reference.set user (Some logged_user) >>
cont () ()
in
let module A = (val user_handlers : AUTH_HANDLERS) in
A.login cont ()
with Not_found -> fail_http 404
module Services : AUTH_SERVICES = struct
let auth_realm = N.name
let get_auth_systems () = !auth_instance_names
let get_user () =
match_lwt Eliom_reference.get user with
| Some u -> return (Some u.user_user)
| None -> return None
end
let login_handler service cont =
let cont () () =
match service with
......
......@@ -29,7 +29,7 @@ val register_auth_system : (module AUTH_SYSTEM) -> unit
module MakeLinks (N : NAME) : AUTH_LINKS
module Make (C : NAME) : sig
val configure : (module AUTH_SERVICES) -> auth_config list -> unit
val configure : auth_config list -> unit
module Services : AUTH_SERVICES
module Handlers : AUTH_HANDLERS_PUBLIC
end
......@@ -278,7 +278,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
open Eliom_registration
let () =
Auth.configure (module W.S : AUTH_SERVICES) N.auth_config
Auth.configure N.auth_config
let login service () =
lwt cont = Eliom_reference.get Web_services.cont in
......
......@@ -225,7 +225,7 @@ lwt () =
) election_ptable
let install_authentication auth_configs =
Web_site_auth.configure (module Web_site_auth : AUTH_SERVICES) auth_configs
Web_site_auth.configure auth_configs
let () = Any.register ~service:home
(fun () () ->
......
open Web_serializable_t
open Web_signatures
val configure : (module AUTH_SERVICES) -> auth_config list -> unit
val configure : auth_config list -> unit
include AUTH_SERVICES
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