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
420607b2
Commit
420607b2
authored
Mar 06, 2014
by
Stephane Glondu
Browse files
Rename LOGOUT_HANDLER into CONT_SERVICE
As in "continuation". This is more generic than just logging out...
parent
9f13fa67
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/web/auth_common.ml
View file @
420607b2
...
...
@@ -31,7 +31,7 @@ type user = {
type
logged_user
=
{
user_admin
:
bool
;
user_user
:
user
;
user_logout
:
(
module
LOGOUT_HANDLER
);
user_logout
:
(
module
CONT_SERVICE
);
}
let
string_of_user
{
user_type
;
user_name
}
=
...
...
@@ -106,18 +106,18 @@ module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) (T : TEMPLATES) = struct
let
module
L
=
(
val
u
.
user_logout
)
in
security_log
(
fun
()
->
string_of_user
u
.
user_user
^
" logged out"
)
>>
L
.
logou
t
()
)
>>
L
.
con
t
()
|
_
->
S
.
get
()
)
module
DefaultLogout
:
LOGOUT_HANDLER
=
struct
let
logou
t
=
S
.
get
module
DefaultLogout
:
CONT_SERVICE
=
struct
let
con
t
=
S
.
get
end
let
()
=
if
C
.
enable_dummy
then
(
let
user_admin
=
false
in
let
user_type
=
"dummy"
in
let
user_logout
=
(
module
DefaultLogout
:
LOGOUT_HANDLER
)
in
let
user_logout
=
(
module
DefaultLogout
:
CONT_SERVICE
)
in
let
service
=
Eliom_service
.
service
~
path
:
[
"login-dummy"
]
~
get_params
:
Eliom_parameter
.
unit
...
...
@@ -154,7 +154,7 @@ module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) (T : TEMPLATES) = struct
|
Some
db
->
let
user_admin
=
false
in
let
user_type
=
"password"
in
let
user_logout
=
(
module
DefaultLogout
:
LOGOUT_HANDLER
)
in
let
user_logout
=
(
module
DefaultLogout
:
CONT_SERVICE
)
in
let
service
=
Eliom_service
.
service
~
path
:
[
"login-password"
]
~
get_params
:
Eliom_parameter
.
unit
...
...
@@ -244,8 +244,8 @@ module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) (T : TEMPLATES) = struct
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
:
LOGOUT_HANDLER
=
struct
let
logou
t
()
=
let
module
L
:
CONT_SERVICE
=
struct
let
con
t
()
=
lwt
service
=
S
.
get
()
in
let
uri
=
Eliom_uri
.
make_string_uri
~
absolute
:
true
~
service
()
in
let
uri
=
C
.
rewrite_prefix
uri
in
...
...
@@ -254,7 +254,7 @@ module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) (T : TEMPLATES) = struct
)
>>
Lwt
.
return
(
Eliom_service
.
preapply
cas_logout
uri
)
end
in
let
user_logout
=
(
module
L
:
LOGOUT_HANDLER
)
in
let
user_logout
=
(
module
L
:
CONT_SERVICE
)
in
let
user_admin
=
false
in
security_log
(
fun
()
->
user_name
^
" successfully logged in using CAS"
...
...
@@ -302,7 +302,7 @@ module Register (C : AUTH_CONFIG) (S : ALL_SERVICES) (T : TEMPLATES) = struct
(
fun
()
user_name
->
if
sha256_hex
user_name
=
C
.
admin_hash
then
(
let
user_type
=
"password"
in
let
user_logout
=
(
module
DefaultLogout
:
LOGOUT_HANDLER
)
in
let
user_logout
=
(
module
DefaultLogout
:
CONT_SERVICE
)
in
let
user_user
=
{
user_type
;
user_name
}
in
let
user_admin
=
true
in
Eliom_reference
.
set
user
(
Some
{
user_admin
;
user_user
;
user_logout
})
>>
...
...
src/web/auth_common.mli
View file @
420607b2
...
...
@@ -29,7 +29,7 @@ type user = {
type
logged_user
=
{
user_admin
:
bool
;
user_user
:
user
;
user_logout
:
(
module
LOGOUT_HANDLER
);
user_logout
:
(
module
CONT_SERVICE
);
}
val
string_of_user
:
user
->
string
...
...
src/web/web_signatures.mli
View file @
420607b2
...
...
@@ -185,8 +185,8 @@ module type ALL_SERVICES = sig
end
module
type
LOGOUT_HANDLER
=
sig
val
logou
t
:
module
type
CONT_SERVICE
=
sig
val
con
t
:
unit
->
(
unit
,
unit
,
[
>
`Attached
of
...
...
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