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 05bc228a authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Handle configuration locally in each auth system

Summary:
 - move rewrite_prefix to Web_common
 - each auth system now has an $init function that registers its
   configuration spec and an $exec function to Auth_common
 - an auth system may support multiple instances via configuration;
   user_type is specific to each instance
 - when parsing is done, each $exec is called with an $instantiate
   callback; $exec is supposed to call $instantiate for each instance

TODO:
 - default fallback when there are several instances
 - generic login should do security_log
 - auth system instances should not set user_type themselves
 - it should not be possible to login twice
 - admin login
 - update doc
parent d4b71428
......@@ -35,8 +35,8 @@
<static dir="_SRCDIR_/ext/booth" />
</site>
<eliom module="_build/src/web/server.cma">
<enable-dummy/>
<enable-password db="demo/data/password_db.csv"/>
<auth-dummy name="demo"/>
<auth-password name="local" db="demo/data/password_db.csv"/>
<source file="../belenios.tar.gz"/>
<main-election uuid="6d122f00-2650-4de8-87de-30037a21f943"/>
<log file="_RUNDIR_/log/security.log"/>
......
......@@ -27,44 +27,50 @@ let next_lf str i =
try Some (String.index_from str i '\n')
with Not_found -> None
module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) = struct
module type CONFIG = sig
val server : string
end
module Make (C : CONFIG) (N : NAME) : AUTH_INSTANCE = struct
let user_admin = false
let user_type = "cas"
module A : AUTH_SYSTEM = struct
let cas_login = Eliom_service.external_service
~prefix:C.cas_server
~path:["login"]
~get_params:Eliom_parameter.(string "service")
()
let cas_logout = Eliom_service.external_service
~prefix:C.cas_server
~path:["logout"]
~get_params:Eliom_parameter.(string "service")
()
let cas_validate = Eliom_service.external_service
~prefix:C.cas_server
~path:["validate"]
~get_params:Eliom_parameter.(string "service" ** string "ticket")
()
let login_cas = Eliom_service.service
~path:["login-cas"]
~get_params:Eliom_parameter.(opt (string "ticket"))
()
let () = Eliom_registration.Redirection.register ~service:login_cas
let user_type = N.name
let cas_login = Eliom_service.external_service
~prefix:C.server
~path:["login"]
~get_params:Eliom_parameter.(string "service")
()
let cas_logout = Eliom_service.external_service
~prefix:C.server
~path:["logout"]
~get_params:Eliom_parameter.(string "service")
()
let cas_validate = Eliom_service.external_service
~prefix:C.server
~path:["validate"]
~get_params:Eliom_parameter.(string "service" ** string "ticket")
()
let login_cas = Eliom_service.service
~path:["auth"; N.name]
~get_params:Eliom_parameter.(opt (string "ticket"))
()
let service = Eliom_service.preapply login_cas None
module Register (S : CONT_SERVICE) (T : TEMPLATES) = struct
let () = Eliom_registration.Redirection.register
~service:login_cas
(fun ticket () ->
match ticket with
| Some x ->
let me =
let service = Eliom_service.preapply login_cas None in
let uri = Eliom_uri.make_string_uri ~absolute:true ~service () in
C.rewrite_prefix uri
rewrite_prefix uri
in
let validation =
let service = Eliom_service.preapply cas_validate (me, x) in
......@@ -85,20 +91,18 @@ module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) = struct
let user_user = {user_type; user_name} in
let module L : CONT_SERVICE = struct
let cont () =
lwt service = S.get () in
lwt service = S.cont () in
let uri = Eliom_uri.make_string_uri ~absolute:true ~service () in
let uri = C.rewrite_prefix uri in
let uri = rewrite_prefix uri in
security_log (fun () ->
string_of_user user_user ^ " logged out, redirecting to CAS"
Printf.sprintf "%s logged out, redirecting to CAS [%s]"
(string_of_user user_user) C.server
) >> Lwt.return (Eliom_service.preapply cas_logout uri)
end in
let user_logout = (module L : CONT_SERVICE) in
security_log (fun () ->
user_name ^ " successfully logged in using CAS"
) >>
Eliom_reference.set user
(Some {user_admin; user_user; user_logout}) >>
S.get ()
S.cont ()
| None -> fail_http 502
)
| "no" -> fail_http 401
......@@ -109,15 +113,57 @@ module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) = struct
| None -> fail_http 502
)
| None ->
let service = Eliom_service.preapply login_cas None in
let uri = Eliom_uri.make_string_uri ~absolute:true ~service () in
let uri = C.rewrite_prefix uri in
let uri = rewrite_prefix uri in
Lwt.return (Eliom_service.preapply cas_login uri)
)
let service = Eliom_service.preapply login_cas None
end
let () = register_auth_system "CAS" (module A : AUTH_SYSTEM)
end
type instance = {
mutable name : string option;
mutable server : string option;
}
let init () =
let instances = ref [] in
let current_instance = ref None in
let push_current loc =
match !current_instance with
| None -> ()
| Some {name = Some name; server = Some server} ->
let module C : CONFIG = struct
let server = server
end in
instances := (name, (module C : CONFIG)) :: !instances;
current_instance := None
| _ -> failwith ("unexpected case in auth-cas/" ^ loc)
in
let spec =
let open Ocsigen_extensions.Configuration in
[
let init () =
push_current "init";
current_instance := Some {name = None; server = None}
and attributes = [
attribute ~name:"name" ~obligatory:true (fun s ->
match !current_instance with
| Some ({name = None; _} as i) -> i.name <- Some s
| _ -> failwith "unexpected case in auth-cas/name"
);
attribute ~name:"server" ~obligatory:true (fun s ->
match !current_instance with
| Some ({server = None; _} as i) -> i.server <- Some s
| _ -> failwith "unexpected case in auth-cas/server"
);
] in element ~name:"auth-cas" ~init ~attributes ();
]
and exec ~instantiate =
push_current "exec";
List.iter (fun (name, config) ->
let module X = Make ((val config : CONFIG)) in
instantiate name (module X : AUTH_SERVICE)
) !instances
in Auth_common.register_auth_system ~spec ~exec
open Web_signatures
module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) : EMPTY
val init : unit -> unit
......@@ -41,26 +41,47 @@ let user = Eliom_reference.eref
~scope:Eliom_common.default_session_scope
None
(* TODO: make the authentication system more flexible *)
let auth_system_map = ref []
type instantiator = string -> (module AUTH_SERVICE) -> unit
let register_auth_system name service =
auth_system_map := (name, service) :: !auth_system_map
let config_spec = ref []
let config_exec = ref []
let auth_systems = lazy (List.map fst !auth_system_map)
let register_auth_system ~spec ~exec =
config_spec := spec @ !config_spec;
config_exec := exec :: !config_exec
let get_auth_systems () = Lazy.force auth_systems
let get_config_spec () = !config_spec
let get_default_auth_system () =
match !auth_system_map with
| [] -> fail_http 404
| (name, _) :: _ -> Lwt.return name
(* TODO: make the authentication system more flexible *)
module Make (X : EMPTY) = struct
let instances = Hashtbl.create 10
let auth_systems = ref []
let instantiate name auth =
if Hashtbl.mem instances name then (
failwith ("multiple instances with name " ^ name)
) else (
let module N = struct let name = name end in
let module A = (val auth : AUTH_SERVICE) in
let i = (module A (N) : AUTH_INSTANCE) in
Hashtbl.add instances name i;
auth_systems := name :: !auth_systems
)
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"
)
module Services : AUTH_SERVICES = struct
let get_auth_systems () = !auth_systems
let login = Eliom_service.service
~path:["login"]
~get_params:Eliom_parameter.(opt (string "service"))
......@@ -73,18 +94,24 @@ module Make (X : EMPTY) = struct
end
module Register (C : CONT_SERVICE) : EMPTY = struct
module Register (C : CONT_SERVICE) (T : TEMPLATES) : EMPTY = struct
let () = Hashtbl.iter (fun name i ->
let module A = (val i : AUTH_INSTANCE) in
let module X : EMPTY = A.Register (C) (T) in
()
) instances
let () = Eliom_registration.Redirection.register
~service:Services.login
(fun service () ->
lwt x = match service with
| None -> get_default_auth_system ()
| None -> Lwt.return (Lazy.force default_auth_system)
| Some x -> Lwt.return x
in
try
let auth_system = List.assoc x !auth_system_map in
let module A = (val auth_system : AUTH_SYSTEM) in
let i = Hashtbl.find instances x in
let module A = (val i : AUTH_INSTANCE) in
Lwt.return A.service
with Not_found -> fail_http 404
)
......
......@@ -35,10 +35,17 @@ type logged_user = {
val string_of_user : user -> string
val user : logged_user option Eliom_reference.eref
val get_auth_systems : unit -> string list
val register_auth_system : string -> (module AUTH_SYSTEM) -> unit
type instantiator = string -> (module AUTH_SERVICE) -> unit
val register_auth_system :
spec:(Ocsigen_extensions.Configuration.element list) ->
exec:(instantiate:instantiator -> unit) ->
unit
val get_config_spec :
unit -> Ocsigen_extensions.Configuration.element list
module Make (X : EMPTY) : sig
module Services : AUTH_SERVICES
module Register (S : CONT_SERVICE) : EMPTY
module Register (S : CONT_SERVICE) (T : TEMPLATES) : EMPTY
end
......@@ -22,22 +22,19 @@
open Web_signatures
open Auth_common
module Register (S : ALL_SERVICES) (T : TEMPLATES) = struct
module L : CONT_SERVICE = struct
let cont = S.get
end
module Make (N : NAME) : AUTH_INSTANCE = struct
let user_admin = false
let user_type = "dummy"
let user_logout = (module L : CONT_SERVICE)
let user_type = N.name
let service = Eliom_service.service
~path:["auth"; N.name]
~get_params:Eliom_parameter.unit
()
module A : AUTH_SYSTEM = struct
module Register (S : CONT_SERVICE) (T : TEMPLATES) = struct
let service = Eliom_service.service
~path:["login-dummy"]
~get_params:Eliom_parameter.unit
()
let user_logout = (module S : CONT_SERVICE)
let () = Eliom_registration.Html5.register ~service
(fun () () ->
......@@ -54,14 +51,27 @@ module Register (S : ALL_SERVICES) (T : TEMPLATES) = struct
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) >>
Web_common.security_log (fun () ->
user_name ^ " successfully logged in using dummy"
) >> S.get ())
S.cont ())
in T.string_login ~service ~kind:`Dummy
)
end
let () = register_auth_system "dummy" (module A : AUTH_SYSTEM)
end
let init () =
let instances = ref [] in
let spec =
let open Ocsigen_extensions.Configuration in
[
let attributes = [
attribute ~name:"name" ~obligatory:true (fun s ->
instances := s :: !instances
);
] in element ~name:"auth-dummy" ~attributes ();
]
and exec ~instantiate =
List.iter (fun name ->
instantiate name (module Make : AUTH_SERVICE)
) !instances
in Auth_common.register_auth_system ~spec ~exec
open Web_signatures
module Register (S : ALL_SERVICES) (T : TEMPLATES) : EMPTY
val init : unit -> unit
......@@ -24,26 +24,31 @@ open Web_signatures
open Web_common
open Auth_common
module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) (T : TEMPLATES) = struct
module type CONFIG = sig
val db : string
end
module L : CONT_SERVICE = struct
let cont = S.get
end
module Make (C : CONFIG) (N : NAME) : AUTH_INSTANCE = struct
let user_admin = false
let user_type = "password"
let user_logout = (module L : CONT_SERVICE)
let user_type = N.name
let service = Eliom_service.service
~path:["auth"; N.name]
~get_params:Eliom_parameter.unit
()
let db = match C.password_db with
| None -> assert false
| Some db -> db
let db =
List.fold_left (fun accu line ->
match line with
| username :: salt :: password :: _ ->
SMap.add username (salt, password) accu
| _ -> failwith ("error while parsing db file for " ^ N.name)
) SMap.empty (Csv.load C.db)
module A = struct
module Register (S : CONT_SERVICE) (T : TEMPLATES) = struct
let service = Eliom_service.service
~path:["login-password"]
~get_params:Eliom_parameter.unit
()
let user_logout = (module S : CONT_SERVICE)
let () = Eliom_registration.Html5.register ~service
(fun () () ->
......@@ -67,15 +72,57 @@ module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) (T : TEMPLATES) = struct
) then (
let user_user = {user_type; user_name} in
Eliom_reference.set user (Some {user_admin; user_user; user_logout}) >>
security_log (fun () ->
user_name ^ " successfully logged in using password"
) >> S.get ()
S.cont ()
) else forbidden ())
in T.password_login ~service
)
end
let () = register_auth_system "password" (module A : AUTH_SYSTEM)
end
type instance = {
mutable name : string option;
mutable db : string option;
}
let init () =
let instances = ref [] in
let current_instance = ref None in
let push_current loc =
match !current_instance with
| None -> ()
| Some {name = Some name; db = Some db} ->
let module C : CONFIG = struct
let db = db
end in
instances := (name, (module C : CONFIG)) :: !instances;
current_instance := None
| _ -> failwith ("unexpected case in auth-password/" ^ loc)
in
let spec =
let open Ocsigen_extensions.Configuration in
[
let init () =
push_current "init";
current_instance := Some {name = None; db = None}
and attributes = [
attribute ~name:"name" ~obligatory:true (fun s ->
match !current_instance with
| Some ({name = None; _} as i) -> i.name <- Some s
| _ -> failwith "unexpected case in auth-password/name"
);
attribute ~name:"db" ~obligatory:true (fun s ->
match !current_instance with
| Some ({db = None; _} as i) -> i.db <- Some s
| _ -> failwith "unexpected case in auth-password/db"
);
] in element ~name:"auth-password" ~init ~attributes ();
]
and exec ~instantiate =
push_current "exec";
List.iter (fun (name, config) ->
let module X = Make ((val config : CONFIG)) in
instantiate name (module X : AUTH_SERVICE)
) !instances
in Auth_common.register_auth_system ~spec ~exec
open Web_signatures
module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) (T : TEMPLATES) : EMPTY
val init : unit -> unit
......@@ -24,6 +24,7 @@ open Util
open Serializable_t
open Lwt
open Web_common
open Web_signatures
(* FIXME: the following should be in configuration file... but
<maxrequestbodysize> doesn't work *)
......@@ -49,19 +50,19 @@ let populate accu f s = Lwt_stream.fold_s f s accu
let secure_logfile = ref None
let data_dir = ref None
let source_file = ref None
let enable_dummy = ref false
let password_db_fname = ref None
let enable_cas = ref false
let cas_server = ref "https://cas.example.org"
let main_election = ref None
let rewrite_src = ref None
let rewrite_dst = ref None
let () = CalendarLib.Time_Zone.(change Local)
let () =
let () = Auth_dummy.init ()
let () = Auth_password.init ()
let () = Auth_cas.init ()
let config_spec =
let open Ocsigen_extensions.Configuration in
Eliom_config.parse_config [
[
element
~name:"log"
~obligatory:true
......@@ -87,54 +88,21 @@ let () =
attribute ~name:"src" ~obligatory:true (fun s -> rewrite_src := Some s);
attribute ~name:"dst" ~obligatory:true (fun s -> rewrite_dst := Some s);
] ();
element
~name:"enable-dummy"
~obligatory:false
~init:(fun () -> enable_dummy := true)
();
element
~name:"enable-password"
~obligatory:false
~attributes:[
attribute ~name:"db" ~obligatory:true (fun s -> password_db_fname := Some s);
] ();
element
~name:"enable-cas"
~obligatory:false
~init:(fun () -> enable_cas := true)
~attributes:[
attribute ~name:"server" ~obligatory:true (fun s -> cas_server := s);
] ();
element
~name:"main-election"
~obligatory:false
~attributes:[
attribute ~name:"uuid" ~obligatory:true (fun s -> main_election := Some s);
] ();
];;
] @ Auth_common.get_config_spec ()
let password_db = match !password_db_fname with
| None -> None
| Some fname -> Some (
List.fold_left (fun accu line ->
match line with
| username :: salt :: password :: _ ->
SMap.add username (salt, password) accu
| _ -> failwith "error in password db file"
) SMap.empty (Csv.load fname)
)
let () = Eliom_config.parse_config config_spec
let rewrite_prefix =
let () =
match !rewrite_src, !rewrite_dst with
| Some src, Some dst ->
let nsrc = String.length src in
(fun x ->
let n = String.length x in
if n >= nsrc && String.sub x 0 nsrc = src then
dst ^ String.sub x nsrc (n-nsrc)
else x
)
| _, _ -> (fun x -> x)
set_rewrite_prefix ~src ~dst
| _, _ -> ()
lwt () =
match !secure_logfile with
......@@ -344,28 +312,12 @@ module S = struct
include A.Services
end
let () = let module X = A.Register (struct let cont = S.get end) in ()
module T = Templates.Make (S)
module C = struct
let enable_cas = !enable_cas
let cas_server = !cas_server
let password_db = password_db
let enable_dummy = !enable_dummy
let rewrite_prefix = rewrite_prefix
end
let () =
if C.enable_dummy then let module X = Auth_dummy.Register (S) (T) in ()
let () =
match C.password_db with
| Some _ -> let module X = Auth_password.Register (C) (S) (T) in ()
| None -> ()
let () =
if C.enable_cas then let module X = Auth_cas.Register (C) (S) in ()
let module S = struct let cont = S.get end in
let module X : EMPTY = A.Register (S) (T) in
()
let () =
match main_election with
......