Skip to content

GitLab

Commit 2433d9ce authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Move each auth system to its own module

parent 420607b2
Hide whitespace changes
Inline Side-by-side
Showing with 295 additions and 176 deletions
src/web/auth_cas.ml 0 → 100644
View file @ 2433d9ce
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2014 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 Web_signatures
open Web_common
open Auth_common
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
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
(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
in
let validation =
let service = Eliom_service.preapply cas_validate (me, x) in
Eliom_uri.make_string_uri ~absolute:true ~service ()
in
lwt reply = Ocsigen_http_client.get_url validation in
(match reply.Ocsigen_http_frame.frame_content with
| Some stream ->
lwt info = Ocsigen_stream.(string_of_stream 1000 (get stream)) in
Ocsigen_stream.finalize stream `Success >>
(match next_lf info 0 with
| Some i ->
(match String.sub info 0 i with
| "yes" ->
(match next_lf info (i+1) with
| Some j ->
let user_name = String.sub info (i+1) (j-i-1) in
let user_user = {user_type; user_name} in
let module L : CONT_SERVICE = struct
let cont () =
lwt service = S.get () in
let uri = Eliom_uri.make_string_uri ~absolute:true ~service () in
let uri = C.rewrite_prefix uri in
security_log (fun () ->
string_of_user user_user ^ " logged out, redirecting to CAS"
) >> 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 ()
| None -> fail_http 502
)
| "no" -> fail_http 401
| _ -> fail_http 502
)
| None -> fail_http 502
)
| 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
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
src/web/auth_cas.mli 0 → 100644
View file @ 2433d9ce
open Web_signatures
module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) : EMPTY
src/web/auth_common.ml
View file @ 2433d9ce
......@@ -63,10 +63,6 @@ module Make (X : EMPTY) = struct
end
let next_lf str i =
try Some (String.index_from str i '\n')
with Not_found -> None
let auth_system_map = ref []
let register_auth_system name service =
......@@ -114,176 +110,6 @@ module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) (T : TEMPLATES) = struct
let cont = S.get
end
let () = if C.enable_dummy then (
let user_admin = false in
let user_type = "dummy" in
let user_logout = (module DefaultLogout : CONT_SERVICE) in
let service = Eliom_service.service
~path:["login-dummy"]
~get_params:Eliom_parameter.unit
()
in
let () = Eliom_registration.Html5.register ~service
(fun () () ->
let post_params = Eliom_parameter.(string "username") in
let service = Eliom_service.post_coservice
~csrf_safe:true
~csrf_scope:Eliom_common.default_session_scope
~fallback:service
~post_params ()
in
let () = Eliom_registration.Redirection.register ~service
~scope:Eliom_common.default_session_scope
(fun () user_name ->
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 ())
in T.string_login ~service ~kind:`Dummy
)
in
let module A = struct let service = service end in
let auth_system = (module A : AUTH_SYSTEM) in
register_auth_system "dummy" auth_system
)
let () = match C.password_db with
| None -> ()
| Some db ->
let user_admin = false in
let user_type = "password" in
let user_logout = (module DefaultLogout : CONT_SERVICE) in
let service = Eliom_service.service
~path:["login-password"]
~get_params:Eliom_parameter.unit
()
in
let () = Eliom_registration.Html5.register ~service
(fun () () ->
let post_params = Eliom_parameter.(
string "username" ** string "password"
) in
let service = Eliom_service.post_coservice
~csrf_safe:true
~csrf_scope:Eliom_common.default_session_scope
~fallback:service
~post_params ()
in
let () = Eliom_registration.Redirection.register ~service
~scope:Eliom_common.default_session_scope
(fun () (user_name, password) ->
if (
try
let salt, hashed = SMap.find user_name db in
sha256_hex (salt ^ password) = hashed
with Not_found -> false
) 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 ()
) else forbidden ())
in T.password_login ~service
)
in
let module A = struct let service = service end in
let auth_system = (module A : AUTH_SYSTEM) in
register_auth_system "password" auth_system
let () = if C.enable_cas then (
let cas_login = Eliom_service.external_service
~prefix:C.cas_server
~path:["login"]
~get_params:Eliom_parameter.(string "service")
()
in
let cas_logout = Eliom_service.external_service
~prefix:C.cas_server
~path:["logout"]
~get_params:Eliom_parameter.(string "service")
()
in
let cas_validate = Eliom_service.external_service
~prefix:C.cas_server
~path:["validate"]
~get_params:Eliom_parameter.(string "service" ** string "ticket")
()
in
let login_cas = Eliom_service.service
~path:["login-cas"]
~get_params:Eliom_parameter.(opt (string "ticket"))
()
in
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
in
let validation =
let service = Eliom_service.preapply cas_validate (me, x) in
Eliom_uri.make_string_uri ~absolute:true ~service ()
in
lwt reply = Ocsigen_http_client.get_url validation in
(match reply.Ocsigen_http_frame.frame_content with
| Some stream ->
lwt info = Ocsigen_stream.(string_of_stream 1000 (get stream)) in
Ocsigen_stream.finalize stream `Success >>
(match next_lf info 0 with
| Some i ->
(match String.sub info 0 i with
| "yes" ->
(match next_lf info (i+1) with
| Some j ->
let user_name = String.sub info (i+1) (j-i-1) in
let user_type = "cas" in
let user_user = {user_type; user_name} in
let module L : CONT_SERVICE = struct
let cont () =
lwt service = S.get () in
let uri = Eliom_uri.make_string_uri ~absolute:true ~service () in
let uri = C.rewrite_prefix uri in
security_log (fun () ->
string_of_user user_user ^ " logged out, redirecting to CAS"
) >>
Lwt.return (Eliom_service.preapply cas_logout uri)
end in
let user_logout = (module L : CONT_SERVICE) in
let user_admin = false in
security_log (fun () ->
user_name ^ " successfully logged in using CAS"
) >>
Eliom_reference.set user
(Some {user_admin; user_user; user_logout}) >>
S.get ()
| None -> fail_http 502
)
| "no" -> fail_http 401
| _ -> fail_http 502
)
| None -> fail_http 502
)
| 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
Lwt.return (Eliom_service.preapply cas_login uri)
)
in
let service = Eliom_service.preapply login_cas None in
let module A = struct let service = service end in
let auth_system = (module A : AUTH_SYSTEM) in
register_auth_system "CAS" auth_system
)
let login_admin = Eliom_service.service
~path:["login-admin"]
~get_params:Eliom_parameter.unit
......
src/web/auth_dummy.ml 0 → 100644
View file @ 2433d9ce
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2014 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 Web_signatures
open Auth_common
module Register (S : ALL_SERVICES) (T : TEMPLATES) = struct
module L : CONT_SERVICE = struct
let cont = S.get
end
let user_admin = false
let user_type = "dummy"
let user_logout = (module L : CONT_SERVICE)
module A : AUTH_SYSTEM = struct
let service = Eliom_service.service
~path:["login-dummy"]
~get_params:Eliom_parameter.unit
()
let () = Eliom_registration.Html5.register ~service
(fun () () ->
let post_params = Eliom_parameter.(string "username") in
let service = Eliom_service.post_coservice
~csrf_safe:true
~csrf_scope:Eliom_common.default_session_scope
~fallback:service
~post_params ()
in
let () = Eliom_registration.Redirection.register ~service
~scope:Eliom_common.default_session_scope
(fun () user_name ->
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 ())
in T.string_login ~service ~kind:`Dummy
)
end
let () = register_auth_system "dummy" (module A : AUTH_SYSTEM)
end
src/web/auth_dummy.mli 0 → 100644
View file @ 2433d9ce
open Web_signatures
module Register (S : ALL_SERVICES) (T : TEMPLATES) : EMPTY
src/web/auth_password.ml 0 → 100644
View file @ 2433d9ce
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2014 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 Util
open Web_signatures
open Web_common
open Auth_common
module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) (T : TEMPLATES) = struct
module L : CONT_SERVICE = struct
let cont = S.get
end
let user_admin = false
let user_type = "password"
let user_logout = (module L : CONT_SERVICE)
let db = match C.password_db with
| None -> assert false
| Some db -> db
module A = struct
let service = Eliom_service.service
~path:["login-password"]
~get_params:Eliom_parameter.unit
()
let () = Eliom_registration.Html5.register ~service
(fun () () ->
let post_params = Eliom_parameter.(
string "username" ** string "password"
) in
let service = Eliom_service.post_coservice
~csrf_safe:true
~csrf_scope:Eliom_common.default_session_scope
~fallback:service
~post_params ()
in
let () = Eliom_registration.Redirection.register ~service
~scope:Eliom_common.default_session_scope
(fun () (user_name, password) ->
if (
try
let salt, hashed = SMap.find user_name db in
sha256_hex (salt ^ password) = hashed
with Not_found -> false
) 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 ()
) else forbidden ())
in T.password_login ~service
)
end
let () = register_auth_system "password" (module A : AUTH_SYSTEM)
end
src/web/auth_password.mli 0 → 100644
View file @ 2433d9ce
open Web_signatures
module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) (T : TEMPLATES) : EMPTY
src/web/registration.ml
View file @ 2433d9ce
......@@ -351,14 +351,27 @@ end
module T = Templates.Make (S)
module A = Auth_common.Register (struct
module C = struct
let enable_cas = !enable_cas
let cas_server = !cas_server
let password_db = password_db
let enable_dummy = !enable_dummy
let admin_hash = !admin_hash
let rewrite_prefix = rewrite_prefix
end) (S) (T)
end
module A = Auth_common.Register (C) (S) (T)
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 () =
match main_election with
......
src/web/server.mllib
View file @ 2433d9ce
......@@ -3,6 +3,9 @@ Serializable_builtin_j
Serializable_j
Web_common
Auth_common
Auth_dummy
Auth_password
Auth_cas
Web_election
Election
Services
......
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