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