Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
B
belenios
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
List
Boards
Labels
Service Desk
Milestones
Merge Requests
1
Merge Requests
1
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
belenios
belenios
Commits
a4bf7a71
Commit
a4bf7a71
authored
Aug 31, 2017
by
Stephane Glondu
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add possibility to add the server itself as a (non-threshold) trustee
parent
494a4d54
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
123 additions
and
32 deletions
+123
-32
src/web/web_persist.ml
src/web/web_persist.ml
+5
-0
src/web/web_persist.mli
src/web/web_persist.mli
+1
-0
src/web/web_serializable.atd
src/web/web_serializable.atd
+2
-0
src/web/web_services.ml
src/web/web_services.ml
+1
-0
src/web/web_site.ml
src/web/web_site.ml
+80
-24
src/web/web_templates.ml
src/web/web_templates.ml
+34
-8
No files found.
src/web/web_persist.ml
View file @
a4bf7a71
...
...
@@ -146,6 +146,11 @@ let get_passwords uuid =
let
get_public_keys
uuid
=
read_file
~
uuid
"public_keys.jsons"
let
get_private_key
uuid
=
match
%
lwt
read_file
~
uuid
"private_key.json"
with
|
Some
[
x
]
->
return
(
Some
(
number_of_string
x
))
|
_
->
return_none
let
get_private_keys
uuid
=
read_file
~
uuid
"private_keys.jsons"
...
...
src/web/web_persist.mli
View file @
a4bf7a71
...
...
@@ -51,6 +51,7 @@ val get_elections_by_owner : user -> uuid list Lwt.t
val
get_voters
:
uuid
->
string
list
option
Lwt
.
t
val
get_passwords
:
uuid
->
(
string
*
string
)
SMap
.
t
option
Lwt
.
t
val
get_public_keys
:
uuid
->
string
list
option
Lwt
.
t
val
get_private_key
:
uuid
->
number
option
Lwt
.
t
val
get_private_keys
:
uuid
->
string
list
option
Lwt
.
t
val
get_threshold
:
uuid
->
string
option
Lwt
.
t
...
...
src/web/web_serializable.atd
View file @
a4bf7a71
...
...
@@ -23,6 +23,7 @@
(** {1 Predefined types} *)
type number <ocaml predef from="Serializable_builtin"> = abstract
type uuid <ocaml predef from="Serializable_builtin"> = abstract
type string_set <ocaml predef from="Serializable_builtin"> = abstract
type datetime <ocaml predef from="Web_serializable_builtin"> = abstract
...
...
@@ -67,6 +68,7 @@ type setup_trustee = {
id : string;
token : string;
public_key <ocaml mutable> : string;
?private_key : number option;
} <ocaml field_prefix="st_">
type setup_threshold_trustee = {
...
...
src/web/web_services.ml
View file @
a4bf7a71
...
...
@@ -45,6 +45,7 @@ let election_setup_voters_add = post_service ~fallback:election_setup_voters ~po
let
election_setup_voters_remove
=
post_coservice
~
fallback
:
election_setup_voters
~
post_params
:
(
string
"voter"
)
()
let
election_setup_voters_passwd
=
post_coservice
~
fallback
:
election_setup_voters
~
post_params
:
(
string
"voter"
)
()
let
election_setup_trustee_add
=
post_coservice
~
fallback
:
election_setup
~
post_params
:
(
string
"id"
)
()
let
election_setup_trustee_add_server
=
post_coservice
~
fallback
:
election_setup
~
post_params
:
unit
()
let
election_setup_trustee_del
=
post_coservice
~
fallback
:
election_setup
~
post_params
:
(
int
"index"
)
()
let
election_setup_credential_authority
=
service
~
path
:
[
"setup"
;
"credential-authority"
]
~
get_params
:
(
uuid
"uuid"
)
()
let
election_setup_credentials
=
service
~
path
:
[
"setup"
;
"credentials"
]
~
get_params
:
(
string
"token"
)
()
...
...
src/web/web_site.ml
View file @
a4bf7a71
...
...
@@ -122,6 +122,18 @@ let finalize_election uuid se =
let
%
lwt
public_key
=
KG
.
prove
private_key
in
return
(
None
,
[
public_key
]
,
`KEY
private_key
)
|
_
::
_
->
let
private_key
=
List
.
fold_left
(
fun
accu
{
st_private_key
;
_
}
->
match
st_private_key
with
|
Some
x
->
x
::
accu
|
None
->
accu
)
[]
se
.
se_public_keys
in
let
private_key
=
match
private_key
with
|
[]
->
`None
|
[
x
]
->
`KEY
x
|
_
->
failwith
"multiple private keys"
in
return
(
Some
(
List
.
map
(
fun
{
st_id
;
_
}
->
st_id
)
se
.
se_public_keys
)
,
(
List
.
map
...
...
@@ -129,7 +141,7 @@ let finalize_election uuid se =
if
st_public_key
=
""
then
failwith
"some public keys are missing"
;
trustee_public_key_of_string
G
.
read
st_public_key
)
se
.
se_public_keys
)
,
`None
)
private_key
)
in
let
y
=
KG
.
combine
(
Array
.
of_list
public_keys
)
in
return
(
y
,
trustees
,
`PK
public_keys
,
private_key
)
...
...
@@ -223,7 +235,10 @@ let finalize_election uuid se =
Ocsipersist
.
remove
election_credtokens
se
.
se_public_creds
>>
Lwt_list
.
iter_s
(
fun
{
st_token
;
_
}
->
Ocsipersist
.
remove
election_pktokens
st_token
)
if
st_token
<>
""
then
(
Ocsipersist
.
remove
election_pktokens
st_token
)
else
return_unit
)
se
.
se_public_keys
>>
(
match
se
.
se_threshold_trustees
with
|
None
->
return_unit
...
...
@@ -697,7 +712,7 @@ let () =
with_setup_election
uuid
(
fun
se
->
if
is_email
st_id
then
(
let
%
lwt
st_token
=
generate_token
()
in
let
trustee
=
{
st_id
;
st_token
;
st_public_key
=
""
}
in
let
trustee
=
{
st_id
;
st_token
;
st_public_key
=
""
;
st_private_key
=
None
}
in
se
.
se_public_keys
<-
se
.
se_public_keys
@
[
trustee
];
let
%
lwt
()
=
Ocsipersist
.
add
election_pktokens
st_token
(
raw_string_of_uuid
uuid
)
in
redir_preapply
election_setup_trustees
uuid
()
...
...
@@ -709,6 +724,23 @@ let () =
)
)
let
()
=
Any
.
register
~
service
:
election_setup_trustee_add_server
(
fun
uuid
()
->
with_setup_election
uuid
(
fun
se
->
let
st_id
=
"server"
and
st_token
=
""
in
let
module
G
=
(
val
Group
.
of_string
se
.
se_group
)
in
let
module
K
=
Trustees
.
MakeSimple
(
G
)
(
LwtRandom
)
in
let
%
lwt
private_key
=
K
.
generate
()
in
let
%
lwt
public_key
=
K
.
prove
private_key
in
let
st_public_key
=
string_of_trustee_public_key
G
.
write
public_key
in
let
st_private_key
=
Some
private_key
in
let
trustee
=
{
st_id
;
st_token
;
st_public_key
;
st_private_key
}
in
se
.
se_public_keys
<-
se
.
se_public_keys
@
[
trustee
];
redir_preapply
election_setup_trustees
uuid
()
)
)
let
()
=
Any
.
register
~
service
:
election_setup_trustee_del
(
fun
uuid
index
->
...
...
@@ -722,7 +754,9 @@ let () =
se
.
se_public_keys
<-
trustees
;
let
%
lwt
()
=
Lwt_list
.
iter_s
(
fun
{
st_token
;
_
}
->
Ocsipersist
.
remove
election_pktokens
st_token
if
st_token
<>
""
then
(
Ocsipersist
.
remove
election_pktokens
st_token
)
else
return_unit
)
old
in
redir_preapply
election_setup_trustees
uuid
()
...
...
@@ -1022,17 +1056,27 @@ let () =
)
se_threshold_trustees
>>
redir_preapply
election_setup_threshold_trustees
uuid
()
|
Some
ts
,
None
,
Some
pks
when
List
.
length
ts
=
List
.
length
pks
->
let
module
G
=
(
val
Group
.
of_string
se
.
se_group
)
in
let
module
KG
=
Trustees
.
MakeSimple
(
G
)
(
LwtRandom
)
in
let
%
lwt
trustees
=
List
.
combine
ts
pks
|>
Lwt_list
.
map_p
(
fun
(
st_id
,
st_public_key
)
->
let
%
lwt
st_token
=
generate_token
()
in
return
{
st_id
;
st_token
;
st_public_key
})
let
%
lwt
st_token
,
st_private_key
,
st_public_key
=
if
st_id
=
"server"
then
(
let
%
lwt
private_key
=
KG
.
generate
()
in
let
%
lwt
public_key
=
KG
.
prove
private_key
in
let
public_key
=
string_of_trustee_public_key
G
.
write
public_key
in
return
(
""
,
Some
private_key
,
public_key
)
)
else
(
let
%
lwt
st_token
=
generate_token
()
in
return
(
st_token
,
None
,
st_public_key
)
)
in
return
{
st_id
;
st_token
;
st_public_key
;
st_private_key
})
in
let
()
=
(* check that imported keys are valid *)
let
module
G
=
(
val
Group
.
of_string
se
.
se_group
:
GROUP
)
in
let
module
KG
=
Trustees
.
MakeSimple
(
G
)
(
LwtRandom
)
in
if
not
@@
List
.
for_all
(
fun
t
->
let
pk
=
t
.
st_public_key
in
let
pk
=
trustee_public_key_of_string
G
.
read
pk
in
...
...
@@ -1041,7 +1085,9 @@ let () =
in
se
.
se_public_keys
<-
se
.
se_public_keys
@
trustees
;
Lwt_list
.
iter_s
(
fun
{
st_token
;
_
}
->
Ocsipersist
.
add
election_pktokens
st_token
uuid_s
if
st_token
<>
""
then
(
Ocsipersist
.
add
election_pktokens
st_token
uuid_s
)
else
return_unit
)
trustees
>>
redir_preapply
election_setup_trustees
uuid
()
|
_
,
_
,
_
->
...
...
@@ -1532,21 +1578,31 @@ let () =
|
None
->
failwith
"missing public keys and threshold parameters"
in
Web_persist
.
set_election_state
uuid
(
`EncryptedTally
(
npks
,
nb
,
hash
))
>>
(* compute partial decryption and release tally
if the (single) key is known *)
let
skfile
=
!
spool_dir
/
raw_string_of_uuid
uuid
/
"private_key.json"
in
if
npks
=
1
&&
Sys
.
file_exists
skfile
then
(
let
%
lwt
sk
=
read_file
skfile
in
let
sk
=
match
sk
with
|
Some
[
sk
]
->
number_of_string
sk
|
_
->
failwith
"several private keys are available"
in
let
tally
=
encrypted_tally_of_string
W
.
G
.
read
tally
in
let
%
lwt
pd
=
E
.
compute_factor
tally
sk
in
let
pd
=
string_of_partial_decryption
W
.
G
.
write
pd
in
Web_persist
.
set_partial_decryptions
uuid
[
1
,
pd
]
>>
handle_election_tally_release
(
uuid
,
()
)
()
)
else
redir_preapply
election_admin
(
uuid
,
()
)
()
let
tally
=
encrypted_tally_of_string
W
.
G
.
read
tally
in
let
%
lwt
sk
=
Web_persist
.
get_private_key
uuid
in
match
metadata
.
e_trustees
with
|
None
->
(* no trustees: compute decryption and release tally *)
let
sk
=
match
sk
with
|
Some
x
->
x
|
None
->
failwith
"missing private key"
in
let
%
lwt
pd
=
E
.
compute_factor
tally
sk
in
let
pd
=
string_of_partial_decryption
W
.
G
.
write
pd
in
Web_persist
.
set_partial_decryptions
uuid
[
1
,
pd
]
>>
handle_election_tally_release
(
uuid
,
()
)
()
|
Some
ts
->
Lwt_list
.
iteri_s
(
fun
i
t
->
if
t
=
"server"
then
(
match
%
lwt
Web_persist
.
get_private_key
uuid
with
|
Some
k
->
let
%
lwt
pd
=
E
.
compute_factor
tally
k
in
let
pd
=
string_of_partial_decryption
W
.
G
.
write
pd
in
Web_persist
.
set_partial_decryptions
uuid
[
i
+
1
,
pd
]
|
None
->
return_unit
(* dead end *)
)
else
return_unit
)
ts
>>
redir_preapply
election_admin
(
uuid
,
()
)
()
)
else
forbidden
()
)
)
...
...
src/web/web_templates.ml
View file @
a4bf7a71
...
...
@@ -540,6 +540,18 @@ let election_setup_trustees uuid se () =
]
)
uuid
in
let
form_trustees_add_server
=
match
List
.
filter
(
fun
{
st_id
;
_
}
->
st_id
=
"server"
)
se
.
se_public_keys
with
|
[]
->
post_form
~
service
:
election_setup_trustee_add_server
(
fun
()
->
[
string_input
~
input_type
:
`Submit
~
value
:
"Add the server"
()
]
)
uuid
|
_
->
pcdata
""
in
let
mk_form_trustee_del
value
=
post_form
~
service
:
election_setup_trustee_del
...
...
@@ -566,15 +578,23 @@ let election_setup_trustees uuid se () =
pcdata
t
.
st_id
;
];
td
[
if
t
.
st_token
<>
""
then
(
let
uri
=
rewrite_prefix
@@
Eliom_uri
.
make_string_uri
~
absolute
:
true
~
service
:
election_setup_trustee
t
.
st_token
in
let
body
=
Printf
.
sprintf
mail_trustee_generation
uri
in
let
subject
=
"Link to generate the decryption key"
in
a_mailto
~
dest
:
t
.
st_id
~
subject
~
body
"Mail"
)
else
(
pcdata
"(server)"
)
];
td
[
if
t
.
st_token
<>
""
then
(
a
~
service
:
election_setup_trustee
[
pcdata
"Link"
]
t
.
st_token
;
)
else
(
pcdata
"(server)"
)
];
td
[
pcdata
(
if
t
.
st_public_key
=
""
then
"No"
else
"Yes"
);
...
...
@@ -601,6 +621,7 @@ let election_setup_trustees uuid se () =
]
else
pcdata
""
);
form_trustees_add
;
form_trustees_add_server
;
]
else
pcdata
""
in
...
...
@@ -1618,16 +1639,21 @@ let election_admin election metadata state get_tokens_decrypt () =
|
None
->
uri
,
!
server_mail
|
Some
name
->
name
,
name
in
tr
[
td
[
pcdata
link_content
];
td
[
let
mail
,
link
=
if
link_content
=
"server"
then
(
pcdata
"(server)"
,
pcdata
"(server)"
)
else
(
let
body
=
Printf
.
sprintf
mail_trustee_tally
uri
in
let
subject
=
"Link to tally the election"
in
a_mailto
~
dest
~
subject
~
body
"Mail"
];
td
[
a
~
service
[
pcdata
"Link"
]
x
;
];
a_mailto
~
dest
~
subject
~
body
"Mail"
,
a
~
service
[
pcdata
"Link"
]
x
)
in
tr
[
td
[
pcdata
link_content
];
td
[
mail
];
td
[
link
];
td
[
pcdata
(
if
List
.
mem_assoc
trustee_id
pds
then
"Yes"
else
"No"
)
];
...
...
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