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
83942945
Commit
83942945
authored
Jun 17, 2015
by
Stephane Glondu
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Setup mode: add a voter list
parent
2fe96be8
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
74 additions
and
0 deletions
+74
-0
src/web/web_common.ml
src/web/web_common.ml
+1
-0
src/web/web_common.mli
src/web/web_common.mli
+1
-0
src/web/web_services.ml
src/web/web_services.ml
+2
-0
src/web/web_site.ml
src/web/web_site.ml
+38
-0
src/web/web_templates.ml
src/web/web_templates.ml
+31
-0
src/web/web_templates.mli
src/web/web_templates.mli
+1
-0
No files found.
src/web/web_common.ml
View file @
83942945
...
...
@@ -204,6 +204,7 @@ let uuid =
type
setup_election
=
{
mutable
se_owner
:
user
;
mutable
se_group
:
string
;
mutable
se_voters
:
string
list
;
mutable
se_questions
:
template
;
mutable
se_public_keys
:
(
string
*
string
ref
)
list
;
mutable
se_metadata
:
metadata
;
...
...
src/web/web_common.mli
View file @
83942945
...
...
@@ -97,6 +97,7 @@ val uuid :
type
setup_election
=
{
mutable
se_owner
:
user
;
mutable
se_group
:
string
;
mutable
se_voters
:
string
list
;
mutable
se_questions
:
template
;
mutable
se_public_keys
:
(
string
*
string
ref
)
list
;
mutable
se_metadata
:
metadata
;
...
...
src/web/web_services.ml
View file @
83942945
...
...
@@ -44,6 +44,8 @@ let election_setup_group = post_coservice ~fallback:election_setup ~post_params:
let
election_setup_metadata
=
post_coservice
~
fallback
:
election_setup
~
post_params
:
(
string
"metadata"
)
()
let
election_setup_questions
=
service
~
path
:
[
"setup"
;
"questions"
]
~
get_params
:
(
uuid
"uuid"
)
()
let
election_setup_questions_post
=
post_coservice
~
fallback
:
election_setup_questions
~
post_params
:
(
string
"questions"
)
()
let
election_setup_voters
=
service
~
path
:
[
"setup"
;
"voters"
]
~
get_params
:
(
uuid
"uuid"
)
()
let
election_setup_voters_post
=
post_service
~
fallback
:
election_setup_voters
~
post_params
:
(
string
"voters"
)
()
let
election_setup_trustee_add
=
post_coservice
~
fallback
:
election_setup
~
post_params
:
unit
()
let
election_setup_trustee_del
=
post_coservice
~
fallback
:
election_setup
~
post_params
:
unit
()
let
election_setup_credentials
=
service
~
path
:
[
"setup"
;
"credentials"
]
~
get_params
:
(
string
"token"
)
()
...
...
src/web/web_site.ml
View file @
83942945
...
...
@@ -355,6 +355,7 @@ let () = Redirection.register ~service:election_setup_new
let
se
=
{
se_owner
=
u
;
se_group
=
"{
\"
g
\"
:
\"
14887492224963187634282421537186040801304008017743492304481737382571933937568724473847106029915040150784031882206090286938661464458896494215273989547889201144857352611058572236578734319505128042602372864570426550855201448111746579871811249114781674309062693442442368697449970648232621880001709535143047913661432883287150003429802392229361583608686643243349727791976247247948618930423866180410558458272606627111270040091203073580238905303994472202930783207472394578498507764703191288249547659899997131166130259700604433891232298182348403175947450284433411265966789131024573629546048637848902243503970966798589660808533
\"
,
\"
p
\"
:
\"
16328632084933010002384055033805457329601614771185955389739167309086214800406465799038583634953752941675645562182498120750264980492381375579367675648771293800310370964745767014243638518442553823973482995267304044326777047662957480269391322789378384619428596446446984694306187644767462460965622580087564339212631775817895958409016676398975671266179637898557687317076177218843233150695157881061257053019133078545928983562221396313169622475509818442661047018436264806901023966236718367204710755935899013750306107738002364137917426595737403871114187750804346564731250609196846638183903982387884578266136503697493474682071
\"
,
\"
q
\"
:
\"
61329566248342901292543872769978950870633559608669337131139375508370458778917
\"
}"
;
se_voters
=
[]
;
se_questions
;
se_public_keys
=
[]
;
se_metadata
;
...
...
@@ -436,6 +437,43 @@ let () =
(
fun
se
x
_
->
se
.
se_questions
<-
template_of_string
x
)
election_setup_questions
)
let
()
=
Html5
.
register
~
service
:
election_setup_voters
(
fun
uuid
()
->
match_lwt
Web_site_auth
.
get_user
()
with
|
Some
u
->
let
uuid_s
=
Uuidm
.
to_string
uuid
in
lwt
se
=
Ocsipersist
.
find
election_stable
uuid_s
in
if
se
.
se_owner
=
u
then
T
.
election_setup_voters
uuid
se
(
module
Web_site_auth
:
AUTH_SERVICES
)
()
else
forbidden
()
|
None
->
forbidden
()
)
(* see http://www.regular-expressions.info/email.html *)
let
email_rex
=
Pcre
.
regexp
~
flags
:
[
`CASELESS
]
"^[A-Z0-9._%+-]+@[A-Z0-9.-]+
\\
.[A-Z]{2,7}$"
let
is_email
x
=
try
ignore
(
Pcre
.
pcre_exec
~
rex
:
email_rex
x
);
true
with
Not_found
->
false
let
()
=
Any
.
register
~
service
:
election_setup_voters_post
(
handle_setup
(
fun
se
x
_
->
let
xs
=
Pcre
.
split
x
in
let
()
=
try
let
bad
=
List
.
find
(
fun
x
->
not
(
is_email
x
))
xs
in
Printf
.
ksprintf
failwith
"%S is not a valid address"
bad
with
Not_found
->
()
in
se
.
se_voters
<-
xs
)
election_setup
)
let
()
=
Redirection
.
register
~
service
:
election_setup_trustee_add
...
...
src/web/web_templates.ml
View file @
83942945
...
...
@@ -304,6 +304,18 @@ let election_setup uuid se auth () =
(
fun
()
->
[
string_input
~
input_type
:
`Submit
~
value
:
"Delete"
()
])
uuid
in
let
div_voters
=
div
[
h2
[
pcdata
"Voters"
];
div
[
pcdata
@@
string_of_int
@@
List
.
length
se
.
se_voters
;
pcdata
" voter(s) registered"
;
];
a
~
service
:
election_setup_voters
[
pcdata
"Manage voters"
]
uuid
]
in
let
div_trustees
=
div
[
h2
[
pcdata
"Trustees"
];
...
...
@@ -352,6 +364,7 @@ let election_setup uuid se auth () =
)
uuid
in
let
content
=
[
div_voters
;
div_trustees
;
div_credentials
;
form_group
;
...
...
@@ -398,6 +411,24 @@ let election_setup_questions uuid se auth () =
lwt
login_box
=
site_login_box
auth
()
in
base
~
title
~
login_box
~
content
()
let
election_setup_voters
uuid
se
auth
()
=
let
title
=
"Voters for election "
^
Uuidm
.
to_string
uuid
in
let
form
=
post_form
~
service
:
election_setup_voters_post
(
fun
name
->
let
value
=
String
.
concat
"
\n
"
se
.
se_voters
in
[
div
[
textarea
~
a
:
[
a_rows
20
;
a_cols
50
]
~
name
~
value
()
];
div
[
string_input
~
input_type
:
`Submit
~
value
:
"Submit"
()
]])
uuid
in
let
content
=
[
form
]
in
lwt
login_box
=
site_login_box
auth
()
in
base
~
title
~
login_box
~
content
()
let
election_setup_credentials
token
uuid
se
()
=
let
title
=
"Credentials for election "
^
uuid
in
let
form_textarea
=
...
...
src/web/web_templates.mli
View file @
83942945
...
...
@@ -30,6 +30,7 @@ val new_election_failure : [ `Exists | `Exception of exn ] -> (module AUTH_SERVI
val
generic_page
:
title
:
string
->
string
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_setup
:
Uuidm
.
t
->
Web_common
.
setup_election
->
(
module
AUTH_SERVICES
)
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_setup_voters
:
Uuidm
.
t
->
Web_common
.
setup_election
->
(
module
AUTH_SERVICES
)
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_setup_questions
:
Uuidm
.
t
->
Web_common
.
setup_election
->
(
module
AUTH_SERVICES
)
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_setup_credentials
:
string
->
string
->
Web_common
.
setup_election
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
val
election_setup_trustee
:
string
->
string
->
Web_common
.
setup_election
->
unit
->
[
>
`Html
]
Eliom_content
.
Html5
.
F
.
elt
Lwt
.
t
...
...
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