Maj terminée. Pour consulter la release notes associée voici le lien :
https://about.gitlab.com/releases/2021/07/07/critical-security-release-gitlab-14-0-4-released/

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

Remove auth_config from Web_auth.Make's input

parent 704e436f
......@@ -47,23 +47,50 @@ type logged_user = {
user_handlers : (module AUTH_HANDLERS);
}
module type CONFIG = sig
include NAME
val auth_config : auth_config list
end
module Make (N : CONFIG) = struct
module Make (N : NAME) = struct
let scope = Eliom_common.default_session_scope
let auth_instances = Hashtbl.create 10
let auth_instance_names = ref []
let user = Eliom_reference.eref ~scope None
(* Forward reference, will be set to eponymous template *)
let login_choose = ref (fun () -> assert false)
let register templates xs =
let module T = (val templates : LOGIN_TEMPLATES) in
login_choose := T.choose;
List.iter
(fun auth_instance ->
let {
auth_system = name;
auth_instance = instance;
auth_config = attributes;
} = auth_instance in
if Hashtbl.mem auth_instances instance then (
Printf.ksprintf
failwith
"multiple instances with name %s"
instance
) else (
let auth_system = Hashtbl.find auth_systems name in
let module X = (val auth_system : AUTH_SYSTEM) in
let config = X.parse_config ~instance ~attributes in
let auth = X.make config in
let module N = struct
let name = instance
let path = N.path @ ["auth"; instance]
let kind = N.kind
end in
let module A = (val auth : AUTH_SERVICE) (N) (T) in
let i = (module A : AUTH_HANDLERS) in
Hashtbl.add auth_instances instance i;
auth_instance_names := instance :: !auth_instance_names
)
) xs
let user = Eliom_reference.eref ~scope None
let do_login_using user_domain cont =
try
let user_handlers = Hashtbl.find auth_instances user_domain in
......@@ -111,7 +138,7 @@ module Make (N : CONFIG) = struct
module Handlers : AUTH_HANDLERS_PUBLIC = struct
let do_login cont () = login_handler None cont
let do_login service cont () = login_handler service cont
let do_logout cont () =
match_lwt Eliom_reference.get user with
......@@ -127,49 +154,4 @@ module Make (N : CONFIG) = struct
end
module Register (S : SITE) (T : LOGIN_TEMPLATES) : AUTH_HANDLERS_RAW = struct
let () = login_choose := T.choose
let () = List.iter (fun auth_instance ->
let {
auth_system = name;
auth_instance = instance;
auth_config = attributes;
} = auth_instance in
if Hashtbl.mem auth_instances instance then (
Printf.ksprintf failwith
"multiple instances with name %s"
instance
) else (
let auth_system = Hashtbl.find auth_systems name in
let module X = (val auth_system : AUTH_SYSTEM) in
let config = X.parse_config ~instance ~attributes in
let auth = X.make config in
let module N = struct
let name = instance
let path = N.path @ ["auth"; instance]
let kind = N.kind
end in
let module A = (val auth : AUTH_SERVICE) (N) (T) in
let i = (module A : AUTH_HANDLERS) in
Hashtbl.add auth_instances instance i;
auth_instance_names := instance :: !auth_instance_names
)
) N.auth_config
let login =
(fun service () ->
lwt cont = Eliom_reference.get S.cont in
login_handler service cont
)
let logout =
(fun () () ->
lwt cont = Eliom_reference.get S.cont in
Handlers.do_logout cont ()
)
end
end
......@@ -28,13 +28,8 @@ val string_of_user : user -> string
val register_auth_system : (module AUTH_SYSTEM) -> unit
module type CONFIG = sig
include NAME
val auth_config : auth_config list
end
module Make (C : CONFIG) : sig
module Make (C : NAME) : sig
val register : (module LOGIN_TEMPLATES) -> auth_config list -> unit
module Services : AUTH_SERVICES
module Handlers : AUTH_HANDLERS_PUBLIC
module Register (S : SITE) (T : LOGIN_TEMPLATES) : AUTH_HANDLERS_RAW
end
......@@ -282,7 +282,18 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
let logout = Eliom_service.preapply election_logout (W.election.e_params.e_uuid, ())
end
include Auth.Register (S) (T.Login (W.S) (L))
let () =
let module T = T.Login (W.S) (L) in
let templates = (module T : LOGIN_TEMPLATES) in
Auth.register templates N.auth_config
let login service () =
lwt cont = Eliom_reference.get S.cont in
Auth.Handlers.do_login service cont ()
let logout () () =
lwt cont = Eliom_reference.get S.cont in
Auth.Handlers.do_logout cont ()
module T = T.Election (W)
......@@ -469,7 +480,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
Eliom_reference.set S.cont cont >>
Eliom_reference.set ballot (Some the_ballot) >>
match user with
| None -> W.H.do_login cont ()
| None -> W.H.do_login None cont ()
| Some u -> cont () ()
)
)
......
......@@ -122,11 +122,12 @@ module Site_config = struct
let path = []
let source_file = source_file
let spool_dir = spool_dir
let auth_config = !auth_instances
end
module Site = Web_site.Make (Site_config)
let () = Site.install_authentication !auth_instances
lwt () =
Lwt_list.iter_s (fun dir ->
read_election_dir dir >>=
......
......@@ -95,7 +95,7 @@ module type AUTH_HANDLERS = sig
end
module type AUTH_HANDLERS_PUBLIC = sig
val do_login : unit service_cont
val do_login : string option -> unit service_cont
val do_logout : unit service_cont
end
......@@ -182,6 +182,7 @@ module type SITE = sig
val remove_featured_election : string -> unit Lwt.t
val is_featured_election : string -> bool Lwt.t
val cont : (unit -> service_handler) Eliom_reference.eref
val install_authentication : auth_config list -> unit
end
module type LOGIN_TEMPLATES = sig
......
......@@ -34,7 +34,6 @@ module type CONFIG = sig
val path : string list
val source_file : string
val spool_dir : string
val auth_config : auth_config list
end
let rec list_remove x = function
......@@ -104,6 +103,9 @@ module Make (C : CONFIG) : SITE = struct
let import_election_ref = ref (fun _ -> assert false)
(* Forward reference *)
let install_authentication_ref = ref (fun _ -> assert false)
(* We use an intermediate module S that will be passed to Templates
and Web_election. S is not meant to leak and will be included
in the returned module later. *)
......@@ -149,6 +151,8 @@ module Make (C : CONFIG) : SITE = struct
let unset_main_election () =
Ocsipersist.set main_election None
let install_authentication xs = !install_authentication_ref xs
end
include S
......@@ -307,7 +311,10 @@ module Make (C : CONFIG) : SITE = struct
let logout = Eliom_service.preapply site_logout ()
end
module Z = Auth.Register (S) (T.Login (S) (L))
let () = install_authentication_ref := fun auth_configs ->
let module T = T.Login (S) (L) in
let templates = (module T : LOGIN_TEMPLATES) in
Auth.register templates auth_configs
let () = Any.register ~service:home
(fun () () ->
......@@ -345,8 +352,16 @@ module Make (C : CONFIG) : SITE = struct
T.admin ~elections ()
)
let () = Any.register ~service:site_login Z.login
let () = Any.register ~service:site_logout Z.logout
let login service () =
lwt cont = Eliom_reference.get S.cont in
Auth.Handlers.do_login service cont ()
let logout () () =
lwt cont = Eliom_reference.get S.cont in
Auth.Handlers.do_logout cont ()
let () = Any.register ~service:site_login login
let () = Any.register ~service:site_logout logout
let () = File.register
~service:source_code
......
......@@ -27,7 +27,6 @@ module type CONFIG = sig
val path : string list
val source_file : string
val spool_dir : string
val auth_config : auth_config list
end
module Make (C : CONFIG) : SITE
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