Commit 3482da56 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Redesign authentication

 - there is now a single Eliom reference holding the logged in user
 - per-election authentication is no longer handled by a submodule of
   WEB_ELECTION
 - the database of passwords for password authentication can only be
   initialized for the site from the configuration file
parent 3055f97a
......@@ -11,7 +11,7 @@ Web_serializable_j
Web_common
Web_persist
Web_services
Web_site_auth_state
Web_auth_state
Web_templates
Web_auth
Auth_dummy
......
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2015 Inria *)
(* *)
(* This program is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Affero General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version, with the additional *)
(* exemption that compiling, linking, and/or using OpenSSL is allowed. *)
(* *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
(* Affero General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Affero General Public *)
(* License along with this program. If not, see *)
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Lwt
open Web_serializable_t
open Web_signatures
type user = {
uuid: Uuidm.t option;
service : string;
name : string;
logout : unit -> content;
}
let scope = Eliom_common.default_session_scope
let user : user option Eliom_reference.eref =
Eliom_reference.eref ~scope None
let get_site_user () =
match_lwt Eliom_reference.get user with
| None -> return None
| Some u ->
match u.uuid with
| None ->
return @@ Some {
user_domain = u.service;
user_name = u.name;
}
| Some _ -> return None
let get_election_user uuid =
match_lwt Eliom_reference.get user with
| None -> return None
| Some u ->
match u.uuid with
| None -> return None
| Some uuid' ->
if Uuidm.equal uuid uuid' then
return @@ Some {
user_domain = u.service;
user_name = u.name
}
else
return None
let get_config uuid =
let uuid_s =
match uuid with
| None -> ""
| Some u -> Uuidm.to_string u
in
Web_persist.get_auth_config uuid_s
let cont : (unit -> content) list Eliom_reference.eref =
Eliom_reference.eref ~scope []
let cont_push f =
let open Eliom_reference in
lwt fs = get cont in
set cont (f :: fs)
let cont_pop () =
let open Eliom_reference in
lwt fs = get cont in
match fs with
| f :: fs -> set cont fs >> return (Some f)
| [] -> return None
let dummy_post = Eliom_service.Http.post_coservice'
~post_params:(Eliom_parameter.string "username")
()
let password_post = Eliom_service.Http.post_coservice'
~post_params:Eliom_parameter.(string "username" ** string "password")
()
......@@ -54,8 +54,13 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
| Some xs -> xs
end
module Auth = Web_auth.Make (N)
let () = Auth.configure N.auth_config
let configure_auth () =
let auth_config =
List.map (fun {auth_system; auth_instance; auth_config} ->
auth_instance, (auth_system, List.map snd auth_config)
) N.auth_config
in
Web_persist.set_auth_config uuid auth_config
include D
include P
......
......@@ -119,7 +119,7 @@ let spool_dir =
let () = Web_site.source_file := source_file
let () = Web_site.spool_dir := spool_dir
let () = Web_site_auth.configure !auth_instances
let () = Web_site_auth.configure (List.rev !auth_instances)
lwt () =
Lwt_list.iter_s (fun dir ->
......
......@@ -86,3 +86,12 @@ let get_partial_decryptions x =
let set_partial_decryptions x pds =
Ocsipersist.add election_pds x pds
let auth_configs = Ocsipersist.open_table "auth_configs"
let get_auth_config x =
try_lwt Ocsipersist.find auth_configs x
with Not_found -> return []
let set_auth_config x c =
Ocsipersist.add auth_configs x c
......@@ -39,3 +39,6 @@ val get_featured_elections : unit -> string list Lwt.t
val get_partial_decryptions : string -> (int * string) list Lwt.t
val set_partial_decryptions : string -> (int * string) list -> unit Lwt.t
val get_auth_config : string -> (string * (string * string list)) list Lwt.t
val set_auth_config : string -> (string * (string * string list)) list -> unit Lwt.t
......@@ -80,9 +80,6 @@ let election_dir = service ~path:["elections"] ~get_params:(suffix (uuid "uuid"
let scope = Eliom_common.default_session_scope
let cont : (unit -> service_handler) Eliom_reference.eref =
Eliom_reference.eref ~scope (fun () () -> Eliom_registration.Redirection.send home)
let ballot : string option Eliom_reference.eref =
Eliom_reference.eref ~scope None
......
......@@ -113,10 +113,7 @@ module type WEB_ELECTION = sig
include WEB_PARAMS
module E : ELECTION with type elt = G.t and type 'a m = 'a Lwt.t
module B : WEB_BALLOT_BOX
module Auth : sig
module Services : AUTH_SERVICES
module Handlers : AUTH_HANDLERS
end
val configure_auth : unit -> unit Lwt.t
end
type election_files = {
......
......@@ -174,6 +174,7 @@ let import_election f =
)) >>
let election = do_register () in
let module W = (val election : WEB_ELECTION) in
W.configure_auth () >>
let () =
Ocsigen_messages.debug (fun () ->
Printf.sprintf "Injecting credentials for %s" uuid
......@@ -211,6 +212,7 @@ lwt () =
let _, do_register = register_election params web_params in
let election = do_register () in
let module W = (val election : WEB_ELECTION) in
lwt () = W.configure_auth () in
assert (uuid = Uuidm.to_string W.election.e_params.e_uuid);
Ocsigen_messages.debug (fun () ->
Printf.sprintf "Initialized election %s from persistent store" uuid
......@@ -220,7 +222,7 @@ lwt () =
let () = Any.register ~service:home
(fun () () ->
Eliom_reference.unset cont >>
Eliom_reference.unset Web_auth_state.cont >>
match_lwt Web_persist.get_main_election () with
| None ->
lwt featured =
......@@ -236,9 +238,9 @@ let () = Any.register ~service:home
let () = Html5.register ~service:admin
(fun () () ->
let cont () () = Redirection.send admin in
Eliom_reference.set Web_services.cont cont >>
lwt site_user = Web_site_auth.get_user () in
let cont () = Redirection.send admin in
Eliom_reference.set Web_auth_state.cont [cont] >>
lwt site_user = Web_auth_state.get_site_user () in
lwt elections =
match site_user with
| None -> return []
......@@ -292,14 +294,14 @@ let () = String.register
let () = Html5.register ~service:new_election
(fun () () ->
match_lwt Web_site_auth.get_user () with
match_lwt Web_auth_state.get_site_user () with
| None -> forbidden ()
| Some _ -> T.new_election ()
)
let () = Any.register ~service:new_election_post
(fun () (election, (metadata, (public_keys, public_creds))) ->
match_lwt Web_site_auth.get_user () with
match_lwt Web_auth_state.get_site_user () with
| Some u ->
let open Ocsigen_extensions in
let files = {
......@@ -329,7 +331,7 @@ let generate_uuid = Uuidm.v4_gen (Random.State.make_self_init ())
let () = Redirection.register ~service:election_setup_new
(fun () () ->
match_lwt Web_site_auth.get_user () with
match_lwt Web_auth_state.get_site_user () with
| Some u ->
let uuid = generate_uuid () in
let uuid_s = Uuidm.to_string uuid in
......@@ -369,7 +371,7 @@ let () = Redirection.register ~service:election_setup_new
let () = Html5.register ~service:election_setup
(fun uuid () ->
match_lwt Web_site_auth.get_user () with
match_lwt Web_auth_state.get_site_user () with
| Some u ->
let uuid_s = Uuidm.to_string uuid in
lwt se = Ocsipersist.find election_stable uuid_s in
......@@ -382,7 +384,7 @@ let () = Html5.register ~service:election_setup
let election_setup_mutex = Lwt_mutex.create ()
let handle_setup f cont uuid x =
match_lwt Web_site_auth.get_user () with
match_lwt Web_auth_state.get_site_user () with
| Some u ->
let uuid_s = Uuidm.to_string uuid in
Lwt_mutex.with_lock election_setup_mutex (fun () ->
......@@ -420,7 +422,7 @@ let () =
Html5.register
~service:election_setup_questions
(fun uuid () ->
match_lwt Web_site_auth.get_user () with
match_lwt Web_auth_state.get_site_user () with
| Some u ->
let uuid_s = Uuidm.to_string uuid in
lwt se = Ocsipersist.find election_stable uuid_s in
......@@ -441,7 +443,7 @@ let () =
Html5.register
~service:election_setup_voters
(fun uuid () ->
match_lwt Web_site_auth.get_user () with
match_lwt Web_auth_state.get_site_user () with
| Some u ->
let uuid_s = Uuidm.to_string uuid in
lwt se = Ocsipersist.find election_stable uuid_s in
......@@ -478,7 +480,7 @@ let () =
Redirection.register
~service:election_setup_trustee_add
(fun uuid () ->
match_lwt Web_site_auth.get_user () with
match_lwt Web_auth_state.get_site_user () with
| Some u ->
let uuid_s = Uuidm.to_string uuid in
Lwt_mutex.with_lock election_setup_mutex (fun () ->
......@@ -499,7 +501,7 @@ let () =
Redirection.register
~service:election_setup_trustee_del
(fun uuid () ->
match_lwt Web_site_auth.get_user () with
match_lwt Web_auth_state.get_site_user () with
| Some u ->
let uuid_s = Uuidm.to_string uuid in
Lwt_mutex.with_lock election_setup_mutex (fun () ->
......@@ -621,7 +623,7 @@ let () =
Any.register
~service:election_setup_create
(fun uuid () ->
match_lwt Web_site_auth.get_user () with
match_lwt Web_auth_state.get_site_user () with
| None -> forbidden ()
| Some u ->
begin try_lwt
......@@ -731,12 +733,12 @@ let () =
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
Eliom_reference.unset Web_services.ballot >>
let cont () () =
let cont () =
Redirection.send
(Eliom_service.preapply
election_home (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_services.cont cont >>
Eliom_reference.set Web_auth_state.cont [cont] >>
match_lwt Eliom_reference.get Web_services.cast_confirmed with
| Some result ->
Eliom_reference.unset Web_services.cast_confirmed >>
......@@ -763,7 +765,7 @@ let () =
(fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
lwt site_user = Web_site_auth.get_user () in
lwt site_user = Web_auth_state.get_site_user () in
lwt is_featured = Web_persist.is_featured_election uuid_s in
let module W = (val w : WEB_ELECTION) in
let uuid = Uuidm.to_string W.election.e_params.e_uuid in
......@@ -782,7 +784,7 @@ let () =
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
lwt () =
match_lwt Web_site_auth.get_user () with
match_lwt Web_auth_state.get_site_user () with
| Some u when W.metadata.e_owner = Some u -> return ()
| _ -> forbidden ()
in
......@@ -795,33 +797,13 @@ let () =
Web_persist.set_election_state uuid_s state >>
Redirection.send (preapply election_admin (uuid, ())))
let () =
Any.register
~service:election_login
(fun ((uuid, ()), service) () ->
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
lwt cont = Eliom_reference.get Web_services.cont in
W.Auth.Handlers.login service cont ())
let () =
Any.register
~service:election_logout
(fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
lwt cont = Eliom_reference.get Web_services.cont in
W.Auth.Handlers.logout cont ())
let () =
Any.register
~service:election_update_credential
(fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
lwt site_user = Web_site_auth.get_user () in
lwt site_user = Web_auth_state.get_site_user () in
let module W = (val w : WEB_ELECTION) in
match site_user with
| Some u ->
......@@ -838,7 +820,7 @@ let () =
(fun (uuid, ()) (old, new_) ->
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
lwt site_user = Web_site_auth.get_user () in
lwt site_user = Web_auth_state.get_site_user () in
let module W = (val w : WEB_ELECTION) in
match site_user with
| Some u ->
......@@ -862,12 +844,6 @@ let () =
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
Eliom_reference.unset Web_services.ballot >>
let cont () () =
Redirection.send
(Eliom_service.preapply
election_vote (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_services.cont cont >>
Redirection.send
(Eliom_service.preapply
(Eliom_service.static_dir_with_params
......@@ -882,12 +858,12 @@ let () =
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
let cont () () =
let cont () =
Redirection.send
(Eliom_service.preapply
election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_services.cont cont >>
Eliom_reference.set Web_auth_state.cont [cont] >>
match_lwt Eliom_reference.get Web_services.ballot with
| Some b -> T.cast_confirmation w (sha256_b64 b) () >>= Html5.send
| None -> T.cast_raw w () >>= Html5.send)
......@@ -899,7 +875,7 @@ let () =
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
lwt user = W.Auth.Services.get_user () in
lwt user = Web_auth_state.get_election_user uuid in
lwt the_ballot = match ballot_raw, ballot_file with
| Some ballot, None -> return ballot
| None, Some fi ->
......@@ -907,12 +883,12 @@ let () =
Lwt_stream.to_string (Lwt_io.chars_of_file fname)
| _, _ -> fail_http 400
in
let cont () () =
let cont () =
Redirection.send
(Eliom_service.preapply
Web_services.election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_services.cont cont >>
Eliom_reference.set Web_auth_state.cont [cont] >>
Eliom_reference.set Web_services.ballot (Some the_ballot) >>
match user with
| None ->
......@@ -920,7 +896,7 @@ let () =
(Eliom_service.preapply
Web_services.election_login
((W.election.e_params.e_uuid, ()), None))
| Some u -> cont () ())
| Some u -> cont ())
let () =
Any.register
......@@ -933,7 +909,7 @@ let () =
| Some the_ballot ->
begin
Eliom_reference.unset Web_services.ballot >>
match_lwt W.Auth.Services.get_user () with
match_lwt Web_auth_state.get_election_user uuid with
| Some u ->
let record = string_of_user u, now () in
lwt result =
......@@ -1061,7 +1037,7 @@ let () =
let w = SMap.find uuid_s !election_table in
let module W = (val w) in
lwt () =
match_lwt Web_site_auth.get_user () with
match_lwt Web_auth_state.get_site_user () with
| Some u when W.metadata.e_owner = Some u -> return ()
| _ -> forbidden ()
in
......@@ -1117,15 +1093,8 @@ let () =
(fun (uuid, f) () ->
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
lwt site_user = Web_site_auth.get_user () in
lwt site_user = Web_auth_state.get_site_user () in
let module W = (val w : WEB_ELECTION) in
let cont () () =
Redirection.send
(Eliom_service.preapply
election_dir
(W.election.e_params.e_uuid, f))
in
Eliom_reference.set Web_services.cont cont >>
handle_pseudo_file w () f site_user)
let () =
......@@ -1136,7 +1105,7 @@ let () =
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
lwt () =
match_lwt Web_site_auth.get_user () with
match_lwt Web_auth_state.get_site_user () with
| Some u when W.metadata.e_owner = Some u -> return ()
| _ -> forbidden ()
in
......
......@@ -19,29 +19,251 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
module C = struct
let name = "site"
let path = []
let kind = `Site
end
open Lwt
open Eliom_service
open Platform
open Web_serializable_t
open Web_common
open Web_auth_state
open Web_services
module A = Web_auth.Make (C)
let configure = A.configure
include A.Services
let next_lf str i =
try Some (String.index_from str i '\n')
with Not_found -> None
open Eliom_registration
open Web_services
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 "" auth_config |> Lwt_unix.run;
List.iter (fun {auth_system; auth_instance; auth_config} ->
match auth_system with
| "password" ->
let table = Ocsipersist.open_table "password_site" in
(match auth_config with
| [] -> ()
| ["db", file] ->
Ocsigen_messages.debug (fun () ->
Printf.sprintf "Loading passwords from file %s" file
);
let db = Csv.load file in
List.iter (function
| username :: salt :: password :: _ ->
Ocsipersist.add table username (salt, password) |> Lwt_unix.run
| _ -> failwith ("error while loading " ^ file)) db
| _ -> failwith "error in passwords configuration")
| _ -> ()
) x
let scope = Eliom_common.default_session_scope
let auth_env = Eliom_reference.eref ~scope None
let default_cont uuid () =
match_lwt cont_pop () with
| Some f -> f ()
| None ->
match uuid with
| None ->
Eliom_registration.Redirection.send Web_services.admin
| Some u ->
Eliom_registration.Redirection.send (preapply Web_services.election_home (u, ()))
let dummy_handler () name =
match_lwt Eliom_reference.get auth_env with
| None -> failwith "dummy handler was invoked without environment"
| Some (uuid, service) ->
let logout () =
Eliom_reference.unset user >>
default_cont uuid ()
in
Eliom_reference.set user (Some {uuid; service; name; logout}) >>
Eliom_reference.unset auth_env >>
default_cont uuid ()
let () = Eliom_registration.Any.register ~service:dummy_post dummy_handler
let password_handler () (name, password) =
lwt uuid, service =
match_lwt Eliom_reference.get auth_env with
| None -> failwith "password handler was invoked without environment"
| Some x -> return x
in
let table =
"password_" ^
match uuid with
| None -> "site"
| Some u ->
let u = Uuidm.to_string u in
for i = 0 to String.length u - 1 do
if u.[i] = '-' then u.[i] <- '_'
done; u
in
let table = Ocsipersist.open_table table in
lwt salt, hashed =
try_lwt Ocsipersist.find table name
with Not_found -> fail_http 401
in
if sha256_hex (salt ^ password) = hashed then
let logout () =
Eliom_reference.unset user >>
default_cont uuid ()
in
Eliom_reference.set user (Some {uuid; service; name; logout}) >>
Eliom_reference.unset auth_env >>
default_cont uuid ()
else
fail_http 401
let () = Eliom_registration.Any.register ~service:password_post password_handler
let cas_server = Eliom_reference.eref ~scope None
let login_cas = Eliom_service.Http.service
~path:["auth"; "cas"]
~get_params:Eliom_parameter.(opt (string "ticket"))
()
let cas_self =
(* lazy so rewrite_prefix is called after server initialization *)
lazy (Eliom_uri.make_string_uri
~absolute:true
~service:(preapply login_cas None)
() |> rewrite_prefix)
let cas_handler ticket () =
lwt uuid, service =
match_lwt Eliom_reference.get auth_env with
| None -> failwith "cas handler was invoked without environment"
| Some x -> return x
in
match ticket with
| Some x ->