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
96f09d36
Commit
96f09d36
authored
Mar 23, 2014
by
Stephane Glondu
Browse files
Split Registration into Web_site and Web_main
parent
60cb2f27
Changes
6
Hide whitespace changes
Inline
Side-by-side
src/web/server.mllib
View file @
96f09d36
...
...
@@ -10,4 +10,5 @@ Auth_cas
Web_election
Election
Templates
Registration
Web_site
Web_main
src/web/
registratio
n.ml
→
src/web/
web_mai
n.ml
View file @
96f09d36
...
...
@@ -142,122 +142,27 @@ lwt election_configs =
Lwt_list
.
map_p
parse_election_dir
!
data_dirs
>>=
wrap1
List
.
flatten
(** Build up the site *)
module
Site
:
SITE_SERVICES
=
struct
open
Eliom_service
open
Eliom_registration
module
Auth
=
Auth_common
.
Make
(
struct
let
name
=
"site"
let
path
=
[]
let
instances
=
!
auth_instances
end
)
let
main_election
=
ref
None
let
featured
=
ref
[]
(* The following reference is there to cut a dependency loop:
S.register_election depends on S (via Templates). It will be set
to a proper value once we have called Templates.Make. *)
let
register_election_ref
=
ref
(
fun
_
->
assert
false
)
(* We use an intermediate module S that will be passed to Templates
and Web_election. S is not meant to leak and will be included
in the returned module later. *)
module
S
:
SITE_SERVICES
=
struct
include
Auth
.
Services
open
Eliom_parameter
let
home
=
service
~
path
:
[]
~
get_params
:
unit
()
let
source_code
=
service
~
path
:
[
"belenios.tar.gz"
]
~
get_params
:
unit
()
let
get_randomness
=
service
~
path
:
[
"get-randomness"
]
~
get_params
:
unit
()
let
saved_service
=
Eliom_reference
.
eref
~
scope
:
Eliom_common
.
default_session_scope
(
module
struct
let
s
=
home
end
:
SAVED_SERVICE
)
let
register_election
config
=
!
register_election_ref
config
let
cont
()
=
lwt
x
=
Eliom_reference
.
get
saved_service
in
let
module
X
=
(
val
x
:
SAVED_SERVICE
)
in
return
X
.
s
end
include
S
module
T
=
Templates
.
Make
(
S
)
let
()
=
register_election_ref
:=
fun
config
->
let
registration
=
Web_election
.
make
config
in
let
module
R
=
(
val
registration
:
Web_election
.
REGISTRATION
)
in
let
module
W
=
R
.
W
in
let
module
X
:
EMPTY
=
R
.
Register
(
S
)
(
T
.
Election
(
W
))
in
let
election
=
(
module
W
:
WEB_ELECTION
)
in
let
u
=
W
.
election
.
e_params
.
e_uuid
in
if
!
main_election_uuid
=
Some
u
then
main_election
:=
Some
election
;
if
W
.
featured
then
featured
:=
election
::
!
featured
;
return
election
let
()
=
let
module
X
:
EMPTY
=
Auth
.
Register
(
S
)
(
T
)
in
()
let
()
=
Any
.
register
~
service
:
home
(
fun
()
()
->
Eliom_reference
.
unset
saved_service
>>
match
!
main_election
with
|
None
->
T
.
home
~
featured
:!
featured
()
>>=
Html5
.
send
|
Some
w
->
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
Redirection
.
send
W
.
S
.
home
)
let
()
=
File
.
register
~
service
:
source_code
~
content_type
:
"application/x-gzip"
(
fun
()
()
->
match
!
source_file
with
|
None
->
fail_http
404
|
Some
f
->
return
f
lwt
source_file
=
match
!
source_file
with
|
Some
f
->
lwt
b
=
file_exists
f
in
if
b
then
(
return
f
)
else
(
Printf
.
ksprintf
failwith
"file %s does not exist"
f
)
|
None
->
failwith
"missing <source> in configuration"
let
do_get_randomness
=
let
prng
=
Lazy
.
lazy_from_fun
(
Lwt_preemptive
.
detach
(
fun
()
->
Cryptokit
.
Random
.(
pseudo_rng
(
string
secure_rng
16
))
))
in
let
mutex
=
Lwt_mutex
.
create
()
in
fun
()
->
Lwt_mutex
.
with_lock
mutex
(
fun
()
->
lwt
prng
=
Lazy
.
force
prng
in
return
Cryptokit
.
Random
.(
string
prng
32
)
)
let
()
=
String
.
register
~
service
:
get_randomness
(
fun
()
()
->
lwt
r
=
do_get_randomness
()
in
Cryptokit
.(
transform_string
(
Base64
.
encode_compact
()
)
r
)
|>
(
fun
x
->
string_of_randomness
{
randomness
=
x
})
|>
(
fun
x
->
return
(
x
,
"application/json"
))
)
(** Build up the site *)
module
Site_config
=
struct
let
name
=
"site"
let
path
=
[]
let
source_file
=
source_file
let
instances
=
!
auth_instances
end
module
Site
=
Web_site
.
Make
(
Site_config
)
let
populate
accu
f
s
=
Lwt_stream
.
fold_s
f
s
accu
...
...
@@ -265,6 +170,11 @@ lwt () =
Lwt_list
.
iter_s
(
fun
(
config
,
public_creds_fname
)
->
lwt
election
=
Site
.
register_election
config
in
let
module
W
=
(
val
election
:
WEB_ELECTION
)
in
(
match
!
main_election_uuid
with
|
Some
u
when
u
=
W
.
election
.
e_params
.
e_uuid
->
Site
.
set_main_election
election
|
_
->
()
);
lwt
public_creds
=
Lwt_io
.
lines_of_file
public_creds_fname
|>
populate
SSet
.
empty
(
fun
c
accu
->
...
...
src/web/
registratio
n.mli
→
src/web/
web_mai
n.mli
View file @
96f09d36
File moved
src/web/web_signatures.mli
View file @
96f09d36
...
...
@@ -262,7 +262,11 @@ module type SITE_SERVICES = sig
include
CORE_SERVICES
include
CONT_SERVICE
include
AUTH_SERVICES
val
register_election
:
election_config
->
(
module
WEB_ELECTION
)
Lwt
.
t
val
set_main_election
:
(
module
WEB_ELECTION
)
->
unit
val
unset_main_election
:
unit
->
unit
end
module
type
TEMPLATES
=
sig
...
...
src/web/web_site.ml
0 → 100644
View file @
96f09d36
(**************************************************************************)
(* 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
Lwt
open
Util
open
Serializable_t
open
Signatures
open
Web_serializable_j
open
Web_common
open
Web_signatures
module
type
CONFIG
=
sig
val
name
:
string
val
path
:
string
list
val
source_file
:
string
val
instances
:
Auth_common
.
auth_instance
list
end
module
Make
(
C
:
CONFIG
)
:
SITE_SERVICES
=
struct
open
Eliom_service
open
Eliom_registration
module
Auth
=
Auth_common
.
Make
(
C
)
let
main_election
=
ref
None
let
featured
=
ref
[]
(* The following reference is there to cut a dependency loop:
S.register_election depends on S (via Templates). It will be set
to a proper value once we have called Templates.Make. *)
let
register_election_ref
=
ref
(
fun
_
->
assert
false
)
(* We use an intermediate module S that will be passed to Templates
and Web_election. S is not meant to leak and will be included
in the returned module later. *)
module
S
:
SITE_SERVICES
=
struct
include
Auth
.
Services
open
Eliom_parameter
let
home
=
service
~
path
:
[]
~
get_params
:
unit
()
let
source_code
=
service
~
path
:
[
"belenios.tar.gz"
]
~
get_params
:
unit
()
let
get_randomness
=
service
~
path
:
[
"get-randomness"
]
~
get_params
:
unit
()
let
saved_service
=
Eliom_reference
.
eref
~
scope
:
Eliom_common
.
default_session_scope
(
module
struct
let
s
=
home
end
:
SAVED_SERVICE
)
let
cont
()
=
lwt
x
=
Eliom_reference
.
get
saved_service
in
let
module
X
=
(
val
x
:
SAVED_SERVICE
)
in
return
X
.
s
let
register_election
config
=
!
register_election_ref
config
let
set_main_election
x
=
main_election
:=
Some
x
let
unset_main_election
()
=
main_election
:=
None
end
include
S
module
T
=
Templates
.
Make
(
S
)
let
()
=
register_election_ref
:=
fun
config
->
let
registration
=
Web_election
.
make
config
in
let
module
R
=
(
val
registration
:
Web_election
.
REGISTRATION
)
in
let
module
W
=
R
.
W
in
let
module
X
:
EMPTY
=
R
.
Register
(
S
)
(
T
.
Election
(
W
))
in
let
election
=
(
module
W
:
WEB_ELECTION
)
in
if
W
.
featured
then
featured
:=
election
::
!
featured
;
return
election
let
()
=
let
module
X
:
EMPTY
=
Auth
.
Register
(
S
)
(
T
)
in
()
let
()
=
Any
.
register
~
service
:
home
(
fun
()
()
->
Eliom_reference
.
unset
saved_service
>>
match
!
main_election
with
|
None
->
T
.
home
~
featured
:!
featured
()
>>=
Html5
.
send
|
Some
w
->
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
Redirection
.
send
W
.
S
.
home
)
let
()
=
File
.
register
~
service
:
source_code
~
content_type
:
"application/x-gzip"
(
fun
()
()
->
return
C
.
source_file
)
let
do_get_randomness
=
let
prng
=
Lazy
.
lazy_from_fun
(
Lwt_preemptive
.
detach
(
fun
()
->
Cryptokit
.
Random
.(
pseudo_rng
(
string
secure_rng
16
))
))
in
let
mutex
=
Lwt_mutex
.
create
()
in
fun
()
->
Lwt_mutex
.
with_lock
mutex
(
fun
()
->
lwt
prng
=
Lazy
.
force
prng
in
return
Cryptokit
.
Random
.(
string
prng
32
)
)
let
()
=
String
.
register
~
service
:
get_randomness
(
fun
()
()
->
lwt
r
=
do_get_randomness
()
in
Cryptokit
.(
transform_string
(
Base64
.
encode_compact
()
)
r
)
|>
(
fun
x
->
string_of_randomness
{
randomness
=
x
})
|>
(
fun
x
->
return
(
x
,
"application/json"
))
)
end
src/web/web_site.mli
0 → 100644
View file @
96f09d36
(**************************************************************************)
(* 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
module
type
CONFIG
=
sig
val
name
:
string
val
path
:
string
list
val
source_file
:
string
val
instances
:
Auth_common
.
auth_instance
list
end
module
Make
(
C
:
CONFIG
)
:
SITE_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