Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
belenios
belenios
Commits
3ae20596
Commit
3ae20596
authored
Mar 20, 2015
by
Stephane Glondu
Browse files
Drop AUTH_SERVICES argument of Web_auth.Make.configure
parent
001ab016
Changes
5
Hide whitespace changes
Inline
Side-by-side
src/web/web_auth.ml
View file @
3ae20596
...
...
@@ -73,7 +73,40 @@ module Make (N : NAME) = struct
(* Forward reference, will be set to eponymous template *)
let
login_choose
=
ref
(
fun
()
->
assert
false
)
let
configure
auth_services
xs
=
let
user
=
Eliom_reference
.
eref
~
scope
None
let
do_login_using
user_domain
cont
=
try
let
user_handlers
=
Hashtbl
.
find
auth_instances
user_domain
in
let
cont
user_name
()
=
let
user_user
=
{
user_domain
;
user_name
}
in
let
logged_user
=
{
user_user
;
user_handlers
}
in
security_log
(
fun
()
->
Printf
.
sprintf
"[%s] %s logged in"
N
.
name
(
string_of_user
user_user
)
)
>>
Eliom_reference
.
set
user
(
Some
logged_user
)
>>
cont
()
()
in
let
module
A
=
(
val
user_handlers
:
AUTH_HANDLERS
)
in
A
.
login
cont
()
with
Not_found
->
fail_http
404
module
Services
:
AUTH_SERVICES
=
struct
let
auth_realm
=
N
.
name
let
get_auth_systems
()
=
!
auth_instance_names
let
get_user
()
=
match_lwt
Eliom_reference
.
get
user
with
|
Some
u
->
return
(
Some
u
.
user_user
)
|
None
->
return
None
end
let
configure
xs
=
let
auth_services
=
(
module
Services
:
AUTH_SERVICES
)
in
login_choose
:=
Web_templates
.
choose
auth_services
links
;
List
.
iter
(
fun
auth_instance
->
...
...
@@ -105,46 +138,13 @@ module Make (N : NAME) = struct
let
path
=
N
.
path
@
[
"auth"
;
instance
]
let
kind
=
N
.
kind
end
in
let
module
S
=
(
val
auth_services
:
AUTH_SERVICES
)
in
let
module
A
=
(
val
auth
:
AUTH_SERVICE
)
(
N
)
(
S
)
in
let
module
A
=
(
val
auth
:
AUTH_SERVICE
)
(
N
)
(
Services
)
in
let
i
=
(
module
A
:
AUTH_HANDLERS
)
in
Hashtbl
.
add
auth_instances
instance
i
;
auth_instance_names
:=
instance
::
!
auth_instance_names
)
)
xs
let
user
=
Eliom_reference
.
eref
~
scope
None
let
do_login_using
user_domain
cont
=
try
let
user_handlers
=
Hashtbl
.
find
auth_instances
user_domain
in
let
cont
user_name
()
=
let
user_user
=
{
user_domain
;
user_name
}
in
let
logged_user
=
{
user_user
;
user_handlers
}
in
security_log
(
fun
()
->
Printf
.
sprintf
"[%s] %s logged in"
N
.
name
(
string_of_user
user_user
)
)
>>
Eliom_reference
.
set
user
(
Some
logged_user
)
>>
cont
()
()
in
let
module
A
=
(
val
user_handlers
:
AUTH_HANDLERS
)
in
A
.
login
cont
()
with
Not_found
->
fail_http
404
module
Services
:
AUTH_SERVICES
=
struct
let
auth_realm
=
N
.
name
let
get_auth_systems
()
=
!
auth_instance_names
let
get_user
()
=
match_lwt
Eliom_reference
.
get
user
with
|
Some
u
->
return
(
Some
u
.
user_user
)
|
None
->
return
None
end
let
login_handler
service
cont
=
let
cont
()
()
=
match
service
with
...
...
src/web/web_auth.mli
View file @
3ae20596
...
...
@@ -29,7 +29,7 @@ val register_auth_system : (module AUTH_SYSTEM) -> unit
module
MakeLinks
(
N
:
NAME
)
:
AUTH_LINKS
module
Make
(
C
:
NAME
)
:
sig
val
configure
:
(
module
AUTH_SERVICES
)
->
auth_config
list
->
unit
val
configure
:
auth_config
list
->
unit
module
Services
:
AUTH_SERVICES
module
Handlers
:
AUTH_HANDLERS_PUBLIC
end
src/web/web_election.ml
View file @
3ae20596
...
...
@@ -278,7 +278,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
open
Eliom_registration
let
()
=
Auth
.
configure
(
module
W
.
S
:
AUTH_SERVICES
)
N
.
auth_config
Auth
.
configure
N
.
auth_config
let
login
service
()
=
lwt
cont
=
Eliom_reference
.
get
Web_services
.
cont
in
...
...
src/web/web_site.ml
View file @
3ae20596
...
...
@@ -225,7 +225,7 @@ lwt () =
)
election_ptable
let
install_authentication
auth_configs
=
Web_site_auth
.
configure
(
module
Web_site_auth
:
AUTH_SERVICES
)
auth_configs
Web_site_auth
.
configure
auth_configs
let
()
=
Any
.
register
~
service
:
home
(
fun
()
()
->
...
...
src/web/web_site_auth.mli
View file @
3ae20596
open
Web_serializable_t
open
Web_signatures
val
configure
:
(
module
AUTH_SERVICES
)
->
auth_config
list
->
unit
val
configure
:
auth_config
list
->
unit
include
AUTH_SERVICES
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment