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

Add per-election AUTH_SERVICES

For now, they are not referenced anywhere, but seem to work when
accessing directly their URL.
parent 95b4662e
...@@ -42,12 +42,6 @@ let register_auth_system auth_system = ...@@ -42,12 +42,6 @@ let register_auth_system auth_system =
Hashtbl.add auth_systems X.name auth_system Hashtbl.add auth_systems X.name auth_system
) )
type auth_instance = {
auth_system : string;
auth_instance : string;
auth_config : (string * string) list;
}
type logged_user = { type logged_user = {
user_user : user; user_user : user;
user_handlers : (module AUTH_HANDLERS); user_handlers : (module AUTH_HANDLERS);
...@@ -55,7 +49,7 @@ type logged_user = { ...@@ -55,7 +49,7 @@ type logged_user = {
module type CONFIG = sig module type CONFIG = sig
include NAME include NAME
val instances : auth_instance list val auth_config : auth_config list
end end
module Make (N : CONFIG) = struct module Make (N : CONFIG) = struct
...@@ -168,7 +162,7 @@ module Make (N : CONFIG) = struct ...@@ -168,7 +162,7 @@ module Make (N : CONFIG) = struct
Hashtbl.add auth_instances instance i; Hashtbl.add auth_instances instance i;
auth_instance_names := instance :: !auth_instance_names auth_instance_names := instance :: !auth_instance_names
) )
) N.instances ) N.auth_config
let () = Eliom_registration.Any.register let () = Eliom_registration.Any.register
~service:Services.login ~service:Services.login
......
...@@ -28,15 +28,9 @@ val string_of_user : user -> string ...@@ -28,15 +28,9 @@ val string_of_user : user -> string
val register_auth_system : (module AUTH_SYSTEM) -> unit val register_auth_system : (module AUTH_SYSTEM) -> unit
type auth_instance = {
auth_system : string;
auth_instance : string;
auth_config : (string * string) list;
}
module type CONFIG = sig module type CONFIG = sig
include NAME include NAME
val instances : auth_instance list val auth_config : auth_config list
end end
module Make (C : CONFIG) : sig module Make (C : CONFIG) : sig
......
...@@ -46,14 +46,14 @@ let can_vote m user = ...@@ -46,14 +46,14 @@ let can_vote m user =
module type REGISTRATION = sig module type REGISTRATION = sig
module W : WEB_ELECTION module W : WEB_ELECTION
module Register (S : SITE) (T : ELECTION_TEMPLATES) : EMPTY module Register (S : SITE) (T : TEMPLATES) : EMPTY
end end
let make {raw_election; metadata; featured; params_fname; public_keys_fname} = let make config =
let e_fingerprint = sha256_b64 raw_election in let e_fingerprint = sha256_b64 config.raw_election in
let wrapped_params = Serializable_j.params_of_string let wrapped_params = Serializable_j.params_of_string
Serializable_j.read_ff_pubkey raw_election Serializable_j.read_ff_pubkey config.raw_election
in in
let {ffpk_g = g; ffpk_p = p; ffpk_q = q; ffpk_y = y} = wrapped_params.e_public_key in let {ffpk_g = g; ffpk_p = p; ffpk_q = q; ffpk_y = y} = wrapped_params.e_public_key in
let group = {g; p; q} in let group = {g; p; q} in
...@@ -61,17 +61,28 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} = ...@@ -61,17 +61,28 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
let module R : REGISTRATION = struct let module R : REGISTRATION = struct
let uuid = Uuidm.to_string e_params.e_uuid
let base_path = ["elections"; uuid]
module N = struct
let name = uuid
let path = base_path
let auth_config = config.auth_config
end
module Auth = Web_auth.Make (N)
module W : WEB_ELECTION = struct module W : WEB_ELECTION = struct
module G = (val Election.finite_field group : Election.FF_GROUP) module G = (val Election.finite_field group : Election.FF_GROUP)
module M = MakeLwtRandom(struct let rng = make_rng () end) module M = MakeLwtRandom(struct let rng = make_rng () end)
module E = Election.MakeElection(G)(M) module E = Election.MakeElection(G)(M)
let election = {e_params; e_pks = None; e_fingerprint} let election = {e_params; e_pks = None; e_fingerprint}
let metadata = metadata let metadata = config.metadata
let public_keys_fname = public_keys_fname let public_keys_fname = config.public_keys_fname
let params_fname = params_fname let params_fname = config.params_fname
let featured = featured let featured = config.featured
module B : WEB_BALLOT_BOX = struct module B : WEB_BALLOT_BOX = struct
...@@ -234,8 +245,9 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} = ...@@ -234,8 +245,9 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
open Eliom_parameter open Eliom_parameter
module S : ELECTION_SERVICES = struct module S : ELECTION_SERVICES = struct
include Auth.Services
include Auth.Handlers
let base_path = ["elections"; Uuidm.to_string election.e_params.e_uuid]
let make_path x = base_path @ x let make_path x = base_path @ x
let root = make_path [""] let root = make_path [""]
...@@ -292,12 +304,16 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} = ...@@ -292,12 +304,16 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
end end
module Register (S : SITE) (T : ELECTION_TEMPLATES) : EMPTY = struct module Register (S : SITE) (T : TEMPLATES) : EMPTY = struct
open Eliom_registration open Eliom_registration
let () = let module X : EMPTY = Auth.Register (S) (T) in ()
module T = T.Election (W)
let if_eligible acl f () x = let if_eligible acl f () x =
lwt user = S.get_user () in lwt user = S.get_user () in
if acl metadata user then if acl config.metadata user then
f user x f user x
else else
forbidden () forbidden ()
...@@ -321,10 +337,10 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} = ...@@ -321,10 +337,10 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
) )
let f_raw user () = let f_raw user () =
return params_fname return W.params_fname
let f_keys user () = let f_keys user () =
return public_keys_fname return W.public_keys_fname
let f_creds user () = let f_creds user () =
lwt creds = W.B.extract_creds () in lwt creds = W.B.extract_creds () in
...@@ -346,7 +362,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} = ...@@ -346,7 +362,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
let f_records user () = let f_records user () =
match user with match user with
| Some u -> | Some u ->
if metadata.e_owner = Some u then ( if W.metadata.e_owner = Some u then (
(* TODO: streaming *) (* TODO: streaming *)
lwt ballots = W.B.Records.fold (fun u (d, _) xs -> lwt ballots = W.B.Records.fold (fun u (d, _) xs ->
let x = Printf.sprintf "%s %S\n" let x = Printf.sprintf "%s %S\n"
...@@ -396,7 +412,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} = ...@@ -396,7 +412,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
lwt user = S.get_user () in lwt user = S.get_user () in
match user with match user with
| Some u -> | Some u ->
if metadata.e_owner = Some u then ( if W.metadata.e_owner = Some u then (
T.update_credential () T.update_credential ()
) else ( ) else (
forbidden () forbidden ()
...@@ -410,7 +426,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} = ...@@ -410,7 +426,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
lwt user = S.get_user () in lwt user = S.get_user () in
match user with match user with
| Some u -> | Some u ->
if metadata.e_owner = Some u then ( if W.metadata.e_owner = Some u then (
try_lwt try_lwt
W.B.update_cred ~old ~new_ >> W.B.update_cred ~old ~new_ >>
return ("OK", "text/plain") return ("OK", "text/plain")
...@@ -440,7 +456,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} = ...@@ -440,7 +456,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
Eliom_reference.unset ballot >> Eliom_reference.unset ballot >>
match_lwt S.get_user () with match_lwt S.get_user () with
| Some u -> | Some u ->
let b = check_acl metadata.e_voters u in let b = check_acl W.metadata.e_voters u in
if b then ( if b then (
let record = let record =
Web_auth.string_of_user u, Web_auth.string_of_user u,
...@@ -473,7 +489,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} = ...@@ -473,7 +489,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
let () = Any.register ~service ~scope do_cast in let () = Any.register ~service ~scope do_cast in
service service
in in
let can_vote = can_vote metadata user in let can_vote = can_vote W.metadata user in
T.cast_confirmation ~confirm ~user ~can_vote () T.cast_confirmation ~confirm ~user ~can_vote ()
let () = Html5.register let () = Html5.register
......
...@@ -27,7 +27,7 @@ open Web_signatures ...@@ -27,7 +27,7 @@ open Web_signatures
module type REGISTRATION = sig module type REGISTRATION = sig
module W : WEB_ELECTION module W : WEB_ELECTION
module Register (S : SITE) (T : ELECTION_TEMPLATES) : EMPTY module Register (S : SITE) (T : TEMPLATES) : EMPTY
end end
val make : election_config -> (module REGISTRATION) val make : election_config -> (module REGISTRATION)
...@@ -135,6 +135,7 @@ let parse_election_dir dir = ...@@ -135,6 +135,7 @@ let parse_election_dir dir =
featured = item.datadir_featured; featured = item.datadir_featured;
params_fname; params_fname;
public_keys_fname; public_keys_fname;
auth_config = !auth_instances;
}, public_creds_fname) }, public_creds_fname)
) index ) index
...@@ -159,7 +160,7 @@ module Site_config = struct ...@@ -159,7 +160,7 @@ module Site_config = struct
let name = "site" let name = "site"
let path = [] let path = []
let source_file = source_file let source_file = source_file
let instances = !auth_instances let auth_config = !auth_instances
end end
module Site = Web_site.Make (Site_config) module Site = Web_site.Make (Site_config)
......
...@@ -24,14 +24,47 @@ open Serializable_t ...@@ -24,14 +24,47 @@ open Serializable_t
open Web_serializable_t open Web_serializable_t
open Signatures open Signatures
type auth_config = {
auth_system : string;
auth_instance : string;
auth_config : (string * string) list;
}
type election_config = { type election_config = {
raw_election : string; raw_election : string;
metadata : metadata; metadata : metadata;
featured : bool; featured : bool;
params_fname : string; params_fname : string;
public_keys_fname : string; public_keys_fname : string;
auth_config : auth_config list;
} }
module type AUTH_SERVICES = sig
val get_auth_systems : unit -> string list
val get_user : unit -> user option Lwt.t
val login :
(string option, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ],
[ `One of string ] Eliom_parameter.param_name, unit,
[< Eliom_service.registrable > `Registrable ], 'a)
Eliom_service.service
val logout :
(unit, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ], unit, unit,
[< Eliom_service.registrable > `Registrable ], 'a)
Eliom_service.service
end
module type CORE_SERVICES = sig module type CORE_SERVICES = sig
val home : val home :
...@@ -64,6 +97,7 @@ module type CORE_SERVICES = sig ...@@ -64,6 +97,7 @@ module type CORE_SERVICES = sig
end end
module type ELECTION_SERVICES = sig module type ELECTION_SERVICES = sig
include AUTH_SERVICES
val home : val home :
(unit, unit, (unit, unit,
...@@ -161,32 +195,6 @@ module type AUTH_HANDLERS_PUBLIC = sig ...@@ -161,32 +195,6 @@ module type AUTH_HANDLERS_PUBLIC = sig
val do_logout : unit service_cont val do_logout : unit service_cont
end end
module type AUTH_SERVICES = sig
val get_auth_systems : unit -> string list
val get_user : unit -> user option Lwt.t
val login :
(string option, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ],
[ `One of string ] Eliom_parameter.param_name, unit,
[< Eliom_service.registrable > `Registrable ], 'a)
Eliom_service.service
val logout :
(unit, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ], unit, unit,
[< Eliom_service.registrable > `Registrable ], 'a)
Eliom_service.service
end
module type WEB_BALLOT_BOX = sig module type WEB_BALLOT_BOX = sig
module Ballots : MONADIC_MAP_RO module Ballots : MONADIC_MAP_RO
with type 'a m = 'a Lwt.t with type 'a m = 'a Lwt.t
......
...@@ -31,7 +31,7 @@ module type CONFIG = sig ...@@ -31,7 +31,7 @@ module type CONFIG = sig
val name : string val name : string
val path : string list val path : string list
val source_file : string val source_file : string
val instances : Web_auth.auth_instance list val auth_config : auth_config list
end end
module Make (C : CONFIG) : SITE = struct module Make (C : CONFIG) : SITE = struct
...@@ -95,7 +95,7 @@ module Make (C : CONFIG) : SITE = struct ...@@ -95,7 +95,7 @@ module Make (C : CONFIG) : SITE = struct
let registration = Web_election.make config in let registration = Web_election.make config in
let module R = (val registration : Web_election.REGISTRATION) in let module R = (val registration : Web_election.REGISTRATION) in
let module W = R.W in let module W = R.W in
let module X : EMPTY = R.Register (S) (T.Election (W)) in let module X : EMPTY = R.Register (S) (T) in
let election = (module W : WEB_ELECTION) in let election = (module W : WEB_ELECTION) in
let election_ro = (module W : WEB_ELECTION_RO) in let election_ro = (module W : WEB_ELECTION_RO) in
if W.featured then featured := election_ro :: !featured; if W.featured then featured := election_ro :: !featured;
......
...@@ -25,7 +25,7 @@ module type CONFIG = sig ...@@ -25,7 +25,7 @@ module type CONFIG = sig
val name : string val name : string
val path : string list val path : string list
val source_file : string val source_file : string
val instances : Web_auth.auth_instance list val auth_config : auth_config list
end end
module Make (C : CONFIG) : SITE 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