Commit debc842a authored by Stephane Glondu's avatar Stephane Glondu

Do no longer rely on Ocsipersist for authentication configuration

parent f82e3ef5
......@@ -34,14 +34,6 @@ let next_lf str i =
try Some (String.index_from str i '\n')
with Not_found -> None
let configure x =
let auth_config =
List.map (fun {auth_system; auth_instance; auth_config} ->
auth_instance, (auth_system, List.map snd auth_config)
) x
in
Web_persist.set_auth_config None auth_config |> Lwt_main.run
let scope = Eliom_common.default_session_scope
let auth_env = Eliom_reference.eref ~scope None
......@@ -331,7 +323,10 @@ let login_handler service uuid =
cont_push (fun () -> Eliom_registration.Redirection.send (myself service)) >>
Web_templates.already_logged_in () >>= Eliom_registration.Html5.send
| None ->
let%lwt c = Web_persist.get_auth_config uuid in
let%lwt c = match uuid with
| None -> return !site_auth_config
| Some u -> Web_persist.get_auth_config u
in
match service with
| Some s ->
let%lwt auth_system, config =
......
open Web_serializable_t
val configure : auth_config list -> unit
(* empty interface *)
......@@ -27,6 +27,7 @@ open Serializable_t
open Web_serializable_builtin_t
open Web_serializable_j
let site_auth_config = ref []
let spool_dir = ref "."
let server_mail = ref "noreply@example.org"
let return_path = ref None
......@@ -293,6 +294,9 @@ let write_file ?uuid x lines =
)
) >> Lwt_unix.rename fname_new fname
let compile_auth_config {auth_system; auth_instance; auth_config} =
auth_instance, (auth_system, List.map snd auth_config)
let default_contact = "Name <user@example.org>"
let default_questions =
......
......@@ -23,6 +23,7 @@ open Signatures
open Serializable_t
open Web_serializable_t
val site_auth_config : (string * (string * string list)) list ref
val spool_dir : string ref
val server_mail : string ref
val return_path : string option ref
......@@ -111,6 +112,8 @@ val file_exists : string -> bool Lwt.t
val read_file : ?uuid:uuid -> string -> string list option Lwt.t
val write_file : ?uuid:uuid -> string -> string list -> unit Lwt.t
val compile_auth_config : auth_config -> string * (string * string list)
val default_contact : string
val default_questions : question array
val default_name : string
......
......@@ -126,4 +126,4 @@ let%lwt default_group =
let () = Web_site.source_file := source_file
let () = Web_common.spool_dir := spool_dir
let () = Web_site.default_group := default_group
let () = Web_auth.configure (List.rev !auth_instances)
let () = Web_common.site_auth_config := (List.rev_map compile_auth_config !auth_instances)
......@@ -100,19 +100,6 @@ let get_partial_decryptions x =
let set_partial_decryptions x pds =
Ocsipersist.add election_pds (raw_string_of_uuid x) pds
let auth_configs = Ocsipersist.open_table "auth_configs"
let key_of_uuid_option = function
| None -> ""
| Some x -> raw_string_of_uuid x
let get_auth_config x =
try%lwt Ocsipersist.find auth_configs (key_of_uuid_option x)
with Not_found -> return []
let set_auth_config x c =
Ocsipersist.add auth_configs (key_of_uuid_option x) c
let get_raw_election uuid =
match%lwt read_file ~uuid "election.json" with
| Some [x] -> return (Some x)
......@@ -135,6 +122,12 @@ let get_election_metadata uuid =
| Some [x] -> return (metadata_of_string x)
| _ -> return_empty_metadata
let get_auth_config uuid =
let%lwt metadata = get_election_metadata uuid in
match metadata.e_auth_config with
| None -> return []
| Some x -> return (List.map compile_auth_config x)
let get_elections_by_owner user =
Lwt_unix.files_of_directory !spool_dir |>
Lwt_stream.filter_map_s
......
......@@ -46,8 +46,7 @@ val set_election_date : election_date -> uuid -> datetime -> unit Lwt.t
val get_partial_decryptions : uuid -> (int * string) list Lwt.t
val set_partial_decryptions : uuid -> (int * string) list -> unit Lwt.t
val get_auth_config : uuid option -> (string * (string * string list)) list Lwt.t
val set_auth_config : uuid option -> (string * (string * string list)) list -> unit Lwt.t
val get_auth_config : uuid -> (string * (string * string list)) list Lwt.t
val get_raw_election : uuid -> string option Lwt.t
val get_election_metadata : uuid -> metadata Lwt.t
......
......@@ -209,18 +209,6 @@ let validate_election uuid se =
let module W = (val Election.get_group election) in
let module E = Election.Make (W) (LwtRandom) in
let module B = Web_election.Make (E) in
(* set up authentication *)
let%lwt () =
match metadata.e_auth_config with
| None -> return ()
| Some xs ->
let auth_config =
List.map (fun {auth_system; auth_instance; auth_config} ->
auth_instance, (auth_system, List.map snd auth_config)
) xs
in
Web_persist.set_auth_config (Some uuid) auth_config
in
(* inject credentials *)
let%lwt () =
let fname = !spool_dir / uuid_s ^ ".public_creds.txt" in
......@@ -292,7 +280,6 @@ let delete_sensitive_data uuid =
let%lwt () = cleanup_table ~uuid_s "election_states" in
let%lwt () = cleanup_table ~uuid_s "site_tokens_decrypt" in
let%lwt () = cleanup_table ~uuid_s "election_pds" in
let%lwt () = cleanup_table ~uuid_s "auth_configs" in
let%lwt () = cleanup_table ("records_" ^ uuid_u) in
let%lwt () = cleanup_table ("creds_" ^ uuid_u) in
let%lwt () = cleanup_table ("ballots_" ^ uuid_u) in
......
......@@ -97,9 +97,7 @@ end
module Site_auth = struct
let get_user () = Web_state.get_site_user ()
let get_auth_systems () =
let%lwt l = Web_persist.get_auth_config None in
return (List.map fst l)
let get_auth_systems () = return (List.map fst !site_auth_config)
end
let site_links = (module Site_links : AUTH_LINKS)
......@@ -1527,7 +1525,7 @@ let election_login_box uuid =
let get_user () =
Web_state.get_election_user uuid
let get_auth_systems () =
let%lwt l = Web_persist.get_auth_config (Some uuid) in
let%lwt l = Web_persist.get_auth_config uuid in
return @@ List.map fst l
end in
let auth = (module A : AUTH_SERVICES) in
......
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