Commit f9a1b939 authored by Stephane Glondu's avatar Stephane Glondu

Better handling of auth systems

parent e486af9f
......@@ -111,3 +111,8 @@ module String = struct
let xn = String.length x and sn = String.length s in
xn >= sn && String.sub x 0 sn = s
end
let rec list_join sep = function
| [] -> []
| [x] -> [x]
| x :: xs -> x :: sep :: list_join sep xs
......@@ -26,3 +26,5 @@ module String : sig
val map : (char -> char) -> string -> string
val startswith : string -> string -> bool
end
val list_join : 'a -> 'a list -> 'a list
......@@ -2,9 +2,15 @@ open Lwt
open Util
open Serializable_t
type user_type = Dummy | CAS
let string_of_user_type = function
| Dummy -> "dummy"
| CAS -> "cas"
type user = {
user_name : string;
user_type : string;
user_type : user_type;
}
type acl =
......@@ -94,7 +100,7 @@ let load_elections_and_votes dirname =
election;
public_keys;
election_result;
author = { user_name = "admin"; user_type = "dummy" };
author = { user_name = "admin"; user_type = Dummy };
featured_p = true;
can_read = Any;
can_vote = Any;
......
open Serializable_t
type user_type = Dummy | CAS
val string_of_user_type : user_type -> string
type user = {
user_name : string;
user_type : string;
user_type : user_type;
}
type acl =
......
......@@ -89,17 +89,16 @@ let () = Eliom_registration.Html5.register
Templates.index ~featured)
let () = Eliom_registration.Html5.register
~service:Services.login
~service:Services.login_dummy
(fun () () ->
(* FIXME *)
let service = Services.perform_login () in
let service = Services.create_dummy_login () in
let () = Eliom_registration.Redirection.register
~service
~scope:Eliom_common.default_session_scope
(fun () user_name ->
let user_type = "dummy" in
Eliom_reference.set Services.user
Common.(Some {user_name; user_type}) >>
let open Common in
let user_type = Dummy in
Eliom_reference.set Services.user (Some {user_name; user_type}) >>
Services.get ())
in
Templates.dummy_login ~service)
......@@ -133,10 +132,11 @@ let () = Eliom_registration.Redirection.register
| "yes" ->
(match next_lf info (i+1) with
| Some j ->
let open Common in
let user_name = String.sub info (i+1) (j-i-1) in
let user_type = "cas" in
let user_type = CAS in
Eliom_reference.set Services.user
Common.(Some {user_name; user_type}) >>
(Some {user_name; user_type}) >>
Services.get ()
| None -> fail_http 502
)
......@@ -159,7 +159,7 @@ let () = Eliom_registration.Redirection.register
lwt user = Eliom_reference.get Services.user in
Eliom_reference.set Services.user None >>
match user with
| Some user when user.Common.user_type = "cas" ->
| Some user when user.Common.user_type = Common.CAS ->
lwt service = Services.get () in
let uri = Eliom_uri.make_string_uri ~absolute:true ~service () in
return (Eliom_service.preapply Services.cas_logout uri)
......
......@@ -8,8 +8,8 @@ let home = service
~get_params:unit
()
let login = service
~path:["login"]
let login_dummy = service
~path:["login-dummy"]
~get_params:unit
()
......@@ -43,16 +43,17 @@ let logout = service
~get_params:unit
()
let perform_login () =
let create_dummy_login () =
Eliom_service.post_coservice
~csrf_safe:true
~csrf_scope:Eliom_common.default_session_scope
~fallback:login
~fallback:login_dummy
~post_params:Eliom_parameter.(string "username")
()
let auth_systems = [
"dummy";
"dummy", login_dummy;
"CAS", Eliom_service.preapply login_cas None;
]
let user = Eliom_reference.eref
......
......@@ -9,7 +9,8 @@ let welcome_message = "Welcome!"
let format_user u =
let open Common in
Printf.ksprintf pcdata "%s:%s" u.user_type u.user_name
let t = string_of_user_type u.user_type in
Printf.ksprintf pcdata "%s:%s" t u.user_name
let base ~title ~content =
lwt user = Eliom_reference.get Services.user in
......@@ -40,13 +41,14 @@ let base ~title ~content =
div [
pcdata "Not logged in.";
];
div [
pcdata "Login: ";
a ~service:Services.login [pcdata "dummy"] ();
pcdata ", ";
a ~service:Services.login_cas [pcdata "CAS"] None;
pcdata ".";
];
let auth_systems = List.map (fun (name, service) ->
a ~service [pcdata name] ()
) Services.auth_systems in
div (
[ pcdata "Login: " ] @
list_join (pcdata ", ") auth_systems @
[ pcdata "." ]
);
]
);
];
......@@ -158,8 +160,7 @@ let election_view ~election ~user =
match user with
| None ->
Lwt.return [
a ~service:Services.login [pcdata "Log in"] ();
pcdata " to check if you can vote.";
pcdata "Log in to check if you can vote.";
]
| Some u ->
lwt b = p u 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