diff --git a/toplevel/Makefile b/toplevel/Makefile index 6642893cc8..1e3cf28547 100644 --- a/toplevel/Makefile +++ b/toplevel/Makefile @@ -92,6 +92,9 @@ $(NAME).byte: $(OBJS) ../compiler/compiler.cma errors.cmi: errors.mli $(OCAMLC) -c $< +server: server.ml + ocamlfind ocamlc -linkpkg -package cohttp.lwt server.ml -o server + clean:: rm -f *.cm[io] $(NAME).byte $(NAME).js diff --git a/toplevel/server.ml b/toplevel/server.ml new file mode 100644 index 0000000000..58a5b4c571 --- /dev/null +++ b/toplevel/server.ml @@ -0,0 +1,44 @@ +open Lwt +open Cohttp +open Cohttp_lwt_unix +open Re + +let address = ref "127.0.0.1" +let port = ref 8888 +let filesys = ref (Filename.concat (Sys.getenv "HOME") ".opam") + +let server () = + + let re_filesys = compile (seq [ str "/filesys/"; group (rep any); eos ]) in + + let header typ = + let h = Header.init () in + let h = Header.add h "Content-Type" typ in + let h = Header.add h "Server" "iocaml" in + h + in + let header_html = header "text/html; charset=UTF-8" in + let header_plain_user_charset = header "text/plain; charset=x-user-defined" in + + let callback conn_id req body = + let uri = Request.uri req in + let path = Uri.path uri in + + try + (* send binary file *) + let fname = get (exec re_filesys path) 1 in + Lwt_io.eprintf "filesys: %s\n" fname >>= fun () -> + Server.respond_file ~headers:header_plain_user_charset ~fname:fname () + with _ -> + (* send static file *) + let fname = Server.resolve_file ~docroot:"." ~uri:uri in + Lwt_io.eprintf "static: %s\n" fname >>= fun () -> + Server.respond_file ~headers:header_html ~fname:fname () + + in + let conn_closed conn_id () = () in + let config = { Server.callback; conn_closed } in + Server.create ~address:!address ~port:!port config + +let () = Lwt_unix.run (server()) + diff --git a/toplevel/toplevel.ml b/toplevel/toplevel.ml index 129e9a36a4..028e13367f 100644 --- a/toplevel/toplevel.ml +++ b/toplevel/toplevel.ml @@ -118,6 +118,7 @@ end = struct class type global_data = object method compile : (string -> string) Js.writeonly_prop + method auto_register_file_ : (string -> int) Js.writeonly_prop end external global_data : unit -> global_data Js.t = "caml_get_global_data" @@ -205,7 +206,31 @@ end = struct flush_all () + (* load (binary) file from server using a synchronous XMLHttpRequest *) + let load_from_server path = + let xml = XmlHttpRequest.create () in + let () = xml##_open(Js.string "GET", Js.string ("filesys/" ^ path), Js._false) in + let () = xml##send(Js.null) in + if xml##status = 200 then + let resp = xml##responseText in + let len = resp##length in + let str = String.create len in + for i=0 to len-1 do + str.[i] <- Char.chr (int_of_float resp##charCodeAt(i) land 0xff) + done; + Some(str) + else + None + + let auto_register_file name = + match load_from_server name with + | None -> 0 + | Some(content) -> + let () = Sys_js.register_file ~name ~content in + 1 + let initialize () = + g##auto_register_file_ <- auto_register_file; Toploop.initialize_toplevel_env (); Toploop.input_name := "//toplevel//"; let header = " Objective Caml version %s@.@." in