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
4d30236f
Commit
4d30236f
authored
May 23, 2013
by
Stephane Glondu
Browse files
Do no longer use legacy datatypes in web
parent
40f66509
Changes
10
Hide whitespace changes
Inline
Side-by-side
src/lib/serializable.atd
View file @
4d30236f
...
...
@@ -36,7 +36,7 @@ type ff_pubkey = {
p : number;
q : number;
y : number;
}
<ocaml field_prefix="ff_">
}
<doc text="Parameters for a multiplicative subgroup of a finite field, with a public key.">
type question = {
...
...
@@ -82,3 +82,10 @@ type 'a result = {
partial_decryptions : 'a partial_decryption list <ocaml repr="array">;
result : int list <ocaml repr="array"> list <ocaml repr="array">;
}
(** {1 Other datastructures} *)
type randomness = {
randomness : string;
}
<doc text="Randomness generated by the server sent to the client.">
src/lib/serializable_compat.atd
View file @
4d30236f
...
...
@@ -132,9 +132,3 @@ type 'a partial_decryption = {
}
type raw_result = int list <ocaml repr="array"> list <ocaml repr="array">
(** {1 Other basic datastructures} *)
type randomness = {
randomness : string;
}
src/web/common.ml
View file @
4d30236f
open
Lwt
open
Util
open
Serializable_
compat_
t
open
Serializable_t
type
user
=
{
user_name
:
string
;
user_type
:
string
;
}
type
'
a
result
=
{
encrypted_tally
:
'
a
encrypted_tally
;
partial_decryptions
:
'
a
partial_decryption
array
;
result
:
raw_result
;
}
type
election_data
=
{
raw
:
string
;
fingerprint
:
string
;
election
:
Z
.
t
election
;
election
:
ff_pubkey
election
;
public_keys
:
Z
.
t
trustee_public_key
array
;
election_result
:
Z
.
t
result
option
;
admin
:
user
;
private_p
:
bool
;
featured_p
:
bool
;
state
:
election_state
;
}
let
enforce_single_element
s
=
...
...
@@ -59,39 +52,23 @@ let load_elections_and_votes dirname =
Lwt_io
.
lines_of_file
|>
enforce_single_element
in
let
election
=
Serializable_
compat_
j
.
election_of_string
Serializable_
builtin_j
.
read_number
raw
let
election
=
Serializable_j
.
election_of_string
Serializable_
j
.
read_ff_pubkey
raw
in
(
assert_lwt
(
Uuidm
.
equal
uuid
election
.
e_uuid
))
>>
lwt
public_keys
=
data
"public_keys.jsons"
|>
Lwt_io
.
lines_of_file
|>
Lwt_stream
.
map
(
fun
x
->
Serializable_
compat_
j
.
trustee_public_key_of_string
Serializable_builtin_j
.
read_number
x
Serializable_j
.
trustee_public_key_of_string
Serializable_builtin_j
.
read_number
x
)
|>
Lwt_stream
.
to_list
>>=
wrap1
Array
.
of_list
in
lwt
election_result
,
state
=
match
(
try
Some
(
data
"result.json"
|>
load_from_file
Serializable_compat_j
.
read_raw_result
)
with
Sys_error
_
->
None
)
with
|
Some
result
->
let
encrypted_tally
=
data
"encrypted_tally.json"
|>
load_from_file
(
Serializable_compat_j
.
read_encrypted_tally
Serializable_builtin_j
.
read_number
)
in
lwt
partial_decryptions
=
data
"partial_decryptions.jsons"
|>
Lwt_io
.
lines_of_file
|>
Lwt_stream
.
map
(
fun
x
->
Serializable_compat_j
.
partial_decryption_of_string
Serializable_builtin_j
.
read_number
x
)
|>
Lwt_stream
.
to_list
>>=
wrap1
Array
.
of_list
in
return
(
Some
{
encrypted_tally
;
partial_decryptions
;
result
}
,
`Finished
)
|
None
->
return
(
None
,
`Started
)
let
election_result
=
try
Some
(
data
"result.json"
|>
load_from_file
(
Serializable_j
.
read_result
Serializable_builtin_j
.
read_number
)
)
with
Sys_error
_
->
None
in
let
fingerprint
=
hashB
raw
in
let
ballots
=
...
...
@@ -99,7 +76,7 @@ let load_elections_and_votes dirname =
if
Sys
.
file_exists
file
then
(
Lwt_io
.
lines_of_file
file
|>
Lwt_stream
.
map
(
fun
x
->
let
v
=
Serializable_
compat_
j
.
ballot_of_string
Serializable_builtin_j
.
read_number
x
in
let
v
=
Serializable_j
.
ballot_of_string
Serializable_builtin_j
.
read_number
x
in
assert
(
Uuidm
.
equal
uuid
v
.
election_uuid
);
x
,
v
)
...
...
@@ -114,7 +91,6 @@ let load_elections_and_votes dirname =
admin
=
{
user_name
=
"admin"
;
user_type
=
"dummy"
};
private_p
=
false
;
featured_p
=
true
;
state
;
}
in
Lwt
.
return
(
Some
(
election_data
,
ballots
))
|
None
->
assert
false
...
...
src/web/common.mli
View file @
4d30236f
open
Serializable_
compat_
t
open
Serializable_t
type
user
=
{
user_name
:
string
;
user_type
:
string
;
}
type
'
a
result
=
{
encrypted_tally
:
'
a
encrypted_tally
;
partial_decryptions
:
'
a
partial_decryption
array
;
result
:
raw_result
;
}
type
election_data
=
{
raw
:
string
;
fingerprint
:
string
;
election
:
Z
.
t
election
;
election
:
ff_pubkey
election
;
public_keys
:
Z
.
t
trustee_public_key
array
;
election_result
:
Z
.
t
result
option
;
admin
:
user
;
private_p
:
bool
;
featured_p
:
bool
;
state
:
election_state
;
}
val
hashB
:
string
->
string
...
...
src/web/registration.ml
View file @
4d30236f
open
Util
open
Serializable_
compat_
t
open
Serializable_t
open
Lwt
(* The following should be in configuration file... but
...
...
@@ -115,7 +115,7 @@ let () = Eliom_registration.String.register
let
uuid_underscored
=
String
.
map
(
function
'
-
'
->
'
_'
|
c
->
c
)
(
Uuidm
.
to_string
uuid
)
in
let
table
=
Ocsipersist
.
open_table
(
"ballots_"
^
uuid_underscored
)
in
lwt
ballots
=
Ocsipersist
.
fold_step
(
fun
hash
v
res
->
let
s
=
Serializable_
compat_
j
.
string_of_ballot
Serializable_builtin_j
.
write_number
v
^
"
\n
"
in
let
s
=
Serializable_j
.
string_of_ballot
Serializable_builtin_j
.
write_number
v
^
"
\n
"
in
return
(
s
::
res
)
)
table
[]
in
let
result
=
String
.
concat
""
ballots
in
...
...
@@ -129,7 +129,7 @@ let () = Eliom_registration.String.register
(* FIXME: DoS/entropy exhaustion vulnerability *)
Lwt_preemptive
.
detach
(
fun
()
->
Cryptokit
.
Random
.(
string
secure_rng
32
))
()
>>=
wrap1
Cryptokit
.(
transform_string
(
Base64
.
encode_compact
()
))
>>=
(
fun
x
->
return
(
Serializable_
compat_
j
.
string_of_randomness
{
randomness
=
x
}))
>>=
(
fun
x
->
return
(
Serializable_j
.
string_of_randomness
{
randomness
=
x
}))
>>=
(
fun
x
->
return
(
x
,
"application/json"
))
)
...
...
@@ -165,21 +165,21 @@ let () = Eliom_registration.Html5.register
(
fun
uuid
election
user
raw_ballot
->
let
result
=
try
let
ballot
=
Serializable_
compat_
j
.
ballot_of_string
Serializable_builtin_j
.
read_number
raw_ballot
in
let
ballot
=
Serializable_j
.
ballot_of_string
Serializable_builtin_j
.
read_number
raw_ballot
in
let
{
g
;
p
;
q
;
y
}
=
election
.
Common
.
election
.
e_public_key
in
let
module
P
=
struct
module
G
=
(
val
Election
.
finite_field
~
p
~
q
~
g
:
Signatures
.
GROUP
with
type
t
=
Z
.
t
)
let
public_keys
=
Array
.
map
(
fun
x
->
x
.
trustee_public_key
.
y
x
.
trustee_public_key
)
election
.
Common
.
public_keys
let
params
=
Serializable_compat
.
election
election
.
Common
.
election
let
params
=
{
election
.
Common
.
election
with
e_public_key
=
y
}
let
fingerprint
=
assert
false
end
in
let
module
M
=
Election
.
MakeSimpleMonad
(
P
.
G
)
in
let
module
E
=
Election
.
MakeElection
(
P
)(
M
)
in
if
Uuidm
.
equal
uuid
ballot
.
election_uuid
&&
E
.
check_ballot
(
Serializable_compat
.
ballot
ballot
)
E
.
check_ballot
ballot
then
`Valid
(
Common
.
hashB
raw_ballot
)
else
`Invalid
with
e
->
`Malformed
...
...
src/web/server.mllib
View file @
4d30236f
Util
Serializable_builtin_j
Serializable_compat_j
Serializable_j
Serializable_compat
Common
Election
Services
...
...
src/web/services.ml
View file @
4d30236f
open
Util
open
Serializable_
compat_
t
open
Serializable_t
open
Eliom_service
open
Eliom_parameter
...
...
src/web/templates.ml
View file @
4d30236f
open
Util
open
Serializable_
compat_
t
open
Serializable_t
open
Eliom_content
.
Html5
.
F
(* FIXME: these pages should be redesigned *)
...
...
@@ -136,7 +136,7 @@ let format_election_result e r =
)
answers
in
{
question
;
answers
}
)
(
r
.
Common
.
result
:
int
array
array
)
|>
)
r
.
result
|>
Array
.
to_list
let
format_one_election
e
=
...
...
@@ -228,7 +228,7 @@ let election_view ~election ~user =
let
service
=
Services
.(
preapply_uuid
election_raw
election
)
in
let
booth
=
Services
.
make_booth
election
.
Common
.
election
.
e_uuid
in
lwt
eligibility
=
if
not
election
.
Common
.
private_p
&&
election
.
Common
.
election
.
e_openreg
then
(
if
not
election
.
Common
.
private_p
then
(
Lwt
.
return
[
pcdata
"Anyone can vote in this election."
;
]
...
...
@@ -303,8 +303,8 @@ let election_view ~election ~user =
div
~
a
:
[
a_style
"margin-bottom: 25px;margin-left: 15px; border-left: 1px solid #aaa; padding-left: 5px; font-size:1.3em;"
]
[
pcdata
election
.
Common
.
election
.
e_description
];
(* NOTE: administration things removed from here! *)
br
()
;
]
@
(
match
election
.
Common
.
state
,
election
.
Common
.
election_result
with
|
`Finished
,
Some
r
->
]
@
(
match
election
.
Common
.
election_result
with
|
Some
r
->
let
result
=
format_election_result
election
.
Common
.
election
r
in
[
span
~
a
:
[
a_class
[
"highlight-box"
;
"round"
]]
[
...
...
@@ -340,14 +340,7 @@ let election_view ~election ~user =
]
)
result
)
|
`Stopped
,
_
->
[
span
~
a
:
[
a_class
[
"highlight-box"
;
"round"
]]
[
pcdata
"Election closed. Tally will be computed soon."
;
];
br
()
;
]
|
`Started
,
_
->
|
None
->
[
span
~
a
:
[
a_class
[
"highlight-box"
;
"round"
];
...
...
@@ -364,13 +357,6 @@ let election_view ~election ~user =
pcdata
"This election ends at the administrator's discretion."
;
br
()
;
]
|
_
->
[
span
~
a
:
[
a_class
[
"highlight-box"
;
"round"
]]
[
pcdata
"FIXME"
;
];
br
()
;
]
)
@
eligibility
@
[
div
~
a
:
[
a_style
"background: lightyellow; padding:5px; padding-left: 10px; margin-top: 15px; border: 1px solid #aaa; width: 720px;"
;
...
...
tests/ocsigenserver.conf.in
View file @
4d30236f
...
...
@@ -33,7 +33,7 @@
<static dir="_SRCDIR_/media/booth" />
</site>
<eliom module="_build/src/web/server.cma">
<load dir="tests/
legacy
"/>
<load dir="tests/
data
"/>
</eliom>
</host>
...
...
tests/sandbox.ml
View file @
4d30236f
...
...
@@ -141,7 +141,7 @@ let list_save_to filename writer xs =
let
save_to_disk
()
=
let
election
=
{
election
with
e_public_key
=
{
ff_g
=
g
;
ff_p
=
p
;
ff_q
=
q
;
ff_y
=
y
}
e_public_key
=
{
g
;
p
;
q
;
y
}
}
in
let
ballots
=
Array
.
of_list
(
M
.
fold
(
fun
x
xs
()
->
x
::
xs
)
[]
()
)
in
let
dir
=
Printf
.
sprintf
"tests/data/{%s}"
...
...
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