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
9d6742dd
Commit
9d6742dd
authored
Sep 03, 2014
by
Stephane Glondu
Browse files
Add Tool_js_tkeygen
parent
f4cb7aa7
Changes
5
Hide whitespace changes
Inline
Side-by-side
_tags
View file @
9d6742dd
...
...
@@ -2,5 +2,5 @@
<src/platform/native/*>: package(zarith), package(calendar), package(cryptokit)
<src/web/*.{ml,mli,byte,native,odoc}>: thread, package(eliom.server), syntax(camlp4o), package(lwt.syntax), package(csv)
<src/tool/tool_cmdline.*>: package(zarith), package(calendar), package(cryptokit), package(cmdliner), use_platform-native
<src/tool/tool_js
.
*> or <src/platform/js/*> or <src/booth/*>: package(js_of_ocaml), syntax(camlp4o), package(js_of_ocaml.syntax), use_platform-js
<src/tool/tool_js*> or <src/platform/js/*> or <src/booth/*>: package(js_of_ocaml), syntax(camlp4o), package(js_of_ocaml.syntax), use_platform-js
<src/booth/*>: package(lwt.syntax)
all.itarget
View file @
9d6742dd
...
...
@@ -3,3 +3,4 @@ src/lib/lib.cma
src/web/server.cma
src/static/belenios-tool.html.otarget
src/static/vote.html.otarget
src/static/tool_js_tkeygen.js
myocamlbuild.ml
View file @
9d6742dd
...
...
@@ -116,4 +116,6 @@ let () = dispatch & function
copy_rule
"booth.js"
"src/booth/booth.js"
"src/static/booth.js"
;
copy_rule
"vote.html"
"src/booth/vote.html"
"src/static/vote.html"
;
copy_rule
"tool_js_tkeygen.js"
"src/tool/tool_js_tkeygen.js"
"src/static/tool_js_tkeygen.js"
;
|
_
->
()
src/tool/tool_js_tkeygen.ml
0 → 100644
View file @
9d6742dd
(**************************************************************************)
(* 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
Platform
open
Serializable_j
let
document
=
Dom_html
.
window
##
document
let
alert
s
:
unit
=
let
open
Js
.
Unsafe
in
fun_call
(
variable
"alert"
)
[
|
s
|>
Js
.
string
|>
inject
|
]
let
get_textarea
id
=
let
res
=
ref
None
in
Js
.
Opt
.
iter
(
document
##
getElementById
(
Js
.
string
id
))
(
fun
e
->
Js
.
Opt
.
iter
(
Dom_html
.
CoerceTo
.
textarea
e
)
(
fun
x
->
res
:=
Some
(
Js
.
to_string
(
x
##
value
)))
);
match
!
res
with
|
None
->
raise
Not_found
|
Some
x
->
x
let
set_textarea
id
z
=
Js
.
Opt
.
iter
(
document
##
getElementById
(
Js
.
string
id
))
(
fun
e
->
Js
.
Opt
.
iter
(
Dom_html
.
CoerceTo
.
textarea
e
)
(
fun
x
->
x
##
value
<-
Js
.
string
z
)
)
open
Tool_tkeygen
let
tkeygen
_
=
let
module
P
:
PARAMS
=
struct
let
group
=
get_textarea
"group"
end
in
let
module
X
=
(
val
make
(
module
P
:
PARAMS
)
:
S
)
in
let
open
X
in
let
{
id
;
priv
;
pub
}
=
trustee_keygen
()
in
let
data_uri
=
(
Js
.
string
"data:application/json,"
)
##
concat
(
Js
.
encodeURI
(
Js
.
string
priv
))
in
ignore
(
Dom_html
.
window
##
open_
(
data_uri
,
Js
.
string
id
,
Js
.
null
));
set_textarea
"pk"
pub
;
alert
"The private key has been open in a new window (or tab). Please save it before submitting the public key!"
;
Js
.
_false
let
fill_interactivity
_
=
Js
.
Opt
.
iter
(
document
##
getElementById
(
Js
.
string
"interactivity"
))
(
fun
e
->
let
b
=
document
##
createElement
(
Js
.
string
"button"
)
in
let
t
=
document
##
createTextNode
(
Js
.
string
"Generate a new keypair"
)
in
b
##
onclick
<-
Dom_html
.
handler
tkeygen
;
Dom
.
appendChild
b
t
;
Dom
.
appendChild
e
b
;
);
Js
.
_false
let
()
=
Dom_html
.
window
##
onload
<-
Dom_html
.
handler
fill_interactivity
;
src/web/web_templates.ml
View file @
9d6742dd
...
...
@@ -491,14 +491,37 @@ let make_login_box style auth links =
[
div
[
div
[
pcdata
"Public key:"
];
div
[
textarea
~
a
:
[
a_rows
5
;
a_cols
40
]
~
name
~
value
()
];
div
[
textarea
~
a
:
[
a_rows
5
;
a_cols
40
;
a_id
"pk"
]
~
name
~
value
()
];
div
[
string_input
~
input_type
:
`Submit
~
value
:
"Submit"
()
];
]
]
)
()
in
let
group
=
let
name
:
'
a
Eliom_parameter
.
param_name
=
Obj
.
magic
"group"
in
let
value
=
se
.
se_group
in
div
~
a
:
[
a_style
"display:none;"
]
[
div
[
pcdata
"Group parameters:"
];
div
[
textarea
~
a
:
[
a_id
"group"
;
a_rows
5
;
a_cols
40
;
a_readonly
`ReadOnly
]
~
name
~
value
()
];
]
in
let
interactivity
=
div
~
a
:
[
a_id
"interactivity"
]
[
script
~
a
:
[
a_src
(
uri_of_string
(
fun
()
->
"../static/sjcl.js"
))]
(
pcdata
""
);
script
~
a
:
[
a_src
(
uri_of_string
(
fun
()
->
"../static/jsbn.js"
))]
(
pcdata
""
);
script
~
a
:
[
a_src
(
uri_of_string
(
fun
()
->
"../static/jsbn2.js"
))]
(
pcdata
""
);
script
~
a
:
[
a_src
(
uri_of_string
(
fun
()
->
"../static/random.js"
))]
(
pcdata
""
);
script
~
a
:
[
a_src
(
uri_of_string
(
fun
()
->
"../static/tool_js_tkeygen.js"
))]
(
pcdata
""
);
]
in
let
content
=
[
h1
[
pcdata
title
];
group
;
interactivity
;
form
;
]
in
let
login_box
=
pcdata
""
in
...
...
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