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

Add login dispatch service

Currently, it takes the auth_system name as an optional parameter, and
redirects to the existing services. This revision should have the same
behaviour as the previous one, except for login links and the
associated additional redirections.

Summary:
 - Auth_common.Make is now split in two functors: one for declaring
   services (Make) and one for registering them (Register)
 - auth_systems moved to its own signature
 - login and logout are in their own signature
 - new signature ALL_SERVICES
parent 07dbc36d
......@@ -40,11 +40,6 @@ let user = Eliom_reference.eref
~scope:Eliom_common.default_session_scope
None
let logout = Eliom_service.service
~path:["logout"]
~get_params:Eliom_parameter.unit
()
let create_string_login ~fallback ~post_params =
Eliom_service.post_coservice
~csrf_safe:true
......@@ -53,7 +48,21 @@ let create_string_login ~fallback ~post_params =
(* TODO: make the authentication system more flexible *)
module Make (C : AUTH_CONFIG) (S : MAIN_SERVICES) (T : TEMPLATES) = struct
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
module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) (T : TEMPLATES) = struct
let login_dummy = Eliom_service.service
~path:["login-dummy"]
......@@ -99,11 +108,9 @@ module Make (C : AUTH_CONFIG) (S : MAIN_SERVICES) (T : TEMPLATES) = struct
else Eliom_service.preapply login_cas None
let auth_systems =
(if C.enable_cas then [
"CAS", Eliom_service.preapply login_cas None
] else []) @
(if C.password_db <> None then ["password", login_password] else []) @
(if C.enable_dummy then ["dummy", login_dummy] else [])
(if C.enable_cas then ["CAS", "cas"] else []) @
(if C.password_db <> None then ["password", "password"] else []) @
(if C.enable_dummy then ["dummy", "dummy"] else [])
let () = Eliom_registration.Html5.register
~service:login_dummy
......@@ -242,8 +249,17 @@ module Make (C : AUTH_CONFIG) (S : MAIN_SERVICES) (T : TEMPLATES) = struct
Lwt.return (Eliom_service.preapply cas_login uri)
)
let () = Eliom_registration.Redirection.register
~service:logout
let () = Eliom_registration.Redirection.register ~service:S.login
(fun service () ->
match service with
| None -> Lwt.return login_default
| Some "dummy" -> Lwt.return login_dummy
| Some "cas" -> Lwt.return (Eliom_service.preapply login_cas None)
| Some "password" -> Lwt.return login_password
| _ -> 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? *)
......
......@@ -32,15 +32,7 @@ type logged_user = {
val string_of_user : user -> string
val user : logged_user option Eliom_reference.eref
val logout :
(unit, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ], unit, unit,
[< Eliom_service.registrable > `Registrable ], 'a)
Eliom_service.service
open Web_signatures
module Make (C : AUTH_CONFIG) (S : MAIN_SERVICES) (T : TEMPLATES) : AUTH_SERVICES
module Make (X : EMPTY) : AUTH_SERVICES
module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) (T : TEMPLATES) : AUTH_SYSTEMS
......@@ -345,11 +345,13 @@ module S = struct
let set s =
Eliom_reference.set saved_service s
include Auth_common.Make (struct end)
end
module T = Templates.Make (S)
module A = Auth_common.Make (struct
module A = Auth_common.Register (struct
let enable_cas = !enable_cas
let cas_server = !cas_server
let password_db = password_db
......@@ -572,7 +574,7 @@ let () = Eliom_registration.Redirection.register
Eliom_reference.set Services.saved_service (Services.Cast uuid) >>
Eliom_reference.set Services.ballot (Some ballot) >>
match user with
| None -> return A.login_default
| None -> return (Eliom_service.preapply S.login None)
| Some u -> S.get ()
)
)
......
......@@ -32,7 +32,7 @@ let welcome_message = "Welcome!"
let format_user u =
em [pcdata (Auth_common.(string_of_user u.user_user))]
module Make (S : Web_signatures.MAIN_SERVICES) = struct
module Make (S : Web_signatures.ALL_SERVICES) = struct
let base ~auth_systems ~title ~content =
lwt user = Eliom_reference.get Auth_common.user in
......@@ -54,7 +54,7 @@ let base ~auth_systems ~title ~content =
pcdata ".";
];
div [
a ~service:Auth_common.logout [pcdata "Log out"] ();
a ~service:S.logout [pcdata "Log out"] ();
pcdata ".";
];
]
......@@ -64,6 +64,7 @@ let base ~auth_systems ~title ~content =
pcdata "Not logged in.";
];
let auth_systems = List.map (fun (name, service) ->
let service = Eliom_service.preapply S.login (Some service) in
a ~service [pcdata name] ()
) auth_systems in
div (
......
......@@ -19,6 +19,8 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
module type EMPTY = sig end
module type MAIN_SERVICES = sig
val home :
......@@ -129,23 +131,31 @@ end
module type AUTH_SERVICES = sig
val login_default :
val login :
(string option, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ],
[ `One of string ] Eliom_parameter.param_name, unit,
[< Eliom_service.registrable > `Registrable ], 'a)
Eliom_service.service
val logout :
(unit, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ], unit, unit, Eliom_service.registrable, 'a)
[ `WithoutSuffix ], unit, unit,
[< Eliom_service.registrable > `Registrable ], 'a)
Eliom_service.service
val auth_systems :
(string *
(unit, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ], unit, unit, Eliom_service.registrable, 'a)
Eliom_service.service)
list
end
module type AUTH_SYSTEMS = sig
val auth_systems : (string * string) list
end
......@@ -160,12 +170,7 @@ module type TEMPLATES = sig
Eliom_parameter.param_name,
[< Eliom_service.registrable ], 'c)
Eliom_service.service ->
auth_systems:(string *
(unit, unit, [< Eliom_service.get_service_kind ],
[< Eliom_service.suff ], 'd, unit,
[< Eliom_service.registrable ], 'e)
Eliom_service.service)
list ->
auth_systems:(string * string) list ->
[> `Html ] Eliom_content.Html5.F.elt Lwt.t
val password_login :
......@@ -177,12 +182,13 @@ module type TEMPLATES = sig
Eliom_parameter.param_name,
[< Eliom_service.registrable ], 'c)
Eliom_service.service ->
auth_systems:(string *
(unit, unit, [< Eliom_service.get_service_kind ],
[< Eliom_service.suff ], 'd, unit,
[< Eliom_service.registrable ], 'e)
Eliom_service.service)
list ->
auth_systems:(string * string) list ->
[> `Html ] Eliom_content.Html5.F.elt Lwt.t
end
module type ALL_SERVICES = sig
include MAIN_SERVICES
include AUTH_SERVICES
end
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