Webclient: first draft.

This commit is contained in:
Benjamin Canou 2016-12-01 23:20:23 +01:00
parent 8da7bddc36
commit dc64f9b6fb
28 changed files with 799 additions and 113 deletions

10
.gitignore vendored
View File

@ -2,7 +2,9 @@
/tezos-node /tezos-node
/tezos-protocol-compiler /tezos-protocol-compiler
/tezos-client /tezos-client
/tezos-webclient
/src/webclient_static.ml
/src/.depend /src/.depend
/src/node/updater/environment_gen /src/node/updater/environment_gen
@ -19,6 +21,12 @@
/src/client/embedded/bootstrap/concrete_lexer.ml /src/client/embedded/bootstrap/concrete_lexer.ml
/src/client/embedded/bootstrap/concrete_parser.ml /src/client/embedded/bootstrap/concrete_parser.ml
/src/client/embedded/bootstrap/concrete_parser.mli /src/client/embedded/bootstrap/concrete_parser.mli
/src/client/embedded/bootstrap/webclient_proto_static.ml
/src/client/embedded/bootstrap/main.byte
/src/client/embedded/bootstrap/webclient_static/main.js
/src/client/embedded/bootstrap/webclient/browser/main.byte
/src/client/embedded/bootstrap/webclient/static/main.js
/src/client/embedded/bootstrap/webclient/webclient_proto_static.ml
/test/.depend /test/.depend
/test/reports /test/reports
@ -44,6 +52,8 @@
*.cmp *.cmp
*.mli.deps *.mli.deps
*.ml.deps *.ml.deps
*.mli.deps.byte
*.ml.deps.byte
bisect*.out bisect*.out

View File

@ -4,8 +4,9 @@ include Makefile.config
TZCOMPILER=../tezos-protocol-compiler TZCOMPILER=../tezos-protocol-compiler
TZNODE=../tezos-node TZNODE=../tezos-node
TZCLIENT=../tezos-client TZCLIENT=../tezos-client
TZWEBCLIENT=../tezos-webclient
all: ${TZCOMPILER} ${TZNODE} ${TZCLIENT} all: ${TZCOMPILER} ${TZNODE} ${TZCLIENT} ${TZWEBCLIENT}
############################################################################ ############################################################################
@ -131,6 +132,17 @@ minutils.cmxa: ${MINUTILS_LIB_IMPLS:.ml=.cmx}
@echo LINK $(notdir $@) @echo LINK $(notdir $@)
@${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^ @${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^
MINUTILS_OBJS_BYTECODE := \
${MINUTILS_LIB_IMPLS:.ml=.cmo} ${MINUTILS_LIB_IMPLS:.ml=.ml.deps.byte}
${MINUTILS_OBJS_BYTECODE}: PACKAGES=${MINUTILS_PACKAGES}
${MINUTILS_OBJS_BYTECODE}: SOURCE_DIRECTORIES=minutils
${MINUTILS_OBJS_BYTECODE}: TARGET="(minutils.cma)"
${MINUTILS_OBJS_BYTECODE}: OPENED_MODULES=
minutils.cma: ${MINUTILS_LIB_IMPLS:.ml=.cmo}
@echo LINK $(notdir $@)
@${OCAMLC} ${OCAMLFLAGS} -a -o $@ $^
############################################################################ ############################################################################
## Utils library ## Utils library
############################################################################ ############################################################################
@ -366,7 +378,6 @@ proto/client_embedded_proto_%.cmxa: \
clean:: clean::
rm -f ${TZNODE} rm -f ${TZNODE}
############################################################################ ############################################################################
## Client program ## Client program
############################################################################ ############################################################################
@ -390,55 +401,108 @@ CLIENT_LIB_IMPLS := \
client/client_keys.ml \ client/client_keys.ml \
client/client_protocols.ml \ client/client_protocols.ml \
WEBCLIENT_LIB_INTFS := \
WEBCLIENT_LIB_IMPLS := \
client/webclient_version.ml \
CLIENT_IMPLS := \ CLIENT_IMPLS := \
client_main.ml client_main.ml
WEBCLIENT_IMPLS := \
webclient_static.ml \
webclient_main.ml
CLIENT_PACKAGES := \ CLIENT_PACKAGES := \
${NODE_PACKAGES} ${NODE_PACKAGES}
EMBEDDED_CLIENT_PROTOCOLS := \ EMBEDDED_CLIENT_PROTOCOLS := \
$(patsubst client/embedded/%/, \ $(patsubst client/embedded/%/, \
proto/client_embedded_proto_%.cmxa, \ proto/client_embedded_proto_%.cmxa, \
$(shell ls -d client/embedded/*/)) \ $(shell ls -d client/embedded/*/))
EMBEDDED_CLIENT_VERSIONS := \
$(patsubst client/embedded/%/, \ $(patsubst client/embedded/%/, \
client/embedded/client_%.cmx, \ client/embedded/client_%.cmx, \
$(shell ls -d client/embedded/*/)) $(shell ls -d client/embedded/*/))
EMBEDDED_WEBCLIENT_VERSIONS := \
$(patsubst client/embedded/%/, \
client/embedded/webclient_%.cmx, \
$(shell ls -d client/embedded/*/))
CLIENT_OBJS := \ CLIENT_OBJS := \
${CLIENT_IMPLS:.ml=.cmx} ${CLIENT_IMPLS:.ml=.ml.deps} \ ${CLIENT_IMPLS:.ml=.cmx} ${CLIENT_IMPLS:.ml=.ml.deps} \
${WEBCLIENT_IMPLS:.ml=.cmx} ${WEBCLIENT_IMPLS:.ml=.ml.deps} \
${CLIENT_LIB_IMPLS:.ml=.cmx} ${CLIENT_LIB_IMPLS:.ml=.ml.deps} \ ${CLIENT_LIB_IMPLS:.ml=.cmx} ${CLIENT_LIB_IMPLS:.ml=.ml.deps} \
${CLIENT_LIB_INTFS:.mli=.cmi} ${CLIENT_LIB_INTFS:.mli=.mli.deps} \ ${CLIENT_LIB_INTFS:.mli=.cmi} ${CLIENT_LIB_INTFS:.mli=.mli.deps} \
${TZCLIENT} ${WEBCLIENT_LIB_IMPLS:.ml=.cmx} ${WEBCLIENT_LIB_IMPLS:.ml=.ml.deps} \
${WEBCLIENT_LIB_INTFS:.mli=.cmi} ${WEBCLIENT_LIB_INTFS:.mli=.mli.deps} \
${TZCLIENT} \
${TZWEBCLIENT}
${CLIENT_OBJS}: PACKAGES=${CLIENT_PACKAGES} ${CLIENT_OBJS}: PACKAGES=${CLIENT_PACKAGES}
${CLIENT_OBJS}: SOURCE_DIRECTORIES=client client/embedded minutils utils node/net node/shell node/updater node/db compiler ${CLIENT_OBJS}: SOURCE_DIRECTORIES=client client/embedded minutils utils node/net node/shell node/updater node/db compiler
${CLIENT_OBJS}: TARGET="(client.cmxa)"
${CLIENT_OBJS}: OPENED_MODULES=Error_monad Hash Utils ${CLIENT_OBJS}: OPENED_MODULES=Error_monad Hash Utils
${CLIENT_LIB_IMPLS:.ml=.cmx} ${CLIENT_LIB_IMPLS:.ml=.ml.deps}: TARGET="(client.cmxa)"
${CLIENT_LIB_INTFS:.mli=.cmi} ${CLIENT_LIB_INTFS:.mli=.mli.deps}: TARGET="(client.cmxa)"
${WEBCLIENT_LIB_IMPLS:.ml=.cmx} ${WEBCLIENT_LIB_IMPLS:.ml=.ml.deps}: TARGET="(webclient.cmxa)"
${WEBCLIENT_LIB_INTFS:.mli=.cmi} ${WEBCLIENT_LIB_INTFS:.mli=.mli.deps}: TARGET="(webclient.cmxa)"
client.cmxa: ${CLIENT_LIB_IMPLS:.ml=.cmx} client.cmxa: ${CLIENT_LIB_IMPLS:.ml=.cmx}
@echo LINK $(notdir $@) @echo LINK $(notdir $@)
@${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^ @${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ $^
${EMBEDDED_CLIENT_PROTOCOLS}: client.cmxa webclient.cmxa: ${WEBCLIENT_LIB_IMPLS:.ml=.cmx} client.cmxa
${CLIENT_IMPLS:.ml=.cmx}: ${EMBEDDED_CLIENT_PROTOCOLS} @echo LINK $(notdir $@)
${OCAMLOPT} ${OCAMLFLAGS} -a -o $@ ${WEBCLIENT_LIB_IMPLS:.ml=.cmx}
${EMBEDDED_CLIENT_VERSIONS}: client.cmxa
${CLIENT_IMPLS:.ml=.cmx}: ${EMBEDDED_CLIENT_VERSIONS}
${EMBEDDED_WEBCLIENT_VERSIONS}: webclient.cmxa
${WEBCLIENT_IMPLS:.ml=.cmx}: ${EMBEDDED_CLIENT_VERSIONS} ${EMBEDDED_WEBCLIENT_VERSIONS}
${TZCLIENT}: minutils.cmxa utils.cmxa compiler.cmxa node.cmxa \ ${TZCLIENT}: minutils.cmxa utils.cmxa compiler.cmxa node.cmxa \
client.cmxa ${EMBEDDED_CLIENT_PROTOCOLS} \ client.cmxa \
${EMBEDDED_CLIENT_PROTOCOLS} \
${EMBEDDED_CLIENT_VERSIONS} \
${CLIENT_IMPLS:.ml=.cmx} ${CLIENT_IMPLS:.ml=.cmx}
@echo LINK $(notdir $@) @echo LINK $(notdir $@)
@${OCAMLOPT} -linkpkg ${OCAMLFLAGS} -o $@ $^ @${OCAMLOPT} -linkpkg ${OCAMLFLAGS} -o $@ $^
${TZWEBCLIENT}: minutils.cmxa utils.cmxa compiler.cmxa node.cmxa \
client.cmxa webclient.cmxa \
${EMBEDDED_CLIENT_PROTOCOLS} \
${EMBEDDED_CLIENT_VERSIONS} \
${EMBEDDED_WEBCLIENT_VERSIONS} \
${WEBCLIENT_IMPLS:.ml=.cmx}
@echo LINK $(notdir $@)
@${OCAMLOPT} -linkpkg ${OCAMLFLAGS} -o $@ $^
webclient_static.ml: $$(shell find webclient_static/)
ocp-ocamlres webclient_static -o $@
clean:: clean::
-rm -f ${TZCLIENT} -rm -f ${TZCLIENT} $(TZWEBCLIENT)
## Embedded client protocol modules ## Embedded client protocol modules
.SECONDEXPANSION: .SECONDEXPANSION:
client/embedded/client_%.cmx: \ client/embedded/client_%.cmx: \
$(patsubst %.ml, %.cmx, $(NODE_LIB_IMPLS) $(CLIENT_LIB_IMPLS)) \ $(patsubst %.ml, %.cmx, $(NODE_LIB_IMPLS) $(CLIENT_LIB_IMPLS)) \
proto/client_embedded_proto_%.cmxa \ proto/client_embedded_proto_%.cmxa \
$$(shell find client/embedded/% -name \*.ml -or -name \*.mli) $$(shell find client/embedded/% -name \*.ml -or -name \*.mli)
@$(MAKE) -C client/embedded/$* ../client_$*.cmx @$(MAKE) -C client/embedded/$* ../client_$*.cmx
client/embedded/webclient_%.cmx: \
client/embedded/client_%.cmx \
minutils.cma \
$$(shell find client/embedded/%/webclient -name \*.ml -or -name \*.mli) \
$$(shell find client/embedded/%/webclient/static/)
@$(MAKE) -C client/embedded/$* ../webclient_$*.cmx
clean:: clean::
-for d in $$(ls -d client/embedded/*/) ; do make clean -C $$d ; done -for d in $$(ls -d client/embedded/*/) ; do make clean -C $$d ; done
-rm -f client/embedded/*.cm* client/embedded/*.o -rm -f client/embedded/*.cm* client/embedded/*.o
@ -450,7 +514,7 @@ clean::
@$(OCAMLOPT) ${OCAMLFLAGS} -c $< @$(OCAMLOPT) ${OCAMLFLAGS} -c $<
%.cmo: %.ml %.cmo: %.ml
@echo OCAMLOPT ${TARGET} $(notdir $@) @echo OCAMLC ${TARGET} $(notdir $@)
@$(OCAMLC) ${OCAMLFLAGS} -c $< @$(OCAMLC) ${OCAMLFLAGS} -c $<
%.cmi: %.mli %.cmi: %.mli
@ -472,9 +536,10 @@ compiler/embedded_cmis.cmx compiler/embedded_cmis.cmi: OPENED_MODULES=
ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),clean)
ifneq ($(MAKECMDGOALS),build-deps) ifneq ($(MAKECMDGOALS),build-deps)
-include .depend include .depend
endif endif
endif endif
DEPENDS := $(filter-out $(NO_DEPS), $(MINUTILS_LIB_INTFS) $(MINUTILS_LIB_IMPLS) \ DEPENDS := $(filter-out $(NO_DEPS), $(MINUTILS_LIB_INTFS) $(MINUTILS_LIB_IMPLS) \
$(UTILS_LIB_INTFS) $(UTILS_LIB_IMPLS) \ $(UTILS_LIB_INTFS) $(UTILS_LIB_IMPLS) \
$(COMPILER_LIB_INTFS) $(COMPILER_LIB_IMPLS) \ $(COMPILER_LIB_INTFS) $(COMPILER_LIB_IMPLS) \
@ -482,14 +547,18 @@ DEPENDS := $(filter-out $(NO_DEPS), $(MINUTILS_LIB_INTFS) $(MINUTILS_LIB_IMPLS)
$(NODE_LIB_INTFS) $(NODE_LIB_IMPLS) \ $(NODE_LIB_INTFS) $(NODE_LIB_IMPLS) \
$(NODE_INTFS) $(NODE_IMPLS) \ $(NODE_INTFS) $(NODE_IMPLS) \
$(CLIENT_LIB_INTFS) $(CLIENT_LIB_IMPLS) \ $(CLIENT_LIB_INTFS) $(CLIENT_LIB_IMPLS) \
$(CLIENT_INTFS) $(CLIENT_IMPLS)) $(WEBCLIENT_LIB_INTFS) $(WEBCLIENT_LIB_IMPLS) \
$(CLIENT_INTFS) $(CLIENT_IMPLS) \
$(WEBCLIENT_INTFS) $(WEBCLIENT_IMPLS))
DEPENDS_BYTECODE := $(filter-out $(NO_DEPS), $(MINUTILS_LIB_INTFS) $(MINUTILS_LIB_IMPLS))
predepend: node/updater/proto_environment.mli predepend: node/updater/proto_environment.mli
compiler/tezos_compiler.cmo compiler/tezos_compiler.cmx: \ compiler/tezos_compiler.cmo compiler/tezos_compiler.cmx: \
compiler/embedded_cmis.cmi compiler/embedded_cmis.cmx compiler/embedded_cmis.cmi compiler/embedded_cmis.cmx
.SECONDARY: $(patsubst %,%.deps,${DEPENDS}) .SECONDARY: $(patsubst %,%.deps,${DEPENDS}) $(patsubst %,%.deps.byte,${DEPENDS_BYTECODE})
.depend: $(patsubst %,%.deps,${DEPENDS}) .depend: $(patsubst %,%.deps,${DEPENDS}) $(patsubst %,%.deps.byte,${DEPENDS_BYTECODE})
@cat $^ > .depend @cat $^ > .depend
%.ml.deps: %.ml | predepend %.ml.deps: %.ml | predepend
@echo OCAMLDEP ${TARGET} $(notdir $^) @echo OCAMLDEP ${TARGET} $(notdir $^)
@ -497,6 +566,12 @@ compiler/tezos_compiler.cmo compiler/tezos_compiler.cmx: \
%.mli.deps: %.mli | predepend %.mli.deps: %.mli | predepend
@echo OCAMLDEP ${TARGET} $(notdir $^) @echo OCAMLDEP ${TARGET} $(notdir $^)
@$(OCAMLDEP) -native $(INCLUDES) $^ > $@ @$(OCAMLDEP) -native $(INCLUDES) $^ > $@
%.ml.deps.byte: %.ml | predepend
@echo OCAMLDEP ${TARGET} $(notdir $^)
@$(OCAMLDEP) $(INCLUDES) $^ > $@
%.mli.deps.byte: %.mli | predepend
@echo OCAMLDEP ${TARGET} $(notdir $^)
@$(OCAMLDEP) $(INCLUDES) $^ > $@
clean:: clean::
-rm -f .depend -rm -f .depend

View File

@ -102,30 +102,31 @@ let register_config_option version option =
(* Entry point *) (* Entry point *)
let parse_args ?version usage dispatcher = let parse_args ?version usage dispatcher argv =
let open Lwt in let open Lwt in
try begin match version with catch
(fun () ->
let args = ref (cli_group#command_line_args "-") in
begin match version with
| None -> () | None -> ()
| Some version -> | Some version ->
try try
!(Protocol_hash_table.find contextual_options version) () !(Protocol_hash_table.find contextual_options version) ()
with Not_found -> () end ; with Not_found -> () end ;
let base_args = cli_group#command_line_args "-" in
let args = ref base_args in
let anon dispatch n = match dispatch (`Arg n) with let anon dispatch n = match dispatch (`Arg n) with
| `Nop -> () | `Nop -> ()
| `Args nargs -> args := nargs @ !args | `Args nargs -> args := nargs @ !args
| `Fail exn -> raise exn | `Fail exn -> raise exn
| `Res _ -> assert false in | `Res _ -> assert false in
Arg.parse_argv_dynamic Arg.parse_argv_dynamic
~current:(ref 0) Sys.argv args (anon (dispatcher ())) (usage base_args) ; ~current:(ref 0) argv args (anon (dispatcher ())) "\000" ;
let dispatch = dispatcher () in let dispatch = dispatcher () in
(if Sys.file_exists config_file#get then begin (if Sys.file_exists config_file#get then begin
try try
file_group#read config_file#get ; file_group#read config_file#get ;
(* parse once again to overwrite file options by cli ones *) (* parse once again to overwrite file options by cli ones *)
Arg.parse_argv_dynamic Arg.parse_argv_dynamic
~current:(ref 0) Sys.argv args (anon dispatch) (usage base_args) ; ~current:(ref 0) argv args (anon dispatch) "\000" ;
Lwt.return () Lwt.return ()
with Sys_error msg -> with Sys_error msg ->
Cli_entries.error Cli_entries.error
@ -134,7 +135,7 @@ let parse_args ?version usage dispatcher =
try try
(* parse once again with contextual options *) (* parse once again with contextual options *)
Arg.parse_argv_dynamic Arg.parse_argv_dynamic
~current:(ref 0) Sys.argv args (anon dispatch) (usage base_args) ; ~current:(ref 0) argv args (anon dispatch) "\000" ;
Lwt_utils.create_dir (Filename.dirname config_file#get) >>= fun () -> Lwt_utils.create_dir (Filename.dirname config_file#get) >>= fun () ->
file_group#write config_file#get ; file_group#write config_file#get ;
Lwt.return () Lwt.return ()
@ -143,12 +144,22 @@ let parse_args ?version usage dispatcher =
"Warning: can't create the default configuration file: %s\n%!" msg "Warning: can't create the default configuration file: %s\n%!" msg
end) >>= fun () -> end) >>= fun () ->
begin match dispatch `End with begin match dispatch `End with
| `Res res -> | `Res res -> Lwt.return res
res
| `Fail exn -> fail exn | `Fail exn -> fail exn
| `Nop | `Args _ -> assert false | `Nop | `Args _ -> assert false
end end)
with exn -> Lwt.fail exn (function
| Arg.Bad msg ->
(* FIXME: this is an ugly hack to circumvent [Arg]
spuriously printing options at the end of the error
message. *)
let args = cli_group#command_line_args "-" in
let msg = List.hd (Utils.split '\000' msg) in
Lwt.fail (Arg.Help (msg ^ usage args ^ "\n"))
| Arg.Help _ ->
let args = cli_group#command_line_args "-" in
Lwt.fail (Arg.Help (usage args ^ "\n"))
| exn -> Lwt.fail exn)
exception Found of string exception Found of string
let preparse name argv = let preparse name argv =
@ -160,14 +171,14 @@ let preparse name argv =
None None
with Found s -> Some s with Found s -> Some s
let preparse_args () : Node_rpc_services.Blocks.block Lwt.t = let preparse_args argv : Node_rpc_services.Blocks.block Lwt.t =
begin begin
match preparse "-base-dir" Sys.argv with match preparse "-base-dir" argv with
| None -> () | None -> ()
| Some dir -> base_dir#set dir | Some dir -> base_dir#set dir
end ; end ;
begin begin
match preparse "-config-file" Sys.argv with match preparse "-config-file" argv with
| None -> config_file#set @@ base_dir#get // "config" | None -> config_file#set @@ base_dir#get // "config"
| Some file -> config_file#set file | Some file -> config_file#set file
end ; end ;
@ -181,12 +192,12 @@ let preparse_args () : Node_rpc_services.Blocks.block Lwt.t =
else Lwt.return () else Lwt.return ()
end >>= fun () -> end >>= fun () ->
begin begin
match preparse "-addr" Sys.argv with match preparse "-addr" argv with
| None -> () | None -> ()
| Some addr -> incoming_addr#set addr | Some addr -> incoming_addr#set addr
end ; end ;
begin begin
match preparse "-port" Sys.argv with match preparse "-port" argv with
| None -> Lwt.return () | None -> Lwt.return ()
| Some port -> | Some port ->
try try

View File

@ -1,5 +1,7 @@
all: ../client_$(PROTO_VERSION).cmx all: \
../client_$(PROTO_VERSION).cmx \
../webclient_$(PROTO_VERSION).cmx
include ../../../Makefile.config include ../../../Makefile.config
@ -26,25 +28,56 @@ OPENED_MODULES := \
${OPENED_MODULES} ${OPENED_MODULES}
OBJS := \ OBJS := \
${IMPLS:.ml=.cmx} ${IMPLS:.ml=.ml.deps} \ ${CLIENT_IMPLS:.ml=.cmx} ${CLIENT_INTFS:.mli=.cmi}
${INTFS:.mli=.cmi} ${INTFS:.mli=.mli.deps} \ OBJS_DEPS := \
../client_$(PROTO_VERSION).cmx ${CLIENT_IMPLS:.ml=.ml.deps} ${CLIENT_INTFS:.mli=.mli.deps}
${OBJS}: TARGET="(client_$(PROTO_VERSION).cmx)"
${OBJS}: PACKAGES=lwt ocplib-json-typed config-file sodium
${OBJS}: ../../../proto/client_embedded_proto_${PROTO_VERSION}.cmxa
../client_$(PROTO_VERSION).cmx: $(patsubst %.ml, %.cmx, ${IMPLS}) ${OBJS} ${OBJS_DEPS}: TARGET="(client_$(PROTO_VERSION).cmx)"
${OBJS}: EXTRA_OCAMLFLAGS = -for-pack Client_$(PROTO_VERSION)
../client_$(PROTO_VERSION).cmx: EXTRA_OCAMLFLAGS =
${OBJS} ${OBJS_DEPS} ../client_$(PROTO_VERSION).cmx: \
PACKAGES=lwt ocplib-json-typed config-file sodium ocplib-ocamlres
${OBJS} ${OBJS_DEPS} ../client_$(PROTO_VERSION).cmx: \
../../../proto/client_embedded_proto_${PROTO_VERSION}.cmxa
WEBOBJS := \
${WEBCLIENT_IMPLS:.ml=.cmx} ${WEBCLIENT_INTFS:.mli=.cmi}
WEBOBJS_DEPENDS := \
${WEBCLIENT_IMPLS:.ml=.ml.deps} ${WEBCLIENT_INTFS:.mli=.mli.deps}
${WEBOBJS} ${WEBOBJS_DEPS}: TARGET="(webclient_$(PROTO_VERSION).cmx)"
${WEBOBJS} ${WEBOBJS_DEPS}: SOURCE_DIRECTORIES += ..
${WEBOBJS} ${WEBOBJS_DEPS}: OPENED_MODULES += Client_${PROTO_VERSION}
${WEBOBJS}: EXTRA_OCAMLFLAGS = -for-pack Webclient_$(PROTO_VERSION)
../client_$(PROTO_VERSION).cmx: EXTRA_OCAMLFLAGS =
${WEBOBJS} ${WEBOBJS_DEPS} ../webclient_$(PROTO_VERSION).cmx: \
PACKAGES=lwt ocplib-json-typed config-file sodium ocplib-ocamlres
${WEBOBJS} ${WEBOBJS_DEPS} ../webclient_$(PROTO_VERSION).cmx: \
../../../proto/client_embedded_proto_${PROTO_VERSION}.cmxa
${WEBOBJS} ../webclient_$(PROTO_VERSION).cmx: \
../client_${PROTO_VERSION}.cmx
../client_$(PROTO_VERSION).cmx: $(patsubst %.ml, %.cmx, ${CLIENT_IMPLS})
@echo LINK $(notdir $@) @echo LINK $(notdir $@)
@$(OCAMLOPT) -linkall ${OCAMLFLAGS} -pack -o $@ \ @$(OCAMLOPT) -linkall ${OCAMLFLAGS} -pack -o $@ \
$(patsubst %.ml, %.cmx, ${IMPLS}) $(patsubst %.ml, %.cmx, ${CLIENT_IMPLS})
../webclient_$(PROTO_VERSION).cmx: $(patsubst %.ml, %.cmx, ${WEBCLIENT_IMPLS})
@echo LINK $(notdir $@)
@$(OCAMLOPT) -linkall ${OCAMLFLAGS} -pack -o $@ \
$(patsubst %.ml, %.cmx, ${WEBCLIENT_IMPLS})
%.cmx: %.ml %.cmx: %.ml
@echo OCAMLOPT ${TARGET} $(notdir $@) @echo OCAMLOPT ${TARGET} $(notdir $@)
@$(OCAMLOPT) ${OCAMLFLAGS} -for-pack Client_$(PROTO_VERSION) -c $< @$(OCAMLOPT) ${OCAMLFLAGS} -c $<
%.cmo: %.ml
@echo OCAMLC ${TARGET} $(notdir $@)
@$(OCAMLC) ${OCAMLFLAGS} -c $<
%.cmi: %.mli %.cmi: %.mli
@echo OCAMLOPT ${TARGET} $(notdir $@) @echo OCAMLOPT ${TARGET} $(notdir $@)
@$(OCAMLOPT) ${OCAMLFLAGS} -for-pack Client_$(PROTO_VERSION) -c $< @$(OCAMLOPT) ${OCAMLFLAGS} -c $<
%.ml: %.mll %.ml: %.mll
@echo OCAMLLEX ${TARGET} $(notdir $@) @echo OCAMLLEX ${TARGET} $(notdir $@)
@ -57,23 +90,39 @@ ${OBJS}: ../../../proto/client_embedded_proto_${PROTO_VERSION}.cmxa
.PHONY: clean .PHONY: clean
clean:: clean::
-rm -f ../client_$(PROTO_VERSION).cm* ../client_$(PROTO_VERSION).o -rm -f ../client_$(PROTO_VERSION).cm* ../client_$(PROTO_VERSION).o
-rm -f *.cm* *~ *.o *.a *.deps -rm -f ../webclient_$(PROTO_VERSION).cm* ../webclient_$(PROTO_VERSION).o
-rm -f *.cm* *~ *.o *.a *.deps *.deps.byte
-rm -rf _tzbuild -rm -rf _tzbuild
-rm -f .depend -rm -f .depend
ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),clean)
-include .depend include .depend
endif endif
predepend: predepend:
DEPENDS := ${INTFS} ${IMPLS} DEPENDS += \
.SECONDARY: $(patsubst %,%.deps,${DEPENDS}) $(patsubst %,%.deps,${CLIENT_INTFS} ${CLIENT_IMPLS}) \
.depend: $(patsubst %,%.deps,${DEPENDS}) $(patsubst %,%.deps,${WEBCLIENT_INTFS} ${WEBCLIENT_IMPLS})
DEPENDS := $(filter-out ${NODEPENDS}, ${DEPENDS})
.SECONDARY: ${DEPENDS}
.depend: ${DEPENDS}
@cat $^ > .depend @cat $^ > .depend
%.ml.deps: %.ml | predepend %.ml.deps: %.ml | predepend
@echo OCAMLDEP ${TARGET} $(notdir $<) @echo OCAMLDEP ${TARGET} $(notdir $<)
@$(OCAMLDEP) -native $(INCLUDES) ${EXTRA_OCAMLFLAGS} $^ > $@ @$(OCAMLDEP) -native $(INCLUDES) ${EXTRA_OCAMLFLAGS} $< > $@
%.mli.deps: %.mli | predepend %.mli.deps: %.mli | predepend
@echo OCAMLDEP ${TARGET} $(notdir $<) @echo OCAMLDEP ${TARGET} $(notdir $<)
@$(OCAMLDEP) -native $(INCLUDES) ${EXTRA_OCAMLFLAGS} $^ > $@ @$(OCAMLDEP) -native $(INCLUDES) ${EXTRA_OCAMLFLAGS} $< > $@
%.ml.deps.byte: %.ml | predepend
@echo OCAMLDEP ${TARGET} $(notdir $<)
@$(OCAMLDEP) $(INCLUDES) ${EXTRA_OCAMLFLAGS} $< > $@
%.mli.deps.byte: %.mli | predepend
@echo OCAMLDEP ${TARGET} $(notdir $<)
@$(OCAMLDEP) $(INCLUDES) ${EXTRA_OCAMLFLAGS} $< > $@

View File

@ -1,7 +1,7 @@
PROTO_VERSION := bootstrap PROTO_VERSION := bootstrap
INTFS := \ CLIENT_INTFS := \
concrete_parser.mli \ concrete_parser.mli \
client_proto_rpcs.mli \ client_proto_rpcs.mli \
client_proto_args.mli \ client_proto_args.mli \
@ -11,7 +11,7 @@ INTFS := \
client_proto_nonces.mli \ client_proto_nonces.mli \
client_proto_main.mli client_proto_main.mli
IMPLS := \ CLIENT_IMPLS := \
script_located_ir.ml \ script_located_ir.ml \
concrete_parser.ml concrete_lexer.ml \ concrete_parser.ml concrete_lexer.ml \
client_proto_rpcs.ml \ client_proto_rpcs.ml \
@ -22,10 +22,74 @@ IMPLS := \
client_proto_nonces.ml \ client_proto_nonces.ml \
client_proto_main.ml client_proto_main.ml
OPENED_MODULES := Tezos_context WEBCLIENT_INTFS := \
webclient/shared/webclient_proto_services.mli
predepend: concrete_parser.ml concrete_lexer.ml WEBCLIENT_IMPLS := \
webclient/webclient_proto_static.ml \
webclient/shared/webclient_proto_services.ml \
webclient/webclient_proto_service_directory.ml \
webclient/webclient_proto_main.ml
SOURCE_DIRECTORIES := webclient/shared webclient/browser webclient
-include mining/Makefile -include mining/Makefile
JS_IMPLS := \
webclient/shared/webclient_proto_services.ml \
webclient/browser/webclient_main.ml
JS_INTFS := \
webclient/shared/webclient_proto_services.mli
JS_DEPS := $(patsubst %,%.deps.byte,${JS_IMPLS} ${JS_INTFS})
DEPENDS += ${JS_DEPS}
# the generated .ml depends on the result of the bytecode compilation
NODEPENDS := webclient/webclient_proto_static.ml.deps
include ../Makefile.shared include ../Makefile.shared
${WEBOBJS}: OPENED_MODULES += Tezos_context
${OBJS}: OPENED_MODULES += Tezos_context
predepend: concrete_parser.ml concrete_lexer.ml
webclient/webclient_proto_static.ml: $(shell find webclient/static/*) webclient/static/main.js
ocp-ocamlres webclient/static -o $@
webclient/webclient_proto_main.cmx: webclient/webclient_proto_static.cmx
.PHONY: clean
clean::
-rm -f webclient/webclient_proto_static.ml
-rm -f webclient/*/*.cm* webclient/*/*~ webclient/*/*.o webclient/*/*.a
-rm -f webclient/*/*.deps webclient/*/*.deps.byte
-rm -f mining/*.cm* mining/*~ mining/*.o mining/*.a
-rm -f mining/*.deps mining/*.deps.byte
JS_PACKAGES := \
lwt \
cstruct \
ocplib-json-typed.browser \
ocplib-json-typed.bson \
ocplib-resto.directory \
js_of_ocaml.tyxml \
js_of_ocaml.ppx
${JS_DEPS} ${JS_IMPLS:.ml=.cmo} ${JS_INTFS:.mli=.cmi} webclient/browser/main.byte: \
PACKAGES=${JS_PACKAGES}
${JS_DEPS} ${JS_IMPLS:.ml=.cmo} ${JS_INTFS:.mli=.cmi} webclient/browser/main.byte: \
OPENED_MODULES=
${JS_DEPS} ${JS_IMPLS:.ml=.cmo} ${JS_INTFS:.mli=.cmi} webclient/browser/main.byte: \
SOURCE_DIRECTORIES=../../../minutils webclient/shared webclient/browser
webclient/static/main.js: webclient/browser/main.byte
@echo JS_OF_OCAML $(notdir $@)
@js_of_ocaml +weak.js $< -o $@
webclient/browser/main.byte: \
../../../minutils.cma \
${JS_IMPLS:.ml=.cmo}
@echo LINK $(notdir $@)
${OCAMLC} ${OCAMLFLAGS} -o $@ $^ -linkpkg

View File

@ -1,7 +1,7 @@
SOURCE_DIRECTORIES += mining SOURCE_DIRECTORIES += mining
INTFS += \ CLIENT_INTFS += \
mining/client_mining_blocks.mli \ mining/client_mining_blocks.mli \
mining/client_mining_operations.mli \ mining/client_mining_operations.mli \
mining/client_mining_endorsement.mli \ mining/client_mining_endorsement.mli \
@ -11,7 +11,7 @@ INTFS += \
mining/client_mining_daemon.mli \ mining/client_mining_daemon.mli \
mining/client_mining_main.mli \ mining/client_mining_main.mli \
IMPLS += \ CLIENT_IMPLS += \
mining/client_mining_blocks.ml \ mining/client_mining_blocks.ml \
mining/client_mining_operations.ml \ mining/client_mining_operations.ml \
mining/client_mining_endorsement.ml \ mining/client_mining_endorsement.ml \

View File

@ -0,0 +1,5 @@
REC
B browser/
S browser/
B shared/
S shared/

View File

@ -0,0 +1,9 @@
B ../../../../../minutils
S ../../../../../minutils
B ../shared
S ../shared
PKG lwt
PKG ocplib-json-typed.bson
PKG ocplib-resto.directory \
PKG js_of_ocaml.ppx
PKG js_of_ocaml.tyxml

View File

@ -0,0 +1,53 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Lwt.Infix
module Services = Webclient_proto_services.Make (struct
type root = unit
end)
let call_service service params input =
let write_json_body json =
let jsobj =
Json_repr.convert
(module Json_repr.Ezjsonm)
(module Json_repr_browser.Repr)
json in
Js._JSON##stringify jsobj in
let read_json_body body =
Json_repr.convert
(module Json_repr_browser.Repr)
(module Json_repr.Ezjsonm)
(Js._JSON##parse body) in
let path, json = RPC.forge_request service params input in
let url = String.concat "/" path in
let xhr = XmlHttpRequest.create () in
let t, u = Lwt.wait () in
xhr##.onreadystatechange := Js.wrap_callback (fun _ ->
if xhr##.readyState = XmlHttpRequest.DONE then
let response = read_json_body xhr##.responseText in
Lwt.wakeup u response) ;
xhr##_open (Js.string "POST") (Js.string url) Js._true ;
xhr##send (Js.Opt.return (write_json_body json)) ;
t >>= fun json ->
match RPC.read_answer service json with
| Ok res -> Lwt.return res
| Error msg -> Lwt.fail_with msg
let () = Lwt.async @@ fun () ->
call_service Services.contracts () () >>= fun names ->
call_service Services.hash () () >>= fun hash ->
let list = Tyxml_js.Html.(ul (List.map (fun n -> (li [ pcdata n ])) names)) in
Tyxml_js.Register.id "receptacle"
Tyxml_js.Html.
[ h2 [ pcdata "Block: " ; pcdata hash ] ;
h2 [ pcdata "Contract aliases:" ] ;
list ] ;
Lwt.return ()

View File

@ -0,0 +1,5 @@
B ../../../../../minutils
S ../../../../../minutils
PKG lwt
PKG ocplib-json-typed.bson
PKG ocplib-resto.directory

View File

@ -0,0 +1,30 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module type RPC_CONTEXT = sig
type root
end
module Make (RPC_context : RPC_CONTEXT) = struct
let box_result field enc =
let open Data_encoding in
obj1 (req field enc)
let contracts =
let input = Data_encoding.empty in
let output = box_result "contracts" Data_encoding.(list string) in
RPC.service ~input ~output RPC.Path.(root / "contracts")
let hash =
let input = Data_encoding.empty in
let output = box_result "hash" Data_encoding.string in
RPC.service ~input ~output RPC.Path.(root / "hash")
end

View File

@ -0,0 +1,19 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module type RPC_CONTEXT = sig
type root
end
module Make (RPC_context : RPC_CONTEXT) : sig
val contracts :
(RPC_context.root, RPC_context.root, unit, string list) RPC.service
val hash :
(RPC_context.root, RPC_context.root, unit, string) RPC.service
end

View File

@ -0,0 +1,12 @@
<!doctype html>
<html>
<head>
<title>Tezos Web Client :: Bootstrap Version</title>
<meta charset="utf-8" />
<script src="main.js" defer></script>
</head>
<body>
<h1>Tezos Web client :: Bootstrap Version</h1>
<div id="receptacle"></div>
</body>
</html>

View File

@ -0,0 +1,10 @@
<!doctype html>
<html>
<head>
<title>Tezos Web Client :: Bootstrap Version</title>
<meta charset="utf-8" />
</head>
<body>
<h1>Not Found</h1>
</body>
</html>

View File

@ -0,0 +1,15 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let () =
Webclient_version.register_services
Client_proto_main.protocol Webclient_proto_service_directory.root ;
Webclient_version.register_static_files
Client_proto_main.protocol Webclient_proto_static.root

View File

@ -0,0 +1,24 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module Services = Webclient_proto_services.Make (struct
type root = Node_rpc_services.Blocks.block
end)
let root =
let root =
RPC.register RPC.empty Services.contracts @@ fun block () ->
Client_proto_contracts.RawContractAlias.load () >>= fun list ->
let (names, _) = List.split list in
RPC.Answer.return names in
let root =
RPC.register root Services.hash @@ fun block () ->
Client_node_rpcs.(call_service1 Node_rpc_services.Blocks.hash block ()) >>= fun res ->
RPC.Answer.return (Hash.Block_hash.to_b48check res) in
root

View File

@ -1,11 +1,11 @@
PROTO_VERSION = demo PROTO_VERSION = demo
IMPLS = \ CLIENT_IMPLS = \
client_proto_rpcs.ml \ client_proto_rpcs.ml \
client_proto_main.ml client_proto_main.ml
INTFS = \ CLIENT_INTFS = \
client_proto_rpcs.mli \ client_proto_rpcs.mli \
client_proto_main.mli client_proto_main.mli

View File

@ -0,0 +1,28 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
(* Tezos Web Interface - version dependent services *)
let contextual_static_files : string OCamlRes.Res.root Protocol_hash_table.t =
Protocol_hash_table.create 7
let register_static_files version root =
Protocol_hash_table.add contextual_static_files version root
let find_contextual_static_files version =
Protocol_hash_table.find contextual_static_files version
let contextual_services : Node_rpc_services.Blocks.block RPC.directory Protocol_hash_table.t =
Protocol_hash_table.create 7
let register_services version root =
Protocol_hash_table.add contextual_services version root
let find_contextual_services version =
Protocol_hash_table.find contextual_services version

View File

@ -38,7 +38,7 @@ let main () =
Sodium.Random.stir () ; Sodium.Random.stir () ;
catch catch
(fun () -> (fun () ->
Client_config.preparse_args () >>= fun block -> Client_config.preparse_args Sys.argv >>= fun block ->
Lwt.catch Lwt.catch
(fun () -> (fun () ->
Client_node_rpcs.Blocks.protocol block) Client_node_rpcs.Blocks.protocol block)
@ -56,33 +56,36 @@ let main () =
Client_version.commands_for_version version in Client_version.commands_for_version version in
Client_config.parse_args ~version Client_config.parse_args ~version
(Cli_entries.usage commands) (Cli_entries.usage commands)
(Cli_entries.inline_dispatch commands)) (Cli_entries.inline_dispatch commands)
Sys.argv >>= fun command ->
command () >>= fun () ->
Lwt.return 0)
(function (function
| Arg.Help help -> | Arg.Help help ->
Format.printf "%s%!" help ; Format.printf "%s%!" help ;
Pervasives.exit 0 Lwt.return 0
| Arg.Bad help -> | Arg.Bad help ->
Format.eprintf "%s%!" help ; Format.eprintf "%s%!" help ;
Pervasives.exit 1 Lwt.return 1
| Cli_entries.Command_not_found -> | Cli_entries.Command_not_found ->
Format.eprintf "Unkonwn command, try `-help`.\n%!" ; Format.eprintf "Unkonwn command, try `-help`.\n%!" ;
Pervasives.exit 1 Lwt.return 1
| Client_version.Version_not_found -> | Client_version.Version_not_found ->
Format.eprintf "Unkonwn protocol version, try `list versions`.\n%!" ; Format.eprintf "Unkonwn protocol version, try `list versions`.\n%!" ;
Pervasives.exit 1 Lwt.return 1
| Cli_entries.Bad_argument (idx, _n, v) -> | Cli_entries.Bad_argument (idx, _n, v) ->
Format.eprintf "There's a problem with argument %d, %s.\n%!" idx v ; Format.eprintf "There's a problem with argument %d, %s.\n%!" idx v ;
Pervasives.exit 1 Lwt.return 1
| Cli_entries.Command_failed message -> | Cli_entries.Command_failed message ->
Format.eprintf "Command failed, %s.\n%!" message ; Format.eprintf "Command failed, %s.\n%!" message ;
Pervasives.exit 1 Lwt.return 1
| Failure message -> | Failure message ->
Format.eprintf "%s%!" message ; Format.eprintf "%s%!" message ;
Pervasives.exit 1 Lwt.return 1
| exn -> | exn ->
Format.printf "Fatal internal error: %s\n%!" Format.printf "Fatal internal error: %s\n%!"
(Printexc.to_string exn) ; (Printexc.to_string exn) ;
Pervasives.exit 1) Lwt.return 1)
(* Where all the user friendliness starts *) (* Where all the user friendliness starts *)
let () = Lwt_main.run (main ()) let () = Pervasives.exit (Lwt_main.run (main ()))

View File

@ -27,6 +27,9 @@ depends: [
"ocplib-endian" "ocplib-endian"
"ocplib-json-typed" "ocplib-json-typed"
"ocplib-resto" {>= "dev"} "ocplib-resto" {>= "dev"}
"reactiveData"
"tyxml"
"js_of_ocaml"
"sodium" {>= "0.3.0"} "sodium" {>= "0.3.0"}
"kaputt" (* only for testing *) "kaputt" (* only for testing *)
"bisect_ppx" (* only for testing *) "bisect_ppx" (* only for testing *)

View File

@ -189,7 +189,7 @@ let tree_dispatch tree last args =
in in
loop (tree, args) loop (tree, args)
let inline_tree_dispatch tree last = let inline_tree_dispatch tree () =
let state = ref (tree, []) in let state = ref (tree, []) in
fun arg -> match !state, arg with fun arg -> match !state, arg with
| (( TStop c | | (( TStop c |
@ -198,7 +198,7 @@ let inline_tree_dispatch tree last =
TParam { stop = Some c}), acc), TParam { stop = Some c}), acc),
`End -> `End ->
state := (TEmpty, []) ; state := (TEmpty, []) ;
`Res (exec c last (List.rev acc)) `Res (fun last -> exec c last (List.rev acc))
| (TMore c, acc), `Arg n -> | (TMore c, acc), `Arg n ->
state := (TMore c, n :: acc) ; state := (TMore c, n :: acc) ;
`Nop `Nop

View File

@ -54,13 +54,12 @@ val register_tag: tag -> string -> unit
val usage: val usage:
command list -> (string * Arg.spec * string) list -> string command list -> (string * Arg.spec * string) list -> string
val inline_dispatch: val inline_dispatch:
command list -> command list -> unit ->
unit -> [ `Arg of string | `End ] ->
[> `Arg of string | `End ] -> [ `Args of (Arg.key * Arg.spec * Arg.doc) list
[> `Args of (Arg.key * Arg.spec * Arg.doc) list
| `Fail of exn | `Fail of exn
| `Nop | `Nop
| `Res of unit Lwt.t ] | `Res of unit -> unit Lwt.t ]
val dispatch: val dispatch:
command list -> unit -> string list -> unit Lwt.t command list -> unit -> string list -> unit Lwt.t

View File

@ -85,6 +85,7 @@ module Client = struct
module Revelation = Make(struct let name = "client.revealation" end) module Revelation = Make(struct let name = "client.revealation" end)
module Denunciation = Make(struct let name = "client.denunciation" end) module Denunciation = Make(struct let name = "client.denunciation" end)
end end
module Webclient = Make(struct let name = "webclient" end)
let default_logger () = let default_logger () =
Lwt_log.channel ~close_mode:`Keep ~channel:Lwt_io.stderr () Lwt_log.channel ~close_mode:`Keep ~channel:Lwt_io.stderr ()

View File

@ -44,6 +44,7 @@ module Client : sig
module Revelation : LOG module Revelation : LOG
module Denunciation : LOG module Denunciation : LOG
end end
module Webclient : LOG
module Make(S: sig val name: string end) : LOG module Make(S: sig val name: string end) : LOG

218
src/webclient_main.ml Normal file
View File

@ -0,0 +1,218 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
(* Tezos Command line interface - Main Program *)
open Lwt.Infix
open Logging.Webclient
let with_cli_entries_logging =
let startup =
CalendarLib.Printer.Precise_Calendar.sprint
"%Y-%m-%dT%H:%M:%SZ"
(CalendarLib.Calendar.Precise.now ()) in
let stdout = Buffer.create 1000 in
let stderr = Buffer.create 1000 in
let log channel msg = match channel with
| "stdout" ->
Buffer.add_string stdout msg ;
Lwt.return ()
| "stderr" ->
Buffer.add_string stderr msg ;
Lwt.return ()
| log ->
Lwt_utils.create_dir Client_config.(base_dir#get // "webclient_logs" // log) >>= fun () ->
Lwt_io.with_file
~flags: Unix.[ O_APPEND ; O_CREAT ; O_WRONLY ]
~mode: Lwt_io.Output
Client_config.(base_dir#get // "webclient_logs" // log // startup)
(fun chan -> Lwt_io.write chan msg) in
Cli_entries.log_hook := Some log ;
let global_cli_entries_mutex = Lwt_mutex.create () in
(fun callback ->
Lwt_mutex.with_lock
global_cli_entries_mutex
(fun () ->
Buffer.clear stdout ;
Buffer.clear stderr ;
Lwt.catch
(fun () ->
callback () >>= fun result ->
Lwt.return
(Ok (result,
Buffer.contents stdout,
Buffer.contents stderr)))
(fun exn ->
Lwt.return
(Error (exn,
Buffer.contents stdout,
Buffer.contents stderr)))))
let block_protocol block =
Lwt.catch
(fun () ->
Client_node_rpcs.Blocks.protocol block)
(fun _ ->
Cli_entries.message "\n\
The connection to the RPC server failed, \
using the default protocol version.\n" >>= fun () ->
Lwt.return Client_bootstrap.Client_proto_main.protocol)
let eval_command argv =
with_cli_entries_logging
(fun () ->
Client_config.preparse_args argv >>= fun block ->
block_protocol block >>= fun version ->
let commands =
Client_generic_rpcs.commands @
Client_keys.commands () @
Client_protocols.commands () @
Client_helpers.commands () @
Client_version.commands_for_version version in
Client_config.parse_args ~version
(Cli_entries.usage commands)
(Cli_entries.inline_dispatch commands)
argv >>= fun command ->
command ()) >>= function
| Ok ((), stdout, _stderr) ->
Lwt.return (Ok stdout)
| Error (exn, stdout, stderr) ->
let msg = match exn with
| Arg.Help help ->
Format.asprintf "%s%!" help
| Arg.Bad help ->
Format.asprintf "%s%!" help
| Cli_entries.Command_not_found ->
Format.asprintf "Unkonwn command, try `-help`.\n%!"
| Client_version.Version_not_found ->
Format.asprintf "Unkonwn protocol version, try `list versions`.\n%!"
| Cli_entries.Bad_argument (idx, _n, v) ->
Format.asprintf "There's a problem with argument %d, %s.\n%!" idx v
| Cli_entries.Command_failed message ->
Format.asprintf "Command failed, %s.\n%!" message
| Failure msg ->
Format.asprintf "Fatal error: %s\n%!" msg
| exn ->
Format.asprintf "Fatal internal error: %s\n%!" (Printexc.to_string exn) in
let stderr =
if stdout = ""
|| String.get stdout (String.length stderr - 1) = '\n' then
stdout ^ stderr
else
stdout ^ "\n" ^ stderr in
let stderr =
if stderr = ""
|| String.get stderr (String.length stderr - 1) = '\n' then
msg
else
stderr ^ "\n" ^ msg in
Lwt.return (Error stderr)
module ConnectionMap = Map.Make(Cohttp.Connection)
exception Invalid_method
exception Cannot_parse_body of string
let root =
let input, output =
let open Data_encoding in
(obj1 (req "command" string)),
(obj1 (req "output" string)) in
let root =
RPC.empty in
let root =
RPC.register0 root
(RPC.service ~input ~output RPC.Path.(root / "command"))
(fun command ->
let argv = Array.of_list (Utils.split ' ' command) in
eval_command argv >>= function
| Ok output | Error output ->
RPC.Answer.return output) in
let root =
RPC.register_dynamic_directory1 root
RPC.Path.(root / "block" /: Node_rpc_services.Blocks.blocks_arg)
(fun block ->
Client_node_rpcs.Blocks.protocol block >>= fun version ->
let directory = Webclient_version.find_contextual_services version in
let directory = RPC.map (fun ((), block) -> block) directory in
Lwt.return directory) in
root
let find_static_file path =
let path = OCamlRes.Path.of_string path in
let index path = match path with
| ([], None) -> ([], Some ("index", Some "html"))
| oth -> oth in
match path with
| ("block" :: block :: path, file) ->
let path = index (path, file) in
(match Node_rpc_services.Blocks.parse_block block with
| Ok block ->
block_protocol block >>= fun version ->
Lwt.return
(try
let root =
Webclient_version.find_contextual_static_files version in
Some (OCamlRes.Res.find path root)
with Not_found -> None)
| Error _ -> Lwt.return None)
| _ ->
Lwt.return
(try
Some (OCamlRes.Res.find (index path) Webclient_static.root)
with Not_found -> None)
let http_proxy port =
let pre_hook path =
find_static_file path >>= function
| Some body ->
Lwt.return { RPC.Answer.code = 200 ; body = RPC.Answer.Single body }
| None ->
Lwt.return { RPC.Answer.code = 404 ; body = RPC.Answer.Empty } in
let post_hook _ =
(find_static_file "not_found.html" >>= function
| Some body ->
Lwt.return (RPC.Answer.Single body)
| None ->
Lwt.return (RPC.Answer.Empty)) >>= fun body ->
Lwt.return { RPC.Answer.code = 404 ; body } in
RPC_server.launch ~pre_hook ~post_hook port root
let web_port = Client_config.in_both_groups @@
new Config_file.int_cp [ "web" ; "port" ] 8080
"The TCP port to point the web browser to."
(* Where all the user friendliness starts *)
let () =
Pervasives.exit @@ Lwt_main.run
(Lwt.catch
(fun () ->
Client_config.parse_args
(Cli_entries.usage [])
(fun () -> function
| `Arg arg -> raise (Arg.Bad ("unexpected argument " ^ arg))
| `End -> `Res (fun () -> Lwt.return ()))
Sys.argv >>= fun _no_command ->
Random.self_init () ;
Sodium.Random.stir () ;
http_proxy web_port#get >>= fun _server ->
fst (Lwt.wait ()))
(function
| Arg.Help help ->
Format.eprintf "%s%!" help ;
Lwt.return 0
| Arg.Bad help ->
Format.eprintf "%s%!" help ;
Lwt.return 1
| Failure msg ->
Format.eprintf "Fatal error: %s\n%!" msg ;
Lwt.return 1
| exn ->
Format.eprintf "Fatal internal error: %s\n%!" (Printexc.to_string exn) ;
Lwt.return 1))

View File

@ -0,0 +1,33 @@
<!doctype html>
<html>
<head>
<title>Tezos Web Client</title>
<meta charset="utf-8" />
<script src="//code.jquery.com/jquery-2.1.0.min.js"></script>
</head>
<body>
<h1>Tezos Web client</h1>
<form id="form">
./tezos-client <input type="text" name="command" id="command">
<input type="submit" value="RUN">
<br/>
<textarea id="console" cols="80" rows="50"></textarea>
</form>
<script>
$('#form').on('submit', function(e) {
e.preventDefault();
$.ajax ({
url: '/command',
method: 'POST',
contentType: 'application/json',
dataType: 'json',
data: JSON.stringify({ command : './tezos-client ' + $('#command')[0].value }),
processData: false
}).done (function ({ output }) {
console.log (output);
$('#console')[0].value += output;
})
})
</script>
</body>
</html>

View File

@ -0,0 +1,10 @@
<!doctype html>
<html>
<head>
<title>Tezos Web Client</title>
<meta charset="utf-8" />
</head>
<body>
<h1>Not Found</h1>
</body>
</html>

View File

@ -214,7 +214,6 @@ COVERAGESRCDIR= \
-I ../src/client/embedded \ -I ../src/client/embedded \
-I ../src/client/embedded/bootstrap \ -I ../src/client/embedded/bootstrap \
-I ../src/client/embedded/bootstrap/mining \ -I ../src/client/embedded/bootstrap/mining \
-I ../src/client/embedded/bootstrap/demo \
-I ../src/compiler \ -I ../src/compiler \
-I ../src/node \ -I ../src/node \
-I ../src/node/db \ -I ../src/node/db \