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

Move authentication services to site

parent 7c03532f
......@@ -93,16 +93,6 @@ module Make (N : CONFIG) = struct
| Some u -> return (Some u.user_user)
| None -> return None
let login = Eliom_service.Http.service
~path:(N.path @ ["login"])
~get_params:Eliom_parameter.(opt (string "service"))
()
let logout = Eliom_service.Http.service
~path:(N.path @ ["logout"])
~get_params:Eliom_parameter.unit
()
end
let login_handler service cont =
......@@ -138,7 +128,7 @@ module Make (N : CONFIG) = struct
end
module Register (S : SITE) (T : LOGIN_TEMPLATES) : EMPTY = struct
module Register (S : SITE) (T : LOGIN_TEMPLATES) : AUTH_HANDLERS_RAW = struct
let () = login_choose := T.choose
......@@ -169,15 +159,13 @@ module Make (N : CONFIG) = struct
)
) N.auth_config
let () = Eliom_registration.Any.register
~service:Services.login
let login =
(fun service () ->
lwt cont = Eliom_reference.get S.cont in
login_handler service cont
)
let () = Eliom_registration.Any.register
~service:Services.logout
let logout =
(fun () () ->
lwt cont = Eliom_reference.get S.cont in
Handlers.do_logout cont ()
......
......@@ -37,5 +37,5 @@ end
module Make (C : CONFIG) : sig
module Services : AUTH_SERVICES
module Handlers : AUTH_HANDLERS_PUBLIC
module Register (S : SITE) (T : LOGIN_TEMPLATES) : EMPTY
module Register (S : SITE) (T : LOGIN_TEMPLATES) : AUTH_HANDLERS_RAW
end
......@@ -281,7 +281,12 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
module Register (S : SITE) (T : TEMPLATES) : ELECTION_HANDLERS = struct
open Eliom_registration
let () = let module X : EMPTY = Auth.Register (S) (T.Login (W.S)) in ()
module L = struct
let login x = Eliom_service.preapply S.election_login ((W.election.e_params.e_uuid, ()), x)
let logout = Eliom_service.preapply S.election_logout (W.election.e_params.e_uuid, ())
end
include Auth.Register (S) (T.Login (W.S) (L))
module T = T.Election (W)
......
......@@ -32,14 +32,18 @@ module type AUTH_SERVICES = sig
val get_auth_systems : unit -> string list
val get_user : unit -> user option Lwt.t
end
module type AUTH_LINKS = sig
val login :
(string option, unit,
string option ->
(unit, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ],
[ `One of string ] Eliom_parameter.param_name, unit,
[< Eliom_service.registrable > `Registrable ],
[ `WithoutSuffix ], unit, unit,
[< Eliom_service.registrable > `Unregistrable ],
[> Eliom_service.http_service ])
Eliom_service.service
......@@ -49,7 +53,7 @@ module type AUTH_SERVICES = sig
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ], unit, unit,
[< Eliom_service.registrable > `Registrable ],
[< Eliom_service.registrable > `Unregistrable ],
[> Eliom_service.http_service ])
Eliom_service.service
......@@ -245,6 +249,31 @@ module type ELECTION_SERVICES_SITE =
[> Eliom_service.http_service ])
Eliom_service.service
val election_login :
((Uuidm.t * unit) * string option, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithSuffix ],
([ `One of Uuidm.t ] Eliom_parameter.param_name *
[ `One of unit ] Eliom_parameter.param_name) *
[ `One of string ] Eliom_parameter.param_name, unit,
[< Eliom_service.registrable > `Registrable ],
[> Eliom_service.http_service ])
Eliom_service.service
val election_logout :
(Uuidm.t * unit, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithSuffix ],
[ `One of Uuidm.t ] Eliom_parameter.param_name *
[ `One of unit ] Eliom_parameter.param_name, unit,
[< Eliom_service.registrable > `Registrable ],
[> Eliom_service.http_service ])
Eliom_service.service
val election_set_featured :
(Uuidm.t * unit, bool,
[> `Attached of
......@@ -370,6 +399,27 @@ module type CORE_SERVICES = sig
[> Eliom_service.http_service ])
Eliom_service.service
val site_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 ],
[> Eliom_service.http_service ])
Eliom_service.service
val site_logout :
(unit, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ], unit, unit,
[< Eliom_service.registrable > `Registrable ],
[> Eliom_service.http_service ])
Eliom_service.service
val source_code :
(unit, unit,
[> `Attached of
......@@ -441,6 +491,8 @@ type content =
module type ELECTION_HANDLERS =
sig
val login : string option -> unit -> content
val logout : unit -> unit -> content
val home : unit -> unit -> content
val admin : unit -> unit -> content
val election_dir : Web_common.election_file -> unit -> content
......@@ -453,6 +505,12 @@ module type ELECTION_HANDLERS =
val election_cast_confirm : unit -> unit -> content
end
module type AUTH_HANDLERS_RAW =
sig
val login : string option -> unit -> content
val logout : unit -> unit -> content
end
type service_handler = unit ->
Eliom_registration.browser_content Eliom_registration.kind Lwt.t
......@@ -632,7 +690,7 @@ module type TEMPLATES = sig
string -> string -> Web_common.setup_election -> unit ->
[> `Html ] Eliom_content.Html5.F.elt Lwt.t
module Login (S : AUTH_SERVICES) : LOGIN_TEMPLATES
module Login (S : AUTH_SERVICES) (L : AUTH_LINKS) : LOGIN_TEMPLATES
module Election (W : WEB_ELECTION_) : ELECTION_TEMPLATES
end
......
......@@ -127,6 +127,18 @@ module Make (C : CONFIG) : SITE = struct
~get_params:unit
()
let site_login =
service
~path:(make_path ["login"])
~get_params:(opt (string "service"))
()
let site_logout =
service
~path:(make_path ["logout"])
~get_params:unit
()
let source_code = service
~path:(make_path ["belenios.tar.gz"])
~get_params:unit
......@@ -238,6 +250,20 @@ module Make (C : CONFIG) : SITE = struct
~get_params:(suffix (uuid "uuid" ** suffix_const "admin"))
()
let election_login =
service
~path:(make_path ["elections"])
~get_params:(suffix_prod
(uuid "uuid" ** suffix_const "login")
(opt (string "service")))
()
let election_logout =
service
~path:(make_path ["elections"])
~get_params:(suffix (uuid "uuid" ** suffix_const "logout"))
()
let election_set_featured =
post_coservice
~fallback:election_admin
......@@ -473,7 +499,12 @@ module Make (C : CONFIG) : SITE = struct
return ()
) election_ptable
let () = let module X : EMPTY = Auth.Register (S) (T.Login (S)) in ()
module L = struct
let login x = Eliom_service.preapply S.site_login x
let logout = Eliom_service.preapply S.site_logout ()
end
module Z = Auth.Register (S) (T.Login (S) (L))
let () = Any.register ~service:home
(fun () () ->
......@@ -511,6 +542,9 @@ module Make (C : CONFIG) : SITE = struct
T.admin ~elections ()
)
let () = Any.register ~service:site_login Z.login
let () = Any.register ~service:site_logout Z.logout
let () = File.register
~service:source_code
~content_type:"application/x-gzip"
......@@ -931,6 +965,24 @@ module Make (C : CONFIG) : SITE = struct
let module W = (val w : WEB_ELECTION) in
W.Z.admin () ())
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
W.Z.login service ())
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
W.Z.logout () ())
let () =
Any.register
~service:election_update_credential
......
......@@ -37,9 +37,10 @@ let admin_background = " background: #FF9999;"
let format_user u =
em [pcdata (Web_auth.(string_of_user u))]
let make_login_box style auth =
let make_login_box style auth links =
let style = "float: right; text-align: right;" ^ style in
let module S = (val auth : AUTH_SERVICES) in
let module L = (val links : AUTH_LINKS) in
lwt user = S.get_user () in
return @@ div ~a:[a_style style] (
match user with
......@@ -51,7 +52,7 @@ let make_login_box style auth =
pcdata ".";
];
div [
a ~service:S.logout [pcdata "Log out"] ();
a ~service:L.logout [pcdata "Log out"] ();
pcdata ".";
];
]
......@@ -63,7 +64,7 @@ let make_login_box style auth =
let auth_systems =
S.get_auth_systems () |>
List.map (fun name ->
a ~service:S.login [pcdata name] (Some name)
a ~service:(L.login (Some name)) [pcdata name] ()
) |> list_join (pcdata ", ")
in
div (
......@@ -76,7 +77,12 @@ module Make (S : SITE_SERVICES) : TEMPLATES = struct
let site_login_box =
let auth = (module S : AUTH_SERVICES) in
fun () -> make_login_box admin_background auth
let module L = struct
let login x = Eliom_service.preapply S.site_login x
let logout = Eliom_service.preapply S.site_logout ()
end in
let links = (module L : AUTH_LINKS) in
fun () -> make_login_box admin_background auth links
let base ~title ~login_box ~content =
Lwt.return (html ~a:[a_dir `Ltr; a_xml_lang "en"]
......@@ -158,14 +164,15 @@ module Make (S : SITE_SERVICES) : TEMPLATES = struct
lwt login_box = site_login_box () in
base ~title ~login_box ~content
module Login (S : AUTH_SERVICES) : LOGIN_TEMPLATES = struct
module Login (S : AUTH_SERVICES) (L : AUTH_LINKS) : LOGIN_TEMPLATES = struct
let login_box =
let auth = (module S : AUTH_SERVICES) in
let links = (module L : AUTH_LINKS) in
let style =
if S.auth_realm = "site" then admin_background else ""
in
fun () -> make_login_box style auth
fun () -> make_login_box style auth links
let dummy ~service () =
let title, field_name, input_type =
......@@ -242,7 +249,7 @@ module Make (S : SITE_SERVICES) : TEMPLATES = struct
let auth_systems =
S.get_auth_systems () |>
List.map (fun name ->
a ~service:S.login [pcdata name] (Some name)
a ~service:(L.login (Some name)) [pcdata name] ()
) |> list_join (pcdata ", ")
in
let content = [
......@@ -499,7 +506,18 @@ module Make (S : SITE_SERVICES) : TEMPLATES = struct
let election_login_box =
let auth = (module W.S : AUTH_SERVICES) in
fun () -> make_login_box "" auth
let module L = struct
let login x =
Eliom_service.preapply
S.election_login
((W.election.e_params.e_uuid, ()), x)
let logout =
Eliom_service.preapply
S.election_logout
(W.election.e_params.e_uuid, ())
end in
let links = (module L : AUTH_LINKS) in
fun () -> make_login_box "" auth links
let file x =
Eliom_service.preapply
......
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