Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
belenios
belenios
Commits
f8020dc2
Commit
f8020dc2
authored
Aug 21, 2014
by
Stephane Glondu
Browse files
Remove one layer of functors in Web_site
parent
af078a49
Changes
4
Hide whitespace changes
Inline
Side-by-side
src/web/server.mllib
View file @
f8020dc2
...
...
@@ -11,10 +11,10 @@ Web_serializable_j
Web_common
Web_services
Web_auth
Web_election
Web_site
Web_templates
Auth_dummy
Auth_password
Auth_cas
Web_templates
Web_election
Web_site
Web_main
src/web/web_main.ml
View file @
f8020dc2
...
...
@@ -117,22 +117,15 @@ let spool_dir =
(** Build up the site *)
module
Site_config
=
struct
let
name
=
"site"
let
path
=
[]
let
source_file
=
source_file
let
spool_dir
=
spool_dir
end
module
Site
=
Web_site
.
Make
(
Site_config
)
let
()
=
Site
.
install_authentication
!
auth_instances
let
()
=
Web_site
.
source_file
:=
source_file
let
()
=
Web_site
.
spool_dir
:=
spool_dir
let
()
=
Web_site
.
install_authentication
!
auth_instances
lwt
()
=
Lwt_list
.
iter_s
(
fun
dir
->
read_election_dir
dir
>>=
Lwt_list
.
iter_s
(
fun
(
f
,
featured
)
->
match_lwt
S
ite
.
import_election
f
with
match_lwt
Web_s
ite
.
import_election
f
with
|
None
->
Ocsigen_messages
.
debug
(
fun
()
->
Printf
.
sprintf
"Ignored: %s"
f
.
f_election
...
...
@@ -143,12 +136,12 @@ lwt () =
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
if
featured
then
(
let
uuid
=
Uuidm
.
to_string
W
.
election
.
e_params
.
e_uuid
in
S
ite
.
add_featured_election
uuid
Web_s
ite
.
add_featured_election
uuid
)
else
return
()
)
)
!
import_dirs
lwt
()
=
match
!
main_election_uuid
with
|
Some
uuid
->
S
ite
.
set_main_election
uuid
|
Some
uuid
->
Web_s
ite
.
set_main_election
uuid
|
_
->
return
()
src/web/web_site.ml
View file @
f8020dc2
...
...
@@ -29,12 +29,8 @@ open Web_common
open
Web_signatures
open
Web_services
module
type
CONFIG
=
sig
val
name
:
string
val
path
:
string
list
val
source_file
:
string
val
spool_dir
:
string
end
let
source_file
=
ref
"belenios.tar.gz"
let
spool_dir
=
ref
"."
let
rec
list_remove
x
=
function
|
[]
->
[]
...
...
@@ -62,12 +58,12 @@ let delete_shallow_directory dir =
in
Lwt_unix
.
rmdir
dir
module
Make
(
C
:
CONFIG
)
:
SITE
=
struct
open
Eliom_service
open
Eliom_registration
module
C
=
struct
include
C
let
name
=
"site"
let
path
=
[]
let
kind
=
`Site
end
...
...
@@ -213,7 +209,7 @@ module Make (C : CONFIG) : SITE = struct
Lwt_mutex
.
unlock
registration_mutex
;
return
None
)
else
(
let
dir
=
C
.
spool_dir
/
uuid
in
let
dir
=
!
spool_dir
/
uuid
in
lwt
metadata
=
Lwt_io
.
chars_of_file
f
.
f_metadata
|>
Lwt_stream
.
to_string
>>=
...
...
@@ -366,7 +362,7 @@ module Make (C : CONFIG) : SITE = struct
let
()
=
File
.
register
~
service
:
source_code
~
content_type
:
"application/x-gzip"
(
fun
()
()
->
return
C
.
source_file
)
(
fun
()
()
->
return
!
source_file
)
let
do_get_randomness
=
let
prng
=
Lazy
.
lazy_from_fun
(
Lwt_preemptive
.
detach
(
fun
()
->
...
...
@@ -572,7 +568,7 @@ module Make (C : CONFIG) : SITE = struct
~
content_type
:
"text/plain"
(
fun
token
()
->
lwt
uuid
=
Ocsipersist
.
find
election_credtokens
token
in
return
(
C
.
spool_dir
/
uuid
^
".public_creds.txt"
)
return
(
!
spool_dir
/
uuid
^
".public_creds.txt"
)
)
let
wrap_handler
f
=
...
...
@@ -584,7 +580,7 @@ module Make (C : CONFIG) : SITE = struct
lwt
uuid
=
Ocsipersist
.
find
election_credtokens
token
in
lwt
se
=
Ocsipersist
.
find
election_stable
uuid
in
let
module
G
=
(
val
Group
.
of_string
se
.
se_group
:
GROUP
)
in
let
fname
=
C
.
spool_dir
/
uuid
^
".public_creds.txt"
in
let
fname
=
!
spool_dir
/
uuid
^
".public_creds.txt"
in
Lwt_mutex
.
with_lock
election_setup_mutex
(
fun
()
->
...
...
@@ -694,10 +690,10 @@ module Make (C : CONFIG) : SITE = struct
e_short_name
=
template
.
t_short_name
;
}
in
let
files
=
{
f_election
=
C
.
spool_dir
/
uuid_s
^
".election.json"
;
f_metadata
=
C
.
spool_dir
/
uuid_s
^
".metadata.json"
;
f_public_keys
=
C
.
spool_dir
/
uuid_s
^
".public_keys.jsons"
;
f_public_creds
=
C
.
spool_dir
/
uuid_s
^
".public_creds.txt"
;
f_election
=
!
spool_dir
/
uuid_s
^
".election.json"
;
f_metadata
=
!
spool_dir
/
uuid_s
^
".metadata.json"
;
f_public_keys
=
!
spool_dir
/
uuid_s
^
".public_keys.jsons"
;
f_public_creds
=
!
spool_dir
/
uuid_s
^
".public_creds.txt"
;
}
in
lwt
_
=
try_lwt
Lwt_unix
.
stat
files
.
f_public_creds
...
...
@@ -863,5 +859,3 @@ module Make (C : CONFIG) : SITE = struct
let
w
=
SMap
.
find
uuid_s
!
election_table
in
let
module
W
=
(
val
w
:
WEB_ELECTION
)
in
W
.
Z
.
election_dir
f
x
)
end
src/web/web_site.mli
View file @
f8020dc2
...
...
@@ -22,11 +22,7 @@
open
Web_serializable_t
open
Web_signatures
module
type
CONFIG
=
sig
val
name
:
string
val
path
:
string
list
val
source_file
:
string
val
spool_dir
:
string
end
val
source_file
:
string
ref
val
spool_dir
:
string
ref
module
Make
(
C
:
CONFIG
)
:
SITE
include
SITE
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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