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

Change of topology in Auth_common

We want to be able to share private variables between service
definition time and registration time, so we put both as submodules of
the Make functor.
parent e916ccc6
......@@ -43,20 +43,6 @@ let user = Eliom_reference.eref
(* TODO: make the authentication system more flexible *)
module Make (X : EMPTY) = struct
let login = Eliom_service.service
~path:["login"]
~get_params:Eliom_parameter.(opt (string "service"))
()
let logout = Eliom_service.service
~path:["logout"]
~get_params:Eliom_parameter.unit
()
end
let auth_system_map = ref []
let register_auth_system name service =
......@@ -71,33 +57,53 @@ let get_default_auth_system () =
| [] -> fail_http 404
| (name, _) :: _ -> Lwt.return name
module Register (S : ALL_SERVICES) = struct
let () = Eliom_registration.Redirection.register ~service:S.login
(fun service () ->
lwt x = match service with
| None -> get_default_auth_system ()
| Some x -> Lwt.return x
in
try
let auth_system = List.assoc x !auth_system_map in
let module A = (val auth_system : AUTH_SYSTEM) in
Lwt.return A.service
with Not_found -> fail_http 404
)
let () = Eliom_registration.Redirection.register ~service:S.logout
(fun () () ->
lwt u = Eliom_reference.get user in
(* should ballot be unset here or not? *)
Eliom_reference.unset user >>
match u with
| Some u ->
let module L = (val u.user_logout) in
security_log (fun () ->
string_of_user u.user_user ^ " logged out"
) >> L.cont ()
| _ -> S.get ()
)
module Make (X : EMPTY) = struct
module Services : AUTH_SERVICES = struct
let login = Eliom_service.service
~path:["login"]
~get_params:Eliom_parameter.(opt (string "service"))
()
let logout = Eliom_service.service
~path:["logout"]
~get_params:Eliom_parameter.unit
()
end
module Register (C : CONT_SERVICE) : EMPTY = struct
let () = Eliom_registration.Redirection.register
~service:Services.login
(fun service () ->
lwt x = match service with
| None -> get_default_auth_system ()
| Some x -> Lwt.return x
in
try
let auth_system = List.assoc x !auth_system_map in
let module A = (val auth_system : AUTH_SYSTEM) in
Lwt.return A.service
with Not_found -> fail_http 404
)
let () = Eliom_registration.Redirection.register
~service:Services.logout
(fun () () ->
lwt u = Eliom_reference.get user in
(* should ballot be unset here or not? *)
Eliom_reference.unset user >>
match u with
| Some u ->
let module L = (val u.user_logout) in
security_log (fun () ->
string_of_user u.user_user ^ " logged out"
) >> L.cont ()
| _ -> C.cont ()
)
end
end
......@@ -38,5 +38,7 @@ val user : logged_user option Eliom_reference.eref
val get_auth_systems : unit -> string list
val register_auth_system : string -> (module AUTH_SYSTEM) -> unit
module Make (X : EMPTY) : AUTH_SERVICES
module Register (S : ALL_SERVICES) : EMPTY
module Make (X : EMPTY) : sig
module Services : AUTH_SERVICES
module Register (S : CONT_SERVICE) : EMPTY
end
......@@ -255,6 +255,8 @@ let if_eligible acl f uuid x =
lwt b = check_acl acl election.Web_election.election_web user in
if b then f uuid election user x else forbidden ()
module A = Auth_common.Make (struct end)
module S = struct
open Eliom_service
open Eliom_parameter
......@@ -339,9 +341,11 @@ module S = struct
let set s =
Eliom_reference.set saved_service s
include Auth_common.Make (struct end)
include A.Services
end
let () = let module X = A.Register (struct let cont = S.get end) in ()
module T = Templates.Make (S)
module C = struct
......@@ -352,8 +356,6 @@ module C = struct
let rewrite_prefix = rewrite_prefix
end
module A = Auth_common.Register (S)
let () =
if C.enable_dummy then let module X = Auth_dummy.Register (S) (T) 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