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

Generic login page when there are several auth instances

parent f7ae03af
...@@ -19,6 +19,7 @@ ...@@ -19,6 +19,7 @@
(* <http://www.gnu.org/licenses/>. *) (* <http://www.gnu.org/licenses/>. *)
(**************************************************************************) (**************************************************************************)
open Lwt
open Util open Util
open Web_signatures open Web_signatures
open Web_common open Web_common
...@@ -90,24 +91,22 @@ module Make (X : EMPTY) = struct ...@@ -90,24 +91,22 @@ module Make (X : EMPTY) = struct
let () = List.iter (fun f -> f ~instantiate) !config_exec let () = List.iter (fun f -> f ~instantiate) !config_exec
let default_auth_system = lazy (
match !auth_systems with
| [name] -> name
| _ -> failwith "several (or no) instances of auth systems"
)
let () = Eliom_registration.Any.register let () = Eliom_registration.Any.register
~service:Services.login ~service:Services.login
(fun service () -> (fun service () ->
lwt x = match service with let use name =
| None -> Lwt.return (Lazy.force default_auth_system)
| Some x -> Lwt.return x
in
try try
let i = Hashtbl.find instances x in let i = Hashtbl.find instances name in
let module A = (val i : AUTH_INSTANCE) in let module A = (val i : AUTH_INSTANCE) in
A.handler () A.handler ()
with Not_found -> fail_http 404 with Not_found -> fail_http 404
in
match service with
| Some name -> use name
| None ->
match !auth_systems with
| [name] -> use name
| _ -> T.generic_login () >>= Eliom_registration.Html5.send
) )
let () = Eliom_registration.Redirection.register let () = Eliom_registration.Redirection.register
......
...@@ -167,6 +167,13 @@ let password_login ~service = ...@@ -167,6 +167,13 @@ let password_login ~service =
] in ] in
base ~title:"Password login" ~content base ~title:"Password login" ~content
let generic_login () =
let content = [
h1 [pcdata "Log in"];
div [p [pcdata "Please choose one authentication system."]];
] in
base ~title:"Log in" ~content
let format_date (date, _) = let format_date (date, _) =
CalendarLib.Printer.Precise_Fcalendar.sprint "%a, %d %b %Y %T %z" date CalendarLib.Printer.Precise_Fcalendar.sprint "%a, %d %b %Y %T %z" date
......
...@@ -167,6 +167,9 @@ module type TEMPLATES = sig ...@@ -167,6 +167,9 @@ module type TEMPLATES = sig
Eliom_service.service -> Eliom_service.service ->
[> `Html ] Eliom_content.Html5.F.elt Lwt.t [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val generic_login :
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
end 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