Commit dd2f09b9 authored by MARCHE Claude's avatar MARCHE Claude

Why3 web interface: first draft

Can be tested using

bin/why3webserver.opt & firefox src/ide/index.html
parent 38ac7eb5
......@@ -736,6 +736,53 @@ install_local:: bin/why3ide
endif
###############
# WEBSERV
###############
WEBSERV_FILES = unix_scheduler wserver why3web
WEBSERVMODULES = $(addprefix src/ide/, $(WEBSERV_FILES))
WEBSERVDEP = $(addsuffix .dep, $(WEBSERVMODULES))
WEBSERVCMO = $(addsuffix .cmo, $(WEBSERVMODULES))
WEBSERVCMX = $(addsuffix .cmx, $(WEBSERVMODULES))
$(WEBSERVDEP): DEPFLAGS += -I src/ide
$(WEBSERVCMO) $(WEBSERVCMX): INCLUDES += -I src/ide
# build targets
byte: bin/why3webserver.byte
opt: bin/why3webserver.opt
bin/why3webserver.opt: lib/why3/why3.cmxa $(WEBSERVCMX)
$(SHOW) 'Linking $@'
$(HIDE)$(OCAMLOPT) $(OFLAGS) -o $@ $(OLINKFLAGS) $^
bin/why3webserver.byte: lib/why3/why3.cma $(WEBSERVCMO)
$(SHOW) 'Linking $@'
$(HIDE)$(OCAMLC) $(BFLAGS) -o $@ $(BLINKFLAGS) -custom $^
# depend and clean targets
ifneq "$(MAKECMDGOALS:clean%=clean)" "clean"
-include $(WEBSERVDEP)
endif
depend: $(WEBSERVDEP)
CLEANDIRS += src/ide
clean_old_install::
rm -f $(BINDIR)/why3webserver$(EXE)
install_no_local::
$(INSTALL) bin/why3webserver.@OCAMLBEST@ $(TOOLDIR)/why3webserver$(EXE)
install_local:: bin/why3webserver
###############
# Session
###############
......
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
"http://www.w3.org/TR/html4/strict.dtd">
<html>
<head>
<title>Why3</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
</head>
<body id="body" style="background-color:#e0e0a0">
<h1>Test</h1>
<p>
<button id="b1" onClick="sendRequest('bouton1');">Button 1</button>
<button id="b2" onClick="sendRequest('bouton2');">Button 2</button>
<button id="b3" onclick="startNotificationHandler()">Start notification handler</button>
<button id="b4" onclick="stopNotificationHandler()">Stop notification handler</button>
</p>
<div id="answers" style="overflow:auto">
<p>Answer zone</p>
</div>
<script type="text/javascript" src="why3ide.js"></script>
</body>
</html>
function printAnswer (s) {
var node = document.createElement("P");
var textnode = document.createTextNode(s);
node.appendChild(textnode);
document.getElementById('answers').appendChild(node);
}
function readBody(xhr) {
var data;
if (!xhr.responseType || xhr.responseType === "text") {
data = xhr.responseText;
} else if (xhr.responseType === "document") {
data = xhr.responseXML;
} else {
data = xhr.response;
}
return data;
}
function getNotification () {
var req = new XMLHttpRequest();
req.open('GET', 'http://localhost:6789/getNotifications', true);
req.onreadystatechange = function (aEvt) {
if (req.readyState == XMLHttpRequest.DONE) {
if(req.status == 200)
printAnswer("" + readBody(req));
else
printAnswer("Erreur " + req.status);
}
};
req.send(null);
}
var notifHandler = null;
function startNotificationHandler() {
if (notifHandler == null) {
notifHandler = setInterval(getNotification,1000);
}
}
function stopNotificationHandler() {
if (notifHandler != null) {
clearInterval(notifHandler);
notifHandler = null;
}
}
function sendRequest(r) {
var req = new XMLHttpRequest();
req.open('GET', 'http://localhost:6789/request?value='+r, true);
req.overrideMimeType('text/json');
req.onreadystatechange = function (aEvt) {
if (req.readyState == XMLHttpRequest.DONE) {
if(req.status == 200)
printAnswer("" + readBody(req));
else
printAnswer("Erreur " + req.status);
}
};
req.send(null);
}
open Why3
module P = struct
let notify _ = ()
let get_requests () = []
end
module S = Itp_server.Make (Unix_scheduler.Unix_scheduler) (P)
open Format
let handle_script s args =
match s with
| "request" -> "{ \"request\": \"" ^ args ^ "\" }"
| "getNotifications" ->
let n = Random.int 4 in
"{ \"kind\": \"Random\", \"value\" = \"" ^ string_of_int n ^ "\" }"
| _ -> "bad request"
let plist fmt l =
List.iter (fun x -> fprintf fmt "'%s'@\n" x) l
let string_of_addr addr =
match addr with
| Unix.ADDR_UNIX s -> s
| Unix.ADDR_INET (ie,i) ->
(Unix.string_of_inet_addr ie)^":"^string_of_int(i)
let handler (addr,req) script cont fmt =
eprintf "addr : %s@." (string_of_addr addr);
eprintf "req: @[%a@]@." plist req;
eprintf "script: `%s'@." script;
eprintf "cont: `%s'@." cont;
let ans = handle_script script cont in
Wserver.http_header fmt "HTTP/1.0 200 OK";
fprintf fmt "Access-Control-Allow-Origin: *\n";
fprintf fmt "\n"; (* end of header *)
fprintf fmt "%s" ans;
fprintf fmt "@."
let () = Wserver.main_loop None 6789 handler
This diff is collapsed.
val main_loop : string option -> int ->
(Unix.sockaddr * string list -> string -> string -> Format.formatter -> unit) -> unit
(** [main_loop addr port g] starts an elementary httpd server at port
[port] in the current machine. The variable [addr] is [Some
the-address-to-use] or [None] for any of the available addresses
of the present machine. The port number is any number greater than
1024 (to create a client < 1024, you must be root). At each
connection, the function [g] is called: [g (addr, request) scr
cont fmt] where [addr] is the client identification socket,
[request] the browser request, [scr] the script name (extracted
from [request]) and [cont] the stdin contents. [fmt] is the
formatter where the answer should be written. It must start by a
call to [http_header] below. *)
val timeout: ms:int -> (unit -> bool) -> unit
(** [timeout ~ms f] registers the function [f] as a function to be
called every [ms] milliseconds. The function is called repeatedly
until it returns false. the [ms] delay is not strictly guaranteed:
it is only a minimum delay between the end of the last call and
the beginning of the next call. Several functions can be
registered at the same time. *)
val idle: prio:int -> (unit -> bool) -> unit
(** [idle prio f] registers the function [f] as a function to be
called whenever there is nothing else to do. Several functions can
be registered at the same time. Several functions can be
registered at the same time. Functions registered with higher
priority will be called first. *)
val http_header : Format.formatter -> string -> unit
(** [http answer] sends the http header where [answer] represents the
answer status. If empty string, "200 OK" is assumed. *)
val encode : string -> string
(** [encode s] encodes the string [s] in another string where spaces
and special characters are coded. This allows to put such strings
in html links <a href=...>. This is the same encoding done by Web
browsers in forms. *)
val decode : string -> string
(** [decode s] does the inverse job than [Wserver.code], restoring the
initial string. *)
val extract_param : string -> char -> string list -> string
(** [extract_param name stopc request] can be used to extract some
parameter from a browser [request] (list of strings); [name] is a
string which should match the beginning of a request line, [stopc]
is a character ending the request line. For example, the string
request has been obtained by: [extract_param "GET /" ' '].
Answers the empty string if the parameter is not found. *)
val get_request_and_content : char Stream.t -> string list * string
val string_of_sockaddr : Unix.sockaddr -> string
val sockaddr_of_string : string -> Unix.sockaddr
......@@ -21,8 +21,6 @@ open Printer
open Theory
open Task
open Args_wrapper
(* Labels and locations can be printed by setting the appropriate flags *)
let debug_print_labels = Debug.register_info_flag "print_labels"
~desc:"Print@ labels@ of@ identifiers@ and@ expressions."
......@@ -387,7 +385,7 @@ let print_qt tables fmt th =
(print_list (constant_string ".") string) th.th_path
(print_th tables) th
let print_tdecl tables fmt td = match td.td_node with
let _print_tdecl tables fmt td = match td.td_node with
| Decl d ->
fprintf fmt "%a@\n" (print_decl tables) d
| Use th ->
......
......@@ -77,7 +77,7 @@ module Make (S:Controller_itp.Scheduler) (P:Protocol) = struct
module C = Controller_itp.Make(S)
let debug = Debug.register_flag "itp_server"
let _debug = Debug.register_flag "itp_server"
(************************)
(* parsing command line *)
......
......@@ -14,6 +14,7 @@ let create = String.create
let copy = String.copy
let set = String.set
let lowercase = String.lowercase
let capitalize = String.capitalize
let uncapitalize = String.uncapitalize
......
......@@ -17,6 +17,7 @@ val create : int -> string
val copy : string -> string
val set : string -> int -> char -> unit
val lowercase : string -> string
val capitalize : string -> string
val uncapitalize : string -> string
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment