Commit 4d614457 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Make the user reference private

parent a664c007
......@@ -33,9 +33,6 @@ end
module Make (C : CONFIG) (N : NAME) (S : CONT_SERVICE) (T : TEMPLATES) : AUTH_INSTANCE = struct
let user_admin = false
let user_type = N.name
let cas_login = Eliom_service.external_service
~prefix:C.server
~path:["login"]
......@@ -61,6 +58,10 @@ module Make (C : CONFIG) (N : NAME) (S : CONT_SERVICE) (T : TEMPLATES) : AUTH_IN
let service = Eliom_service.preapply login_cas None
let on_success_ref = Eliom_reference.eref
~scope:Eliom_common.default_session_scope
(fun ~user_name ~user_logout -> Lwt.return ())
let () = Eliom_registration.Redirection.register
~service:login_cas
(fun ticket () ->
......@@ -86,20 +87,19 @@ module Make (C : CONFIG) (N : NAME) (S : CONT_SERVICE) (T : TEMPLATES) : AUTH_IN
(match next_lf info (i+1) with
| Some j ->
let user_name = String.sub info (i+1) (j-i-1) in
let user_user = {user_type; user_name} in
let module L : CONT_SERVICE = struct
let cont () =
lwt service = S.cont () in
let uri = Eliom_uri.make_string_uri ~absolute:true ~service () in
let uri = rewrite_prefix uri in
security_log (fun () ->
Printf.sprintf "%s logged out, redirecting to CAS [%s]"
(string_of_user user_user) C.server
Printf.sprintf "%s:%s logged out, redirecting to CAS [%s]"
N.name user_name C.server
) >> Lwt.return (Eliom_service.preapply cas_logout uri)
end in
let user_logout = (module L : CONT_SERVICE) in
Eliom_reference.set user
(Some {user_admin; user_user; user_logout}) >>
lwt on_success = Eliom_reference.get on_success_ref in
on_success ~user_name ~user_logout >>
S.cont ()
| None -> fail_http 502
)
......@@ -116,7 +116,9 @@ module Make (C : CONFIG) (N : NAME) (S : CONT_SERVICE) (T : TEMPLATES) : AUTH_IN
Lwt.return (Eliom_service.preapply cas_login uri)
)
let handler () = Eliom_registration.Redirection.send service
let handler ~on_success () =
Eliom_reference.set on_success_ref on_success >>
Eliom_registration.Redirection.send service
end
......
......@@ -24,24 +24,9 @@ open Util
open Web_signatures
open Web_common
type user = {
user_type : string;
user_name : string;
}
type logged_user = {
user_admin : bool;
user_user : user;
user_logout : (module CONT_SERVICE);
}
let string_of_user {user_type; user_name} =
user_type ^ ":" ^ user_name
let user = Eliom_reference.eref
~scope:Eliom_common.default_session_scope
None
type instantiator = string -> (module AUTH_SERVICE) -> unit
let config_spec = ref []
......@@ -60,10 +45,21 @@ module Make (X : EMPTY) = struct
let instances = Hashtbl.create 10
let auth_systems = ref []
let user = Eliom_reference.eref
~scope:Eliom_common.default_session_scope
None
let on_success user_admin user_type ~user_name ~user_logout =
let user_user = {user_type; user_name} in
let logged_user = {user_admin; user_user; user_logout} in
Eliom_reference.set user (Some logged_user)
module Services : AUTH_SERVICES = struct
let get_auth_systems () = !auth_systems
let get_logged_user () = Eliom_reference.get user
let login = Eliom_service.service
~path:["login"]
~get_params:Eliom_parameter.(opt (string "service"))
......@@ -98,7 +94,7 @@ module Make (X : EMPTY) = struct
try
let i = Hashtbl.find instances name in
let module A = (val i : AUTH_INSTANCE) in
A.handler ()
A.handler ~on_success:(on_success false name) ()
with Not_found -> fail_http 404
in
match service with
......
......@@ -21,19 +21,7 @@
open Web_signatures
type user = {
user_type : string;
user_name : string;
}
type logged_user = {
user_admin : bool;
user_user : user;
user_logout : (module CONT_SERVICE);
}
val string_of_user : user -> string
val user : logged_user option Eliom_reference.eref
type instantiator = string -> (module AUTH_SERVICE) -> unit
......
......@@ -24,9 +24,6 @@ open Auth_common
module Make (N : NAME) (S : CONT_SERVICE) (T : TEMPLATES) : AUTH_INSTANCE = struct
let user_admin = false
let user_type = N.name
let service = Eliom_service.service
~path:["auth"; N.name]
~get_params:Eliom_parameter.unit
......@@ -34,6 +31,10 @@ module Make (N : NAME) (S : CONT_SERVICE) (T : TEMPLATES) : AUTH_INSTANCE = stru
let user_logout = (module S : CONT_SERVICE)
let on_success_ref = Eliom_reference.eref
~scope:Eliom_common.default_session_scope
(fun ~user_name ~user_logout -> Lwt.return ())
let () = Eliom_registration.Html5.register ~service
(fun () () ->
let post_params = Eliom_parameter.(string "username") in
......@@ -46,14 +47,15 @@ module Make (N : NAME) (S : CONT_SERVICE) (T : TEMPLATES) : AUTH_INSTANCE = stru
let () = Eliom_registration.Redirection.register ~service
~scope:Eliom_common.default_session_scope
(fun () user_name ->
let user_user = {user_type; user_name} in
let logged_user = {user_admin; user_user; user_logout} in
Eliom_reference.set user (Some logged_user) >>
lwt on_success = Eliom_reference.get on_success_ref in
on_success ~user_name ~user_logout >>
S.cont ())
in T.string_login ~service ~kind:`Dummy
)
let handler () = Eliom_registration.Redirection.send service
let handler ~on_success () =
Eliom_reference.set on_success_ref on_success >>
Eliom_registration.Redirection.send service
end
......
......@@ -30,9 +30,6 @@ end
module Make (C : CONFIG) (N : NAME) (S : CONT_SERVICE) (T : TEMPLATES) : AUTH_INSTANCE = struct
let user_admin = false
let user_type = N.name
let service = Eliom_service.service
~path:["auth"; N.name]
~get_params:Eliom_parameter.unit
......@@ -48,6 +45,10 @@ module Make (C : CONFIG) (N : NAME) (S : CONT_SERVICE) (T : TEMPLATES) : AUTH_IN
let user_logout = (module S : CONT_SERVICE)
let on_success_ref = Eliom_reference.eref
~scope:Eliom_common.default_session_scope
(fun ~user_name ~user_logout -> Lwt.return ())
let () = Eliom_registration.Html5.register ~service
(fun () () ->
let post_params = Eliom_parameter.(
......@@ -68,14 +69,16 @@ module Make (C : CONFIG) (N : NAME) (S : CONT_SERVICE) (T : TEMPLATES) : AUTH_IN
sha256_hex (salt ^ password) = hashed
with Not_found -> false
) then (
let user_user = {user_type; user_name} in
Eliom_reference.set user (Some {user_admin; user_user; user_logout}) >>
lwt on_success = Eliom_reference.get on_success_ref in
on_success ~user_name ~user_logout >>
S.cont ()
) else forbidden ())
in T.password_login ~service
)
let handler () = Eliom_registration.Redirection.send service
let handler ~on_success () =
Eliom_reference.set on_success_ref on_success >>
Eliom_registration.Redirection.send service
end
......
......@@ -214,15 +214,9 @@ let check_acl acl election user =
| Any -> return true
| Restricted p ->
match user with
| Some user -> p user.Auth_common.user_user
| Some user -> p user.Web_signatures.user_user
| None -> return false
let if_eligible acl f uuid x =
lwt election = get_election_by_uuid uuid in
lwt user = Eliom_reference.get Auth_common.user in
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
......@@ -309,6 +303,12 @@ end
module T = Templates.Make (S)
let if_eligible acl f uuid x =
lwt election = get_election_by_uuid uuid in
lwt user = S.get_logged_user () in
lwt b = check_acl acl election.Web_election.election_web user in
if b then f uuid election user x else forbidden ()
let () =
let module S = struct let cont = S.get end in
let module X : EMPTY = A.Register (S) (T) in
......@@ -339,7 +339,7 @@ let () = Eliom_registration.File.register
(fun () () -> match !source_file with
| None -> fail_http 404
| Some f ->
match_lwt Eliom_reference.get Auth_common.user with
match_lwt S.get_logged_user () with
| Some u ->
security_log (fun () ->
Auth_common.(string_of_user u.user_user) ^ " downloaded source code"
......@@ -381,7 +381,7 @@ let f_ballots uuid election user () =
let f_records uuid election user () =
match user with
| Some u when u.Auth_common.user_admin ->
| Some u when u.Web_signatures.user_admin ->
let open Web_election in
let module X = (val election.modules : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t) in
(* TODO: streaming *)
......@@ -462,12 +462,12 @@ let do_cast election uuid () =
Eliom_reference.unset Services.ballot >>
let open Web_election in
let module X = (val election.modules : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t) in
match_lwt Eliom_reference.get Auth_common.user with
match_lwt S.get_logged_user () with
| Some user as u ->
lwt b = check_acl can_vote election.election_web u in
if b then (
let record =
Auth_common.string_of_user user.Auth_common.user_user,
Auth_common.string_of_user user.Web_signatures.user_user,
(CalendarLib.Fcalendar.Precise.now (), None)
in
lwt result =
......@@ -531,9 +531,9 @@ let () = Eliom_registration.Redirection.register
let () = Eliom_registration.Html5.register
~service:Services.election_update_credential_form
(fun uuid () ->
lwt user = Eliom_reference.get Auth_common.user in
lwt user = S.get_logged_user () in
match user with
| Some u when u.Auth_common.user_admin ->
| Some u when u.Web_signatures.user_admin ->
lwt election = get_election_by_uuid uuid in
T.election_update_credential ~election
| _ -> forbidden ()
......@@ -542,9 +542,9 @@ let () = Eliom_registration.Html5.register
let () = Eliom_registration.String.register
~service:S.election_update_credential
(fun uuid (old, new_) ->
lwt user = Eliom_reference.get Auth_common.user in
lwt user = S.get_logged_user () in
match user with
| Some u when u.Auth_common.user_admin ->
| Some u when u.Web_signatures.user_admin ->
lwt election = get_election_by_uuid uuid in
let open Web_election in
let module X = (val election.modules : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t) in
......
......@@ -22,6 +22,7 @@
open Signatures
open Util
open Serializable_t
open Web_signatures
open Eliom_content.Html5.F
(* TODO: these pages should be redesigned *)
......@@ -35,7 +36,7 @@ let format_user u =
module Make (S : Web_signatures.ALL_SERVICES) = struct
let base ~title ~content =
lwt user = Eliom_reference.get Auth_common.user in
lwt user = S.get_logged_user () in
Lwt.return (html ~a:[a_dir `Ltr; a_xml_lang "en"]
(head (Eliom_content.Html5.F.title (pcdata title)) [])
(body [
......@@ -96,7 +97,6 @@ let format_one_featured_election e =
]
let index ~featured =
lwt user = Eliom_reference.get Auth_common.user in
let featured_box = match featured with
| _::_ ->
div [
......@@ -199,7 +199,7 @@ let election_view ~election ~user =
pcdata "Log in to check if you can vote. Alternatively, you can try to vote and log in at the last moment.";
]
| Some u ->
lwt b = p u.Auth_common.user_user in
lwt b = p u.user_user in
let can = if b then pcdata "can" else pcdata "cannot" in
Lwt.return [
pcdata "You ";
......
......@@ -28,7 +28,7 @@ open Web_common
type acl =
| Any
| Restricted of (Auth_common.user -> bool Lwt.t)
| Restricted of (Web_signatures.user -> bool Lwt.t)
type election_web = {
params_fname : string;
......
......@@ -24,7 +24,7 @@ open Serializable_t
type acl =
| Any
| Restricted of (Auth_common.user -> bool Lwt.t)
| Restricted of (Web_signatures.user -> bool Lwt.t)
type election_web = {
params_fname : string;
......
......@@ -117,10 +117,32 @@ module type AUTH_CONFIG = sig
val password_db : (SMap.key * SMap.key) SMap.t option
end
module type CONT_SERVICE = sig
val cont :
unit ->
(unit, unit,
[> `Attached of
([> `External | `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ], unit, unit, Eliom_service.registrable, 'a)
Eliom_service.service Lwt.t
end
type user = {
user_type : string;
user_name : string;
}
type logged_user = {
user_admin : bool;
user_user : user;
user_logout : (module CONT_SERVICE);
}
module type AUTH_SERVICES = sig
val get_auth_systems : unit -> string list
val get_logged_user : unit -> logged_user option Lwt.t
val login :
(string option, unit,
......@@ -178,26 +200,17 @@ module type ALL_SERVICES = sig
include AUTH_SERVICES
end
module type CONT_SERVICE = sig
val cont :
unit ->
(unit, unit,
[> `Attached of
([> `External | `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ], unit, unit, Eliom_service.registrable, 'a)
Eliom_service.service Lwt.t
end
module type NAME = sig
val name : string
end
type on_success_handler =
user_name:string -> user_logout:(module CONT_SERVICE) -> unit Lwt.t
module type AUTH_INSTANCE = sig
val handler :
unit ->
on_success:on_success_handler -> unit ->
(Eliom_registration.browser_content,
Eliom_registration.http_service)
Eliom_registration.kind Lwt.t
......
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