diff --git a/_tags b/_tags deleted file mode 100644 index 09b646a..0000000 --- a/_tags +++ /dev/null @@ -1,9 +0,0 @@ - : syntax(camlp4o), package(cow,cow.syntax) - : syntax(camlp4o), package(lwt.syntax,yojson,unix) - : syntax(camlp4o), package(lwt.syntax,iocaml-kernel,uuidm,yojson) - : package(lwt,re) - : syntax(camlp4o), package(lwt.syntax,uri,websocket.lwt,iocaml-kernel,yojson) -: syntax(camlp4o), package(findlib,cow,lwt.syntax,cohttp.lwt,websocket.lwt,iocaml-kernel,uuidm,yojson) - - : package(findlib,cow,lwt.unix,cohttp,websocket.lwt,iocaml-kernel,uuidm,yojson) -true: annot, bin_annot, debug, principal, strict_sequence diff --git a/bridge.ml b/bridge.ml index 168c0da..d6ee43b 100644 --- a/bridge.ml +++ b/bridge.ml @@ -1,4 +1,4 @@ -(* +(* * iocamlserver - IOCaml notebook server * * (c) 2014 MicroJamJar Ltd @@ -7,19 +7,19 @@ * Description: bridge websockets and zmq sockets * *) -open Lwt +open Lwt.Infix open Iocaml_zmq type ws_stream = Websocket_lwt.Frame.t Lwt_stream.t type ws_push = Websocket_lwt.Frame.t -> unit Lwt.t -type ws_comm = ws_stream * ws_push +type ws_comm = ws_stream * ws_push -let zmq_of_ws_message data = +let zmq_of_ws_message data = let open Yojson.Basic in let data = from_string data in match data with | `Assoc l -> - [ + [ ""; ""; to_string (List.assoc "header" l); @@ -29,7 +29,7 @@ let zmq_of_ws_message data = ] | _ -> raise (Failure "deserialize_ws") -let ws_of_zmq_message data = +let ws_of_zmq_message data = let open Yojson.Basic in let rec find = function | [] -> raise (Failure "bad zmq message") @@ -38,7 +38,7 @@ let ws_of_zmq_message data = | h::t -> find t in let header,parent,meta,content = find data in - let extract data = + let extract data = match header with `Assoc l -> (List.assoc data l) | _ -> `String "error" in to_string @@ -51,62 +51,63 @@ let ws_of_zmq_message data = "metadata", meta; ]) -let ws_to_zmq verbose name stream socket = - lwt frame = Lwt_stream.next stream in - let data = frame.Websocket_lwt.Frame.content in - lwt () = - if verbose > 1 then Lwt_io.eprintf "[ws->zmq]%s: %s\n" name data - else return () - in - try_lwt Lwt_zmq.Socket.send_all socket (zmq_of_ws_message data) - with _ -> return () +let ws_to_zmq verbose name stream socket = + Lwt_stream.next stream >>= fun frame -> + let data = frame.Websocket_lwt.Frame.content in + (if verbose > 1 then Lwt_io.eprintf "[ws->zmq]%s: %s\n" name data + else Lwt.return_unit) >>= fun () -> + Lwt.catch + (fun () -> Lwt_zmq.Socket.send_all socket (zmq_of_ws_message data)) + (fun _ -> Lwt.return_unit) -let zmq_to_ws verbose name socket push = - lwt frames = Lwt_zmq.Socket.recv_all socket in - lwt () = - if verbose > 1 then Lwt_list.iter_s (Lwt_io.eprintf "[zmq->ws]%s: %s\n" name) frames - else return () - in - try_lwt - let frame = ws_of_zmq_message frames in - push (Websocket_lwt.Frame.create ~content:frame ()) - with _ -> return () +let zmq_to_ws verbose name socket (push : ws_push) = + Lwt_zmq.Socket.recv_all socket >>= fun frames -> + (if verbose > 1 then + Lwt_list.iter_s (Lwt_io.eprintf "[zmq->ws]%s: %s\n" name) frames + else + Lwt.return ()) >>= fun () -> + Lwt.catch (fun () -> + let frame = ws_of_zmq_message frames in + push (Websocket_lwt.Frame.create ~content:frame ()) + ) (fun _exn -> Lwt.return_unit) -let rec ws_zmq_comms verbose name socket uri (stream,push) = - lwt _ = zmq_to_ws verbose name socket push ws_to_zmq verbose name stream socket in - ws_zmq_comms verbose name socket uri (stream,push) +let rec ws_zmq_comms verbose name socket uri (stream, push) = + zmq_to_ws verbose name socket push ws_to_zmq verbose name stream socket >>= fun _ -> + ws_zmq_comms verbose name socket uri (stream,push) -let ws_init verbose id req recv send = +let ws_init verbose (client : Websocket_lwt.Connected_client.t) = let open Websocket_lwt in let open Kernel in - try_lwt - recv () >>= fun cookie -> + Lwt.catch (fun () -> + Connected_client.recv client >>= fun cookie -> (* we get one special message per channel, after which it's comms time *) let cookie = cookie.Frame.content in - lwt () = if verbose > 1 then Lwt_io.eprintf "cookie:[%i] %s\n" (String.length cookie) cookie else return () in + (if verbose > 1 then + Lwt_io.eprintf "cookie:[%i] %s\n" (String.length cookie) cookie + else + Lwt.return_unit) >>= fun () -> (* parse the uri to find out which socket we want *) - let get guid = - match M.kernel_of_kernel_guid guid with - | None -> fail (Failure ("cant find kernel: " ^ guid)) - | Some(x) -> return x + let get guid = + match M.kernel_of_kernel_guid guid with + | None -> Lwt.fail_with ("cant find kernel: " ^ guid) + | Some x -> Lwt.return x in - let uri = Cohttp.Request.uri req in - let stream = Websocket_lwt.mk_frame_stream recv in - match_lwt Uri_paths.decode_ws (Uri.path uri) with - | `Ws_shell(guid) -> - get guid >>= fun k -> ws_zmq_comms verbose "shell" (k.shell()) uri (stream,send) - | `Ws_stdin(guid) -> - get guid >>= fun k -> ws_zmq_comms verbose "stdin" (k.stdin()) uri (stream,send) - | `Ws_iopub(guid) -> - get guid >>= fun k -> ws_zmq_comms verbose "iopub" (k.iopub()) uri (stream,send) - | `Error_not_found -> - Lwt.fail (Failure "invalid websocket url") - - with - | x -> - lwt () = - if verbose > 0 then Lwt_io.eprintf "ws_init failed with %s\n" (Printexc.to_string x) - else return () - in - return () - + let uri = Cohttp.Request.uri (Connected_client.http_request client) in + let stream = + Websocket_lwt.mk_frame_stream + (fun () -> Connected_client.recv client) in + let send = Connected_client.send client in + Uri_paths.decode_ws (Uri.path uri) >>= function + | `Ws_shell(guid) -> + get guid >>= fun k -> ws_zmq_comms verbose "shell" (k.shell()) uri (stream, send) + | `Ws_stdin(guid) -> + get guid >>= fun k -> ws_zmq_comms verbose "stdin" (k.stdin()) uri (stream, send) + | `Ws_iopub(guid) -> + get guid >>= fun k -> ws_zmq_comms verbose "iopub" (k.iopub()) uri (stream, send) + | `Error_not_found -> + Lwt.fail (Failure "invalid websocket url") + ) (fun x -> + if verbose > 0 then + Lwt_io.eprintf "ws_init failed with %s\n" (Printexc.to_string x) + else + Lwt.return_unit) diff --git a/bridge.mli b/bridge.mli index 7740a81..828e9ac 100644 --- a/bridge.mli +++ b/bridge.mli @@ -1,4 +1,4 @@ -(* +(* * iocamlserver - IOCaml notebook server * * (c) 2014 MicroJamJar Ltd @@ -12,7 +12,7 @@ open Iocaml_zmq type ws_stream = Websocket_lwt.Frame.t Lwt_stream.t type ws_push = Websocket_lwt.Frame.t -> unit Lwt.t -type ws_comm = ws_stream * ws_push +type ws_comm = ws_stream * ws_push val zmq_of_ws_message : string -> string list @@ -24,8 +24,4 @@ val zmq_to_ws : int -> string -> 'a Lwt_zmq.Socket.t -> ws_push -> unit Lwt.t val ws_zmq_comms : int -> string -> 'a Lwt_zmq.Socket.t -> Uri.t -> ws_comm -> unit Lwt.t -val ws_init : int -> - (int -> - Cohttp.Request.t -> - (unit -> Websocket_lwt.Frame.t Lwt.t) -> (Websocket_lwt.Frame.t -> unit Lwt.t) -> unit Lwt.t) - +val ws_init : int -> (Websocket_lwt.Connected_client.t -> unit Lwt.t) diff --git a/config.darwin.ml b/config.darwin.ml deleted file mode 100644 index 95e994d..0000000 --- a/config.darwin.ml +++ /dev/null @@ -1 +0,0 @@ -let default_browser_command = "open" diff --git a/config.ml b/config.ml index fe70603..442917b 100644 --- a/config.ml +++ b/config.ml @@ -1 +1,30 @@ +let with_process_in cmd args f = + let path = ["/bin";"/usr/bin"] in + let cmd = + List.find Sys.file_exists (List.map (fun d -> Filename.concat d cmd) path) + in + let ic = Unix.open_process_in (cmd^" "^args) in + try + let r = f ic in + ignore (Unix.close_process_in ic) ; r + with exn -> + ignore (Unix.close_process_in ic) ; raise exn + +let uname_s () = + try + with_process_in "uname" "-s" + (fun ic -> Some (String.trim (input_line ic))) + with Unix.Unix_error _ | Sys_error _ | Not_found -> + None + let default_browser_command = "xdg-open" + +let default_browser_command = + match Sys.os_type with + | "Unix" -> + begin match uname_s () with + | Some "Darwin" -> "open" + | _ -> "xdg-open" + end + | _ -> "xdg-open" + diff --git a/files.ml b/files.ml index 0de2f77..e06d6ab 100644 --- a/files.ml +++ b/files.ml @@ -1,4 +1,4 @@ -(* +(* * iocamlserver - IOCaml notebook server * * (c) 2014 MicroJamJar Ltd @@ -7,40 +7,39 @@ * Description: Utilities to deal with notebooks on the file system * *) -open Lwt +open Lwt.Infix module SSet = Set.Make(String) -let list_notebooks path = - lwt h = Lwt_unix.opendir path in - let rec f l = - try_lwt - lwt n = Lwt_unix.readdir h in - lwt s = Lwt_unix.stat Filename.(concat path n) in - if Filename.check_suffix n ".ipynb" && - Lwt_unix.(s.st_kind = S_REG) then - f (Filename.(chop_suffix (basename n) ".ipynb")::l) - else - f l - with _ -> - return l - in - f [] - -let new_notebook_name cur = - let set = List.fold_right SSet.add cur SSet.empty in - let name = "Untitled" in - let rec f i = - let name = name ^ string_of_int i in - return (SSet.mem name set) - >>= function - | true -> f (i+1) - | false -> return name - in - f 0 +let list_notebooks path = + Lwt_unix.opendir path >>= fun h -> + let rec f l = + Lwt.catch (fun () -> + Lwt_unix.readdir h >>= fun n -> + Lwt_unix.stat Filename.(concat path n) >>= fun s -> + if Filename.check_suffix n ".ipynb" && + Lwt_unix.(s.st_kind = S_REG) then + f (Filename.(chop_suffix (basename n) ".ipynb")::l) + else + f l + ) (fun _ -> Lwt.return l) + in + f [] + +let new_notebook_name cur = + let set = List.fold_right SSet.add cur SSet.empty in + let name = "Untitled" in + let rec f i = + let name = name ^ string_of_int i in + Lwt.return (SSet.mem name set) + >>= function + | true -> f (i+1) + | false -> Lwt.return name + in + f 0 (* the json that's served for an empty notebook *) -let empty_notebook title = +let empty_notebook title = let open Yojson.Basic in pretty_to_string ~std:true (`Assoc [ @@ -52,17 +51,17 @@ let empty_notebook title = let is_regular_file f = try Unix.((stat f).st_kind = S_REG) with _ -> false let using_out n f = let n = open_out n in let r = f n in close_out n; r -let file_or_path file_or_path = +let file_or_path file_or_path = let failwith x = failwith (file_or_path ^ ": " ^ x) in - let file_or_path = - if file_or_path = "" || file_or_path = "." || file_or_path = "./" then + let file_or_path = + if file_or_path = "" || file_or_path = "." || file_or_path = "./" then Unix.getcwd () - else if Filename.is_relative file_or_path then + else if Filename.is_relative file_or_path then Filename.concat (Unix.getcwd ()) file_or_path - else + else file_or_path in - + if Filename.check_suffix file_or_path ".ipynb" then (* if the name ends in .ipynb then assume it is a file *) let split s = Filename.(dirname s, basename s) in @@ -71,8 +70,8 @@ let file_or_path file_or_path = else failwith "expecting a file" else let path,name = split file_or_path in - let () = using_out file_or_path - (fun file -> + let () = using_out file_or_path + (fun file -> output_string file (empty_notebook Filename.(chop_suffix name ".ipynb"))) in path,name @@ -81,7 +80,7 @@ let file_or_path file_or_path = if Sys.file_exists file_or_path then if Sys.is_directory file_or_path then file_or_path, "" - else + else failwith "expecting a directory" else failwith "directory doesnt exist" @@ -98,14 +97,14 @@ let rejoin = function let split = function | `List l -> `List l | `String s -> begin - let split str = + let split str = let len = String.length str in - let rec scan pos = + let rec scan pos = if pos = (len-1) then pos else if str.[pos] = '\n' then pos else scan (pos+1) in - let rec split start_pos = + let rec split start_pos = if start_pos >= len then [] else let end_pos = scan start_pos in @@ -117,37 +116,37 @@ let split = function end | _ as x -> failwith ("split: expecting string or list" ^ Yojson.Basic.pretty_to_string x) -let process_lines fn json = +let process_lines fn json = let open Yojson.Basic in - let failwith message json = + let failwith message json = failwith (message ^ " : " ^ pretty_to_string json) in - let map_dict name json f = + let map_dict name json f = let open Yojson.Basic in let el = Util.member name json in if el = `Null then json else replace_dict name (f el) json in - let map_dict_list_el name json f = - map_dict name json - (function + let map_dict_list_el name json f = + map_dict name json + (function | `List l -> `List (List.map f l) | _ as x -> failwith ("map_dict_list_el: expecting list in " ^ name) x) in - let outputs json = - List.fold_left + let outputs json = + List.fold_left (fun json name -> map_dict name json fn) json [ "text"; "html"; "svg"; "latex"; "javascript"; "json" ] in - let cell json = + let cell json = match Util.member "cell_type" json with | `String "code" -> (* rewrite "input" and "outputs" *) let json = map_dict "input" json fn in - map_dict_list_el "outputs" json outputs + map_dict_list_el "outputs" json outputs | `String _ -> map_dict "source" json fn | _ as x -> failwith "invalid cell type" x @@ -155,10 +154,10 @@ let process_lines fn json = let worksheet json = map_dict_list_el "cells" json cell in map_dict_list_el "worksheets" json worksheet -let diffable_pretty_to_string json = +let diffable_pretty_to_string json = let open Easy_format in let rec f = function - | List(("[", s, c, p), t) -> + | List(("[", s, c, p), t) -> List(("[", s, c, {p with wrap_body = `Force_breaks}), List.map f t) | List((o, s, c, p), t) -> List((o, s, c, p), List.map f t) | Label((t0, p), t1) -> Label((f t0, p), f t1) @@ -166,7 +165,7 @@ let diffable_pretty_to_string json = in Pretty.to_string (f (Yojson.Basic.pretty_format ~std:true json)) -let prepare_ipynb_for_saving no_split_lines data = +let prepare_ipynb_for_saving no_split_lines data = let open Yojson.Basic in let json = from_string data in @@ -174,30 +173,28 @@ let prepare_ipynb_for_saving no_split_lines data = let name = Util.member "name" metadata in let filename = Util.to_string name in - (* rewrite the json with an empty notebook name *) + (* rewrite the json with an empty notebook name *) let json = replace_dict "metadata" (replace_dict "name" (`String "") metadata) json in - let json = - if no_split_lines then to_string ~std:true json - else diffable_pretty_to_string (process_lines split json) + let json = + if no_split_lines then to_string ~std:true json + else diffable_pretty_to_string (process_lines split json) in filename, json -let load_ipynb_for_serving path nbname = +let load_ipynb_for_serving path nbname = let open Yojson.Basic in - lwt data = - Lwt_io.(with_file ~mode:input (path (nbname ^ ".ipynb")) read) - in + Lwt_io.(with_file ~mode:input (path (nbname ^ ".ipynb")) read) >>= fun data -> let json = from_string data in let metadata = Util.member "metadata" json in let json = replace_dict "metadata" (replace_dict "name" (`String nbname) metadata) json in let json = process_lines rejoin json in - return (to_string ~std:true json) + Lwt.return (to_string ~std:true json) -let tutorial_notebook () = +let tutorial_notebook () = let open Yojson.Basic in match Tutorial.read "tutorial.ipynb" with | None -> failwith "tutorial not found" @@ -213,8 +210,8 @@ let tutorial_notebook () = (*************************************************************) (* static site generation *) -let paths fln = - let rec paths lst fln = +let paths fln = + let rec paths lst fln = let dir = Filename.dirname fln in match lst with | prev_dir :: tl when prev_dir = dir -> lst @@ -222,28 +219,28 @@ let paths fln = in paths [fln] fln -let create_dir_for_file to_file = +let create_dir_for_file to_file = let to_dir = Filename.dirname to_file in let to_paths = paths to_dir in - let create_dir d = - try + let create_dir d = + try if Sys.is_directory d then () else failwith ("not a directory: " ^ d) with Sys_error _ -> begin - try Unix.mkdir d 0o777 + try Unix.mkdir d 0o777 with _ -> failwith ("couldn't make directory: " ^ d) end in List.iter create_dir to_paths -let write_file data to_file = +let write_file data to_file = let f = open_out_bin to_file in output_string f data; close_out f -let copy_static to_dir = +let copy_static to_dir = let files = Filesys.file_list in - let write_static_file from_file = + let write_static_file from_file = let to_file = Filename.concat to_dir from_file in (* create dir if it doesn't exist already *) create_dir_for_file to_file; @@ -256,16 +253,16 @@ let copy_static to_dir = let () = Printf.printf "ok\n%!" in () -let copy_js_kernel to_dir iocaml_kernel = +let copy_js_kernel to_dir iocaml_kernel = let mk_kernel_name t = "kernel." ^ t ^ ".js" in let spath = "static/services/kernels/js" in - let in_file = + let in_file = match iocaml_kernel with | `byte_code_kernel -> failwith "you must specify a javascript kernel" - | `js_kernel(p, t) -> Filename.concat p (Filename.concat spath (mk_kernel_name t)) + | `js_kernel(p, t) -> Filename.concat p (Filename.concat spath (mk_kernel_name t)) | `js_kernel_file f -> f in - let out_file = + let out_file = match iocaml_kernel with | `byte_code_kernel -> failwith "you must specify a javascript kernel" | `js_kernel(p, t) -> Filename.concat to_dir (Filename.concat spath (mk_kernel_name t)) @@ -282,14 +279,14 @@ let copy_js_kernel to_dir iocaml_kernel = output out_file buf 0 len; copy () end - in + in let () = copy () in let () = Printf.printf "ok\n%!" in () -let get_notebook_list notebook_path filename = +let get_notebook_list notebook_path filename = let () = Printf.printf "getting notebook list...%!" in - let nb = + let nb = if filename <> "" then (* just the 1 notebook, as specified on the commandline. check it exists *) let notebook_filename = Filename.concat notebook_path filename in @@ -298,7 +295,7 @@ let get_notebook_list notebook_path filename = else (* find all notebooks in given directory *) let dirh = Unix.opendir notebook_path in - let rec f () = + let rec f () = match (try Some( Unix.readdir dirh ) with _ -> None) with | None -> [] | Some(x) -> (Filename.concat notebook_path x) :: f () @@ -313,14 +310,14 @@ let get_notebook_list notebook_path filename = let () = Printf.printf "ok\n%!" in nb -let create_notebook_html to_dir base_path js_kernel notebook_name = +let create_notebook_html to_dir base_path js_kernel notebook_name = let () = Printf.printf "creating html for %s...%!" notebook_name in let path = base_path ^ "/notebooks" in let notebook_guid = Filename.basename notebook_name in - let html = Pages.generate_notebook_html + let html = Pages.generate_notebook_html ~base_path ~title:"IOCaml-Notebook" ~path ~notebook_guid ~kernel:js_kernel in - let html_file_name = + let html_file_name = let html_file = Filename.(chop_suffix notebook_guid ".ipynb") ^ ".html" in Filename.(concat to_dir html_file) in @@ -330,18 +327,18 @@ let create_notebook_html to_dir base_path js_kernel notebook_name = let () = Printf.printf "ok\n%!" in () -let copy_ipynb to_dir notebook_name = +let copy_ipynb to_dir notebook_name = let () = Printf.printf "copying notebook %s...%!" notebook_name in (* load the notebook (into servable format) *) let notebook_dir = Filename.dirname notebook_name in let notebook_file_name = Filename.basename notebook_name in - lwt notebook = + let notebook = let file = Filename.(chop_suffix notebook_file_name ".ipynb") in - load_ipynb_for_serving (Filename.concat notebook_dir) file - in + load_ipynb_for_serving (Filename.concat notebook_dir) file in + notebook >>= fun notebook -> (* save the notebook *) - let output_notebook_file_name = - Filename.(concat to_dir (concat "notebooks" notebook_file_name)) + let output_notebook_file_name = + Filename.(concat to_dir (concat "notebooks" notebook_file_name)) in let () = create_dir_for_file output_notebook_file_name in let f = open_out output_notebook_file_name in @@ -350,13 +347,12 @@ let copy_ipynb to_dir notebook_name = let () = Printf.printf "ok\n%!" in Lwt.return () -let create_static_site - ~to_dir ~notebook_path ~notebook_filename - ~iocaml_kernel - ~base_path = +let create_static_site + ~to_dir ~notebook_path ~notebook_filename + ~iocaml_kernel + ~base_path = let () = copy_static to_dir in let () = copy_js_kernel to_dir iocaml_kernel in let notebooks = get_notebook_list notebook_path notebook_filename in let () = List.iter (create_notebook_html to_dir base_path iocaml_kernel) notebooks in - Lwt_list.iter_s (copy_ipynb to_dir) notebooks - + Lwt_list.iter_s (copy_ipynb to_dir) notebooks diff --git a/iocaml.install b/iocaml.install deleted file mode 100644 index 1ef3fa7..0000000 --- a/iocaml.install +++ /dev/null @@ -1,3 +0,0 @@ -bin: [ - "_build/iocamlserver.byte" { "iocaml" } -] diff --git a/opam b/iocaml.opam similarity index 68% rename from opam rename to iocaml.opam index 7fc2bca..8ba8ebe 100644 --- a/opam +++ b/iocaml.opam @@ -5,14 +5,15 @@ homepage: "https://github.com/andrewray/iocamlserver" dev-repo: "https://github.com/andrewray/iocamlserver.git" bug-reports: "https://github.com/andrewray/iocamlserver/issues" build: [ - [ "cp" "config.darwin.ml" "config.ml" ] {os = "darwin"} - [ make "all" ] + ["jbuilder" "subst" "-n" name] {pinned} + ["jbuilder" "build" "-p" name "-j" jobs] ] +build-test: [["jbuilder" "runtest" "-p" name "-j" jobs]] depends: [ - "ocamlfind" + "jbuilder" {build & >= "1.0+beta10"} "uuidm" + "mustache" "yojson" - "cow" {< "2.0.0"} "lwt" {>= "2.4"} "websocket" {>= "2.0"} "cohttp" {>= "0.21.0"} @@ -21,7 +22,6 @@ depends: [ "ctypes-foreign" "iocaml-kernel" {= "0.4.8"} "iocamljs-kernel" {= "0.4.8"} - "ocamlbuild" {build} ] -available: [ ocaml-version >= "4.02.0" ] +available: [ ocaml-version >= "4.02.3" ] diff --git a/iocamlserver.ml b/iocamlserver.ml index 337c380..cdd9993 100644 --- a/iocamlserver.ml +++ b/iocamlserver.ml @@ -1,4 +1,4 @@ -(* +(* * iocamlserver - IOCaml notebook server * * (c) 2014 MicroJamJar Ltd @@ -30,8 +30,8 @@ let iocamljs_kernel = ref "" let browser = ref Config.default_browser_command -let () = Findlib.init () -let configure_js_serve () = +let () = Findlib.init () +let configure_js_serve () = let stdlib = Findlib.ocaml_stdlib () in let findlib = Findlib.default_location () in (* mapping for compiler and findlib *) @@ -39,7 +39,7 @@ let configure_js_serve () = stdlib :: findlib :: !serve_uri_path; - serve_file_path := + serve_file_path := stdlib :: findlib :: !serve_file_path @@ -49,60 +49,60 @@ let no_split_lines = ref false let static_site_path = ref "" let static_site_base_path = ref "" -let () = - Arg.(parse (align [ - "-tutorial", Set(tutorial), " show IOCaml tutorial notebook"; - "-ip", Set_string(address), " ip address of server"; - "-js", Set_string(iocamljs_kernel), " use iocamljs kernel"; - "-static", Set_string(static_file_path), " serve static files from dir"; - "-serve", String(fun s -> serve_uri_path := s :: !serve_uri_path; - serve_file_path := s :: !serve_file_path), - " serve files from same path and uri"; - "-serve-at", Tuple([ String(fun s -> serve_uri_path := s :: !serve_uri_path); - String(fun s -> serve_file_path := s :: !serve_file_path) ]), - " serve files from path on uri"; - "-serve-jslibs", Unit(configure_js_serve), - " configure paths to serve libraries for js kernel"; - "-log", Set_string(Kernel.(kernel_args.log_file)), " kernel log file"; - "-init", Set_string(Kernel.(kernel_args.init_file)), " kernel init file"; - "-completion", Set(Kernel.(kernel_args.completion)), " enable tab completion"; - "-object-info", Set(Kernel.(kernel_args.object_info)), " enable introspection"; - "-browser", Set_string(browser), " browser command [xdg-open]"; - "-no-split-lines", Set(no_split_lines), " dont split lines when saving"; - "-create-static-site", Set_string(static_site_path), - " create site for static serving (ie gh-pages)"; - "-static-site-base-path", Set_string(static_site_base_path), - " set static site base path"; - "-v", Unit(fun () -> incr verbose), " increase verbosity"; +let () = + Arg.(parse (align [ + "-tutorial", Set(tutorial), " show IOCaml tutorial notebook"; + "-ip", Set_string(address), " ip address of server"; + "-js", Set_string(iocamljs_kernel), " use iocamljs kernel"; + "-static", Set_string(static_file_path), " serve static files from dir"; + "-serve", String(fun s -> serve_uri_path := s :: !serve_uri_path; + serve_file_path := s :: !serve_file_path), + " serve files from same path and uri"; + "-serve-at", Tuple([ String(fun s -> serve_uri_path := s :: !serve_uri_path); + String(fun s -> serve_file_path := s :: !serve_file_path) ]), + " serve files from path on uri"; + "-serve-jslibs", Unit(configure_js_serve), + " configure paths to serve libraries for js kernel"; + "-log", Set_string(Kernel.(kernel_args.log_file)), " kernel log file"; + "-init", Set_string(Kernel.(kernel_args.init_file)), " kernel init file"; + "-completion", Set(Kernel.(kernel_args.completion)), " enable tab completion"; + "-object-info", Set(Kernel.(kernel_args.object_info)), " enable introspection"; + "-browser", Set_string(browser), " browser command [xdg-open]"; + "-no-split-lines", Set(no_split_lines), " dont split lines when saving"; + "-create-static-site", Set_string(static_site_path), + " create site for static serving (ie gh-pages)"; + "-static-site-base-path", Set_string(static_site_base_path), + " set static site base path"; + "-v", Unit(fun () -> incr verbose), " increase verbosity"; ]) - (fun s -> file_or_path := s) - "iocaml [options] [file-or-path]") + (fun s -> file_or_path := s) + "iocaml [options] [file-or-path]") -let notebook_path, file_to_open = +let notebook_path, file_to_open = if !tutorial then begin let name = "iocaml_tutorial.ipynb" in - let _ = Files.using_out name - (fun file -> output_string file (Files.tutorial_notebook ())) + let _ = Files.using_out name + (fun file -> output_string file (Files.tutorial_notebook ())) in "./", name - end else - Files.file_or_path !file_or_path + end else + Files.file_or_path !file_or_path let filename name = Filename.(concat notebook_path name) let serve_files = List.rev (List.map2 (fun a b -> a,b) !serve_uri_path !serve_file_path) -let share_dir () = +let share_dir () = try - let ic = Unix.open_process_in ("opam config var share 2>/dev/null") in - let r = input_line ic in - let r = - let len = String.length r in - if len>0 && r.[len - 1] = '\r' then String.sub r 0 (len-1) else r - in - match Unix.close_process_in ic with - | Unix.WEXITED 0 -> r - | _ -> failwith "" + let ic = Unix.open_process_in ("opam config var share 2>/dev/null") in + let r = input_line ic in + let r = + let len = String.length r in + if len>0 && r.[len - 1] = '\r' then String.sub r 0 (len-1) else r + in + match Unix.close_process_in ic with + | Unix.WEXITED 0 -> r + | _ -> failwith "" with | _ -> failwith ("could not query opam for share directory") @@ -110,35 +110,35 @@ let iocaml_kernel = match !iocamljs_kernel with (* standard byte code kernel, communicated over websockets. uses kernel.js from ipython *) | "" -> `byte_code_kernel - (* direct file link to javscript kernel *) + (* direct file link to javscript kernel *) | k when Sys.file_exists k && Filename.check_suffix k ".js" -> `js_kernel_file(k) (* javascript kernel loaded from std install dir *) | k -> `js_kernel(share_dir() ^ "/iocamljs-kernel/profile", k) -let () = - if !verbose > 0 then begin - let open Printf in - printf "ip address: '%s'\n" !address; - printf "notebook path: '%s'\n" notebook_path; - printf "file to open: '%s'\n" file_to_open; - printf "extra static dir: '%s'\n" !static_file_path; - List.iter (fun (u,p) -> +let () = + if !verbose > 0 then begin + let open Printf in + printf "ip address: '%s'\n" !address; + printf "notebook path: '%s'\n" notebook_path; + printf "file to open: '%s'\n" file_to_open; + printf "extra static dir: '%s'\n" !static_file_path; + List.iter (fun (u,p) -> printf "serve uri: '%s' -> '%s'\n" u p) serve_files; - (match iocaml_kernel with - | `byte_code_kernel -> printf "kernel: byte code\n" - | `js_kernel_file(f) -> printf "kernel: javascript file %s\n" f - | `js_kernel(p,t) -> printf "kernel: javscript %s @ %s\n" t p); - flush stdout; - end + (match iocaml_kernel with + | `byte_code_kernel -> printf "kernel: byte code\n" + | `js_kernel_file(f) -> printf "kernel: javascript file %s\n" f + | `js_kernel(p,t) -> printf "kernel: javscript %s @ %s\n" t p); + flush stdout; + end (* zmq initialization *) let zmq = ZMQ.Context.create () -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 +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 let header_none = Header.init () let header_html = header "text/html; charset=UTF-8" @@ -146,375 +146,365 @@ let header_css = header "text/css" let header_javascript = header "application/javascript" let header_json = header "application/json" let header_font = header "application/x-font-woff" -let header_redirect guid = - let h = header_html in - let h = Header.add h "Location" ("/" ^ guid) in - h -let header_date h = - let day = function - | 0 -> "Sun" | 1 -> "Mon" | 2 -> "Tue" | 3 -> "Wed" - | 4 -> "Thu" | 5 -> "Fri" | _ -> "Sat" - in - let month = function - | 0 -> "Jan" | 1 -> "Feb" | 2 -> "Mar" | 3 -> "Apr" - | 4 -> "May" | 5 -> "Jun" | 6 -> "Jul" | 7 -> "Aug" - | 8 -> "Sep" | 9 -> "Oct" | 10 -> "Nov" | _ ->"Dec" - in - let tm = Unix.(gmtime (gettimeofday ())) in - let tm = Unix.(Printf.sprintf "%s, %.2i %s %.4i %.2i:%.2i:%.2i GMT" - (day tm.tm_wday) tm.tm_mday (month tm.tm_mon) (tm.tm_year+1900) tm.tm_hour tm.tm_min tm.tm_sec) - in - let h = Header.add h "Date" tm in - h +let header_redirect guid = + let h = header_html in + let h = Header.add h "Location" ("/" ^ guid) in + h +let header_date h = + let day = function + | 0 -> "Sun" | 1 -> "Mon" | 2 -> "Tue" | 3 -> "Wed" + | 4 -> "Thu" | 5 -> "Fri" | _ -> "Sat" + in + let month = function + | 0 -> "Jan" | 1 -> "Feb" | 2 -> "Mar" | 3 -> "Apr" + | 4 -> "May" | 5 -> "Jun" | 6 -> "Jul" | 7 -> "Aug" + | 8 -> "Sep" | 9 -> "Oct" | 10 -> "Nov" | _ ->"Dec" + in + let tm = Unix.(gmtime (gettimeofday ())) in + let tm = Unix.(Printf.sprintf "%s, %.2i %s %.4i %.2i:%.2i:%.2i GMT" + (day tm.tm_wday) tm.tm_mday (month tm.tm_mon) (tm.tm_year+1900) tm.tm_hour tm.tm_min tm.tm_sec) + in + let h = Header.add h "Date" tm in + h let header_binary = header "application/octet-stream" let header_plain_user_charset = header "text/plain; charset=x-user-defined" -let checkpoint_date () = - let tm = Unix.(gmtime (gettimeofday ())) in - Unix.(Printf.sprintf "%.4i-%.2i-%.2iT%.2i:%.2i:%.2i.000000+00:00" - (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday - tm.tm_hour tm.tm_min tm.tm_sec) - -let header_of_extension filename = - if Filename.check_suffix filename ".js" then header_javascript - else if Filename.check_suffix filename ".css" then header_css - else if Filename.check_suffix filename ".ipynb" then header_json - else if Filename.check_suffix filename ".woff" then header_font - else header_none - -let kernel_id_json ~kernel_guid ~address ~ws_port = - let open Yojson.Basic in - to_string ~std:true - (`Assoc [ - "kernel_id", `String kernel_guid; - "ws_url", `String ("ws://" ^ address ^ ":" ^ string_of_int ws_port); - ]) - -let not_found () = - lwt () = if !verbose > 0 then Lwt_io.eprintf "Not_found\n" else return () in - Server.respond_not_found () - -let notebook_list notebook_path = - lwt l = Files.list_notebooks notebook_path in - let open Yojson.Basic in - let json nb = - let notebook_guid = Kernel.M.notebook_guid_of_filename nb in - `Assoc [ - "kernel_id", (* check if kernel is already running *) - (match Kernel.M.kernel_of_notebook_guid notebook_guid with - | None -> `Null - | Some(x) -> `String (Kernel.M.kernel_guid_of_kernel x)); - "name", `String nb; - "notebook_id", `String notebook_guid; - ] - in - let json = `List (List.map json l) in - Server.respond_string ~status:`OK ~body:(to_string ~std:true json) () +let checkpoint_date () = + let tm = Unix.(gmtime (gettimeofday ())) in + Unix.(Printf.sprintf "%.4i-%.2i-%.2iT%.2i:%.2i:%.2i.000000+00:00" + (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday + tm.tm_hour tm.tm_min tm.tm_sec) + +let header_of_extension filename = + if Filename.check_suffix filename ".js" then header_javascript + else if Filename.check_suffix filename ".css" then header_css + else if Filename.check_suffix filename ".ipynb" then header_json + else if Filename.check_suffix filename ".woff" then header_font + else header_none + +let kernel_id_json ~kernel_guid ~address ~ws_port = + let open Yojson.Basic in + to_string ~std:true + (`Assoc [ + "kernel_id", `String kernel_guid; + "ws_url", `String ("ws://" ^ address ^ ":" ^ string_of_int ws_port); + ]) + +let not_found () = + (if !verbose > 0 then + Lwt_io.eprintf "Not_found\n" + else + return ()) + >>= fun () -> Server.respond_not_found () + +let notebook_list notebook_path = + Files.list_notebooks notebook_path >>= fun l -> + let open Yojson.Basic in + let json nb = + let notebook_guid = Kernel.M.notebook_guid_of_filename nb in + `Assoc [ + "kernel_id", (* check if kernel is already running *) + (match Kernel.M.kernel_of_notebook_guid notebook_guid with + | None -> `Null + | Some(x) -> `String (Kernel.M.kernel_guid_of_kernel x)); + "name", `String nb; + "notebook_id", `String notebook_guid; + ] + in + let json = `List (List.map json l) in + Server.respond_string ~status:`OK ~body:(to_string ~std:true json) () (* read notebook from file *) -let send_notebook guid = - (try_lwt - lwt name = - try return (Kernel.M.filename_of_notebook_guid guid) - with _ -> fail (Failure "bad_file") - in - lwt notebook = - Lwt_io.(with_file ~mode:input (filename (name ^ ".ipynb")) read) - in - Kernel.M.dump_state !verbose; - Server.respond_string ~status:`OK ~body:notebook () - with _ -> - not_found ()) - -let register_notebooks notebook_path = - lwt l = Files.list_notebooks notebook_path in - Lwt_list.iter_s - (fun nb -> return (ignore (Kernel.M.notebook_guid_of_filename nb))) l - -let serve_crunched_files uri = - (* serve from crunched file system *) - let fname = Server.resolve_file ~docroot:"" ~uri:uri in - (match Filesys.read fname with - | None -> not_found() - | Some(x) -> - Server.respond_string ~status:`OK ~headers:(header_of_extension fname) ~body:x ()) - -let serve_from uri path next = +let send_notebook guid = + Lwt.catch (fun () -> + let name = + try return (Kernel.M.filename_of_notebook_guid guid) + with _ -> fail (Failure "bad_file") + in + name >>= fun name -> + Lwt_io.(with_file ~mode:input (filename (name ^ ".ipynb")) read) >>= fun notebook -> + Kernel.M.dump_state !verbose; + Server.respond_string ~status:`OK ~body:notebook () + ) (fun _ -> not_found ()) + +let register_notebooks notebook_path = + Files.list_notebooks notebook_path >>= fun l -> + Lwt_list.iter_s + (fun nb -> return (ignore (Kernel.M.notebook_guid_of_filename nb))) l + +let serve_crunched_files uri = + (* serve from crunched file system *) + let fname = Server.resolve_file ~docroot:"" ~uri:uri in + (match Filesys.read fname with + | None -> not_found() + | Some(x) -> + Server.respond_string ~status:`OK ~headers:(header_of_extension fname) ~body:x ()) + +let serve_from uri path next = if path <> "" then let fname = Server.resolve_file ~docroot:path ~uri:uri in if Sys.file_exists fname then - lwt () = - if !verbose > 0 then Lwt_io.eprintf " [ STATIC]: %s [%s] [%s]\n" fname path (Uri.path uri) - else return () - in + (if !verbose > 0 then + Lwt_io.eprintf " [ STATIC]: %s [%s] [%s]\n" fname path (Uri.path uri) + else + return () + ) >>= fun () -> Server.respond_file ~headers:(header_of_extension fname) ~fname:fname () else next () else next () -let serve_static_files uri = +let serve_static_files uri = let serve_from = serve_from uri in serve_from !static_file_path (fun () -> - match iocaml_kernel with - | `byte_code_kernel -> serve_crunched_files uri - | `js_kernel(path, _) -> serve_from path (fun () -> serve_crunched_files uri) - | `js_kernel_file(fname) -> (* XXX this wont serve the custom icon I think XXX not hugely important, but to be fixed! *) - if Uri.path uri = "/static/services/kernels/js/kernel.js" then begin - lwt () = - if !verbose > 0 then - Lwt_io.eprintf " [JSKERNEL]: %s [%s]\n" fname (Uri.path uri) - else return () - in - Server.respond_file ~headers:(header_of_extension fname) ~fname:fname () - end else serve_crunched_files uri - ) - -let save_notebook guid body = - let old_filename = Kernel.M.filename_of_notebook_guid guid in - (*lwt new_filename = get_filename_of_ipynb body in*) - let new_filename, body = Files.prepare_ipynb_for_saving !no_split_lines body in - lwt () = Lwt_io.(with_file ~mode:output - (filename (new_filename ^ ".ipynb")) - (fun f -> write f body)) - in - let () = - if new_filename <> old_filename then - Kernel.M.change_filename old_filename new_filename guid - in - Kernel.M.dump_state !verbose; - Server.respond_string ~status:`OK ~headers:(header_date header_html) ~body:"" () + match iocaml_kernel with + | `byte_code_kernel -> serve_crunched_files uri + | `js_kernel(path, _) -> serve_from path (fun () -> serve_crunched_files uri) + | `js_kernel_file(fname) -> (* XXX this wont serve the custom icon I think XXX not hugely important, but to be fixed! *) + if Uri.path uri = "/static/services/kernels/js/kernel.js" then begin + (if !verbose > 0 then + Lwt_io.eprintf " [JSKERNEL]: %s [%s]\n" fname (Uri.path uri) + else + return ()) >>= fun () -> + Server.respond_file ~headers:(header_of_extension fname) ~fname:fname () + end else serve_crunched_files uri + ) + +let save_notebook guid body = + let old_filename = Kernel.M.filename_of_notebook_guid guid in + (*lwt new_filename = get_filename_of_ipynb body in*) + let new_filename, body = Files.prepare_ipynb_for_saving !no_split_lines body in + (Lwt_io.(with_file ~mode:output + (filename (new_filename ^ ".ipynb")) + (fun f -> write f body))) >>= fun () -> + let () = + if new_filename <> old_filename then + Kernel.M.change_filename old_filename new_filename guid + in + Kernel.M.dump_state !verbose; + Server.respond_string ~status:`OK ~headers:(header_date header_html) ~body:"" () let http_server address port ws_port notebook_path = - let decode = Uri_paths.decode serve_files in - - let callback (_,conn_id) req body = - let uri = Request.uri req in - let meth = Request.meth req in - let path = Uri.path uri in - - lwt decode = decode path in - lwt () = - (* XXX log all messages that are not just serving notebook files *) - if (!verbose > 0 && decode <> `Static) || (!verbose > 1) then - Lwt_io.eprintf "%s [%8s]: [%s] %s -> %s\n%!" - (Connection.to_string conn_id) - (Code.string_of_method meth) - (Uri_paths.string_of_message decode) - (Uri.to_string uri) path - else - return () - in - - let query_param var = - match Uri.get_query_param uri var with - | None -> Lwt.fail (Failure ("failed to get param: " ^ var)) - | Some(x) -> return x - in - - match decode with - - | `Root -> - let dashboard = Pages.generate_dashboard_html ~path:notebook_path in - Server.respond_string ~status:`OK ~headers:header_html ~body:dashboard () - - | `Static -> - serve_static_files uri - - | `File(fname) -> - lwt () = - if !verbose > 0 then Lwt_io.eprintf " [ DATA] %s\n" fname - else return () - in - Server.respond_file ~headers:header_plain_user_charset ~fname:fname () - - | `Root_guid(guid) -> - let notebook = Pages.generate_notebook_html - ~base_path:"" - ~title:"IOCaml-Notebook" ~path:notebook_path - ~notebook_guid:guid ~kernel:iocaml_kernel - in - Kernel.M.dump_state !verbose; - Server.respond_string ~status:`OK ~headers:header_html ~body:notebook () - - | `Root_new -> - (* create new .ipynb file *) - lwt name = Files.(list_notebooks notebook_path >>= new_notebook_name) in - lwt () = Lwt_io.(with_file ~mode:output - (filename (name ^ ".ipynb")) - (fun f -> write f (Files.empty_notebook name))) - in - let guid = Kernel.M.notebook_guid_of_filename name in - (* 302 Found, redirect to `Root_guid *) - Server.respond_string ~status:`Found ~headers:(header_redirect guid) ~body:"" () - - | `Root_name(name) -> - (try_lwt - Server.respond_string ~status:`Found - ~headers:(header_redirect (Kernel.M.notebook_guid_of_filename name)) - ~body:"" () - with _ -> - not_found ()) - - | `Root_copy(guid) -> not_found () - - | `Notebooks -> notebook_list notebook_path - - | `Notebooks_guid(guid) when meth = `GET -> - (try_lwt - (* read notebook from file *) - lwt name = - try return (Kernel.M.filename_of_notebook_guid guid) - with _ -> fail (Failure "bad_file") - in - lwt notebook = Files.load_ipynb_for_serving filename name in - Kernel.M.dump_state !verbose; - Server.respond_string ~status:`OK ~body:notebook () - with _ -> - not_found ()) - - | `Notebooks_guid(guid) when meth = `PUT -> - (* save notebook *) - (try_lwt - lwt body = Cohttp_lwt_body.to_string body in - Kernel.M.dump_state !verbose; - save_notebook guid body - with _ -> - not_found ()) - - | `Notebooks_checkpoint(_) -> - Server.respond_string ~status:`OK ~body:"[]" () - - | `Notebooks_checkpoint_id(_) -> not_found () - - | `Clusters -> - Server.respond_string ~status:`OK ~body:"[]" () - - | `Kernels when meth = `POST -> - (try_lwt - lwt notebook_guid = query_param "notebook" in - lwt kernel = Kernel.get_kernel - ~zmq ~path:notebook_path ~notebook_guid ~ip_addr:address - in - Kernel.M.dump_state !verbose; - Server.respond_string ~status:`OK - ~body:(kernel_id_json ~kernel_guid:kernel.Kernel.guid ~address ~ws_port) () - with _ -> - not_found ()) - - | `Kernels_guid(guid) when meth = `DELETE -> - let () = Kernel.close_kernel guid in - Kernel.M.dump_state !verbose; - Server.respond_string ~status:`OK ~body:"" () - - | `Kernels_restart(guid) -> - (try_lwt - (* stop kernel *) - let () = Kernel.close_kernel guid in - (* re-start kernel *) - let notebook_guid = Kernel.M.notebook_guid_of_kernel_guid guid in - lwt kernel = Kernel.get_kernel - ~zmq ~path:notebook_path ~notebook_guid ~ip_addr:address - in - Kernel.M.dump_state !verbose; - Server.respond_string ~status:`OK - ~body:(kernel_id_json ~kernel_guid:kernel.Kernel.guid ~address ~ws_port) () - with _ -> - not_found ()) - - | `Kernels_interrupt(guid) -> - (match Kernel.M.kernel_of_kernel_guid guid with - | Some(kernel) -> - kernel.Kernel.process#kill Sys.sigint; (* interrupt *) - Kernel.M.dump_state !verbose; - Server.respond_string ~status:`OK ~body:"" () - | None -> not_found ()) - - | `Error_not_found | _ -> not_found () + let decode = Uri_paths.decode serve_files in + + let callback (_,conn_id) req body = + let uri = Request.uri req in + let meth = Request.meth req in + let path = Uri.path uri in + + decode path >>= fun decode -> + + (* XXX log all messages that are not just serving notebook files *) + (if (!verbose > 0 && decode <> `Static) || (!verbose > 1) then + Lwt_io.eprintf "%s [%8s]: [%s] %s -> %s\n%!" + (Connection.to_string conn_id) + (Code.string_of_method meth) + (Uri_paths.string_of_message decode) + (Uri.to_string uri) path + else + return ()) >>= fun () -> + + let query_param var = + match Uri.get_query_param uri var with + | None -> Lwt.fail (Failure ("failed to get param: " ^ var)) + | Some(x) -> return x in - (*let conn_closed conn_id () = () in + + match decode with + + | `Root -> + let dashboard = Pages.generate_dashboard_html ~path:notebook_path in + Server.respond_string ~status:`OK ~headers:header_html ~body:dashboard () + + | `Static -> + serve_static_files uri + + | `File(fname) -> + (if !verbose > 0 then + Lwt_io.eprintf " [ DATA] %s\n" fname + else + return ()) >>= fun () -> + Server.respond_file ~headers:header_plain_user_charset ~fname:fname () + + | `Root_guid(guid) -> + let notebook = Pages.generate_notebook_html + ~base_path:"" + ~title:"IOCaml-Notebook" ~path:notebook_path + ~notebook_guid:guid ~kernel:iocaml_kernel + in + Kernel.M.dump_state !verbose; + Server.respond_string ~status:`OK ~headers:header_html ~body:notebook () + + | `Root_new -> + (* create new .ipynb file *) + Files.(list_notebooks notebook_path >>= new_notebook_name) >>= fun name -> + (Lwt_io.(with_file ~mode:output + (filename (name ^ ".ipynb")) + (fun f -> write f (Files.empty_notebook name)))) + >>= fun () -> + let guid = Kernel.M.notebook_guid_of_filename name in + (* 302 Found, redirect to `Root_guid *) + Server.respond_string ~status:`Found ~headers:(header_redirect guid) ~body:"" () + + | `Root_name(name) -> + Lwt.catch (fun () -> + Server.respond_string ~status:`Found + ~headers:(header_redirect (Kernel.M.notebook_guid_of_filename name)) + ~body:"" () + ) (fun _ -> not_found ()) + + | `Root_copy(guid) -> not_found () + + | `Notebooks -> notebook_list notebook_path + + | `Notebooks_guid(guid) when meth = `GET -> + Lwt.catch (fun () -> + (* read notebook from file *) + let name = + try return (Kernel.M.filename_of_notebook_guid guid) + with _ -> fail (Failure "bad_file") in + name >>= fun name -> + Files.load_ipynb_for_serving filename name >>= fun notebook -> + Kernel.M.dump_state !verbose; + Server.respond_string ~status:`OK ~body:notebook () + ) (fun _ -> not_found ()) + + | `Notebooks_guid(guid) when meth = `PUT -> + (* save notebook *) + Lwt.catch (fun () -> + Cohttp_lwt_body.to_string body >>= fun body -> + Kernel.M.dump_state !verbose; + save_notebook guid body + ) (fun _ -> not_found ()) + + | `Notebooks_checkpoint(_) -> + Server.respond_string ~status:`OK ~body:"[]" () + + | `Notebooks_checkpoint_id(_) -> not_found () + + | `Clusters -> + Server.respond_string ~status:`OK ~body:"[]" () + + | `Kernels when meth = `POST -> + Lwt.catch (fun () -> + query_param "notebook" >>= fun notebook_guid -> + Kernel.get_kernel ~zmq ~path:notebook_path ~notebook_guid ~ip_addr:address + >>= fun kernel -> + Kernel.M.dump_state !verbose; + Server.respond_string ~status:`OK + ~body:(kernel_id_json ~kernel_guid:kernel.Kernel.guid ~address ~ws_port) () + ) (fun _ -> not_found ()) + + | `Kernels_guid(guid) when meth = `DELETE -> + let () = Kernel.close_kernel guid in + Kernel.M.dump_state !verbose; + Server.respond_string ~status:`OK ~body:"" () + + | `Kernels_restart(guid) -> + Lwt.catch (fun () -> + (* stop kernel *) + let () = Kernel.close_kernel guid in + (* re-start kernel *) + let notebook_guid = Kernel.M.notebook_guid_of_kernel_guid guid in + Kernel.get_kernel ~zmq ~path:notebook_path ~notebook_guid ~ip_addr:address + >>= fun kernel -> + Kernel.M.dump_state !verbose; + Server.respond_string ~status:`OK + ~body:(kernel_id_json ~kernel_guid:kernel.Kernel.guid ~address ~ws_port) () + ) (fun _ -> not_found ()) + + | `Kernels_interrupt(guid) -> + (match Kernel.M.kernel_of_kernel_guid guid with + | Some(kernel) -> + kernel.Kernel.process#kill Sys.sigint; (* interrupt *) + Kernel.M.dump_state !verbose; + Server.respond_string ~status:`OK ~body:"" () + | None -> not_found ()) + + | `Error_not_found | _ -> not_found () + in + (*let conn_closed conn_id () = () in let config = { Server.callback; conn_closed } in Server.create ~address ~port config*) - let conn_closed (_,_) = () in - lwt ctx = Conduit_lwt_unix.init ~src:address () in - let ctx = Cohttp_lwt_unix_net.init ~ctx () in - let mode = `TCP (`Port port) in - let config = Cohttp_lwt_unix.Server.make ~callback ~conn_closed () in - Cohttp_lwt_unix.Server.create ~ctx ~mode config - -let run_servers address notebook_path = - lwt () = register_notebooks notebook_path in - - (* find ports for http and websocket servers *) - let rec find_port_pair port = - lwt ok = Kernel.n_ports_available address port 2 in - if ok then return port - else find_port_pair (port+2) - in - lwt http_port = find_port_pair 8888 in - let ws_port = http_port + 1 in - let () = Printf.printf "[iocaml] listening on %s:%d\n%!" address http_port in - (*if !verbose > 0 then begin - Printf.printf "listening for HTTP on port: %d\n%!" http_port; - Printf.printf "listening for websockets on port: %d\n%!" ws_port; + let conn_closed (_,_) = () in + Conduit_lwt_unix.init ~src:address () >>= fun ctx -> + let ctx = Cohttp_lwt_unix_net.init ~ctx () in + let mode = `TCP (`Port port) in + let config = Cohttp_lwt_unix.Server.make ~callback ~conn_closed () in + Cohttp_lwt_unix.Server.create ~ctx ~mode config + +let run_servers address notebook_path = + register_notebooks notebook_path >>= fun () -> + + (* find ports for http and websocket servers *) + let rec find_port_pair port = + Kernel.n_ports_available address port 2 >>= fun ok -> + if ok then return port + else find_port_pair (port+2) + in + find_port_pair 8888 >>= fun http_port -> + let ws_port = http_port + 1 in + let () = Printf.printf "[iocaml] listening on %s:%d\n%!" address http_port in + (*if !verbose > 0 then begin + Printf.printf "listening for HTTP on port: %d\n%!" http_port; + Printf.printf "listening for websockets on port: %d\n%!" ws_port; end;*) - (* http server *) - let http_server = http_server address http_port ws_port notebook_path in - - (* websocket server *) - let ws_server = - let uri = Uri.of_string ("http://" ^ address ^ ":" ^ string_of_int ws_port) in - Resolver_lwt.resolve_uri ~uri Resolver_lwt_unix.system >>= fun endp -> - Conduit_lwt_unix.( - endp_to_server ~ctx:default_ctx endp >>= fun server -> - Websocket_lwt.establish_standard_server ~ctx:default_ctx ~mode:server - (Bridge.ws_init !verbose) - ) - in + (* http server *) + let http_server = http_server address http_port ws_port notebook_path in + + (* websocket server *) + let ws_server = + let uri = Uri.of_string ("http://" ^ address ^ ":" ^ string_of_int ws_port) in + Resolver_lwt.resolve_uri ~uri Resolver_lwt_unix.system >>= fun endp -> + Conduit_lwt_unix.( + endp_to_server ~ctx:default_ctx endp >>= fun server -> + Websocket_lwt.establish_standard_server ~ctx:default_ctx ~mode:server + (Bridge.ws_init !verbose) + ) + in + + (* start webbrowser, what about mac-osx? 'open'? *) + let browser_command = + if file_to_open <> "" then + let guid = + Kernel.M.notebook_guid_of_filename + (Filename.(chop_suffix file_to_open ".ipynb")) + in + ("", [| !browser; "http://" ^ address ^ ":" ^ + string_of_int http_port ^ "/" ^ guid |]) + else + ("", [| !browser; "http://" ^ address ^ ":" ^ string_of_int http_port |]) + in + let _ = Lwt_process.open_process_none browser_command in - (* start webbrowser, what about mac-osx? 'open'? *) - let browser_command = - if file_to_open <> "" then - let guid = - Kernel.M.notebook_guid_of_filename - (Filename.(chop_suffix file_to_open ".ipynb")) - in - ("", [| !browser; "http://" ^ address ^ ":" ^ - string_of_int http_port ^ "/" ^ guid |]) - else - ("", [| !browser; "http://" ^ address ^ ":" ^ string_of_int http_port |]) - in - let _ = Lwt_process.open_process_none browser_command in - - Lwt.join [http_server; ws_server] - -let close_kernels () = - (* kill all running kernels *) - Kernel.M.iter_kernels - (fun _ v -> v.Kernel.process#terminate) - -let run_iocaml_server () = - Sys.catch_break true; - try - (*at_exit close_kernels;*) - Lwt_unix.run (run_servers !address notebook_path) - with - | Sys.Break -> begin - close_kernels (); - (*ZMQ.term zmq*) - end + Lwt.join [http_server; ws_server] -let () = - if !static_site_path = "" then - run_iocaml_server () - else - Lwt_unix.run - (Files.create_static_site - ~to_dir:!static_site_path - ~notebook_path ~notebook_filename:file_to_open - ~iocaml_kernel:iocaml_kernel - ~base_path:!static_site_base_path) +let close_kernels () = + (* kill all running kernels *) + Kernel.M.iter_kernels + (fun _ v -> v.Kernel.process#terminate) +let run_iocaml_server () = + Sys.catch_break true; + try + (*at_exit close_kernels;*) + Lwt_unix.run (run_servers !address notebook_path) + with + | Sys.Break -> begin + close_kernels (); + (*ZMQ.term zmq*) + end +let () = + if !static_site_path = "" then + run_iocaml_server () + else + Lwt_unix.run + (Files.create_static_site + ~to_dir:!static_site_path + ~notebook_path ~notebook_filename:file_to_open + ~iocaml_kernel:iocaml_kernel + ~base_path:!static_site_base_path) diff --git a/jbuild b/jbuild new file mode 100644 index 0000000..0960e4c --- /dev/null +++ b/jbuild @@ -0,0 +1,24 @@ +(jbuild_version 1) + +(rule + ((targets (tutorial.ml)) + (deps (tutorial/tutorial.ipynb)) + (action (run ocaml-crunch -o ${@} -m plain tutorial)))) + +(rule + ((targets (filesys.ml)) + (deps ((files_recursively_in filesys-1.1))) + (action (run ocaml-crunch -o ${@} -m plain filesys-1.1)))) + +(executables + ((names (iocamlserver)) + (public_names (iocaml)) + (libraries + (findlib + mustache + lwt.unix + cohttp + websocket.lwt + iocaml-kernel + uuidm + yojson)))) \ No newline at end of file diff --git a/kernel.ml b/kernel.ml index 056c1c9..c6fada5 100644 --- a/kernel.ml +++ b/kernel.ml @@ -8,190 +8,191 @@ * *) +open Lwt.Infix open Iocaml_zmq type kernel_args = - { - log_file : string ref; - init_file : string ref; - completion : bool ref; - object_info : bool ref; - } + { + log_file : string ref; + init_file : string ref; + completion : bool ref; + object_info : bool ref; + } let kernel_args = - { - log_file = ref ""; - init_file = ref ""; - completion = ref false; - object_info = ref false; - } + { + log_file = ref ""; + init_file = ref ""; + completion = ref false; + object_info = ref false; + } type kernel = + { + process : Lwt_process.process_none; + guid : string; + (* zmq sockets *) + stdin : unit -> [`Dealer] Lwt_zmq.Socket.t; + control : unit -> [`Dealer] Lwt_zmq.Socket.t; + shell : unit -> [`Dealer] Lwt_zmq.Socket.t; + iopub : unit -> [`Sub] Lwt_zmq.Socket.t; + heartbeat : unit -> [`Req] Lwt_zmq.Socket.t; + } + +module M = struct + + (* map between + + 1. filename + 2. notebook_guid + 3. kernel_guid + 4. kernel + + There are some issues around renaming notebooks and tracking + which filename, notebook guid and kernel. + *) + + module M = Map.Make(String) + + (* maintain map of kernel_guids to kernels *) + let kernels : kernel M.t ref = ref M.empty + + let kernel_of_kernel_guid kernel_guid = + try Some(M.find kernel_guid !kernels) + with _ -> None + + let add_kernel kernel_guid kernel = kernels := M.add kernel_guid kernel !kernels + let delete_kernel kernel_guid = kernels := M.remove kernel_guid !kernels + let iter_kernels f = M.iter f !kernels + + (* *) + let seed = + match Uuidm.of_string "65506491-a9a4-439f-be2d-03be8732c88e" with + | None -> failwith "couldn't init seed" + | Some(x) -> x + + type str_map = { - process : Lwt_process.process_none; - guid : string; - (* zmq sockets *) - stdin : unit -> [`Dealer] Lwt_zmq.Socket.t; - control : unit -> [`Dealer] Lwt_zmq.Socket.t; - shell : unit -> [`Dealer] Lwt_zmq.Socket.t; - iopub : unit -> [`Sub] Lwt_zmq.Socket.t; - heartbeat : unit -> [`Req] Lwt_zmq.Socket.t; + find : string -> string; + add : string -> string -> unit; + remove : string -> unit; + iter : (string -> string -> unit) -> unit } -module M = struct + let make_str_map () = + let map : string M.t ref = ref M.empty in + let find k = M.find k !map in + let add k d = map := M.add k d !map in + let remove k = map := M.remove k !map in + let iter f = M.iter f !map in + { find; add; remove; iter } + + type str_map_r = { f : str_map; b : str_map; } + + let make_str_map_r () = + let f, b = make_str_map (), make_str_map () in + let mk f b = + { + find = f.find; + add = (fun k d -> f.add k d; b.add d k); + remove = (fun k -> b.remove (f.find k); f.remove k); + iter = f.iter; + } + in + { f = mk f b; b = mk b f; } + + let f_ng = make_str_map_r () (* filename <-> notebook_guid *) - (* map between - - 1. filename - 2. notebook_guid - 3. kernel_guid - 4. kernel - - There are some issues around renaming notebooks and tracking - which filename, notebook guid and kernel. - *) - - module M = Map.Make(String) - - (* maintain map of kernel_guids to kernels *) - let kernels : kernel M.t ref = ref M.empty - - let kernel_of_kernel_guid kernel_guid = - try Some(M.find kernel_guid !kernels) - with _ -> None - - let add_kernel kernel_guid kernel = kernels := M.add kernel_guid kernel !kernels - let delete_kernel kernel_guid = kernels := M.remove kernel_guid !kernels - let iter_kernels f = M.iter f !kernels - - (* *) - let seed = - match Uuidm.of_string "65506491-a9a4-439f-be2d-03be8732c88e" with - | None -> failwith "couldn't init seed" - | Some(x) -> x - - type str_map = - { - find : string -> string; - add : string -> string -> unit; - remove : string -> unit; - iter : (string -> string -> unit) -> unit - } - - let make_str_map () = - let map : string M.t ref = ref M.empty in - let find k = M.find k !map in - let add k d = map := M.add k d !map in - let remove k = map := M.remove k !map in - let iter f = M.iter f !map in - { find; add; remove; iter } - - type str_map_r = { f : str_map; b : str_map; } - - let make_str_map_r () = - let f, b = make_str_map (), make_str_map () in - let mk f b = - { - find = f.find; - add = (fun k d -> f.add k d; b.add d k); - remove = (fun k -> b.remove (f.find k); f.remove k); - iter = f.iter; - } - in - { f = mk f b; b = mk b f; } - - let f_ng = make_str_map_r () (* filename <-> notebook_guid *) - - let notebook_guid_of_filename filename = - try f_ng.f.find filename - with _ -> - f_ng.f.add filename Uuidm.(to_string (create `V4)); - f_ng.f.find filename - - let filename_of_notebook_guid notebook_guid = f_ng.b.find notebook_guid - - let change_filename old_filename new_filename notebook_guid = - f_ng.f.remove old_filename; - f_ng.f.add new_filename notebook_guid - - let ng_kg = make_str_map_r () - - let kernel_guid_of_notebook_guid notebook_guid = - try ng_kg.f.find notebook_guid - with _ -> - ng_kg.f.add notebook_guid Uuidm.(to_string (v3 seed notebook_guid)); - ng_kg.f.find notebook_guid - - let notebook_guid_of_kernel_guid kernel_guid = ng_kg.b.find kernel_guid - - let kernel_guid_of_kernel kernel = kernel.guid - - let kernel_of_notebook_guid notebook_guid = - kernel_of_kernel_guid (kernel_guid_of_notebook_guid notebook_guid) - - let dump_state verbose = - if verbose > 1 then begin - Printf.printf "%36s -> %36s -> %36s\n" "filename" "notebook_guid" "filename"; - f_ng.f.iter (fun k v -> Printf.printf "%36s -> %36s -> %36s\n" k v (f_ng.b.find v)); - Printf.printf "%36s -> %36s -> %36s\n" "notebook_guid" "kernel_guid" "notebook_guid"; - ng_kg.f.iter (fun k v -> Printf.printf "%36s -> %36s -> %36s\n" k v (ng_kg.b.find v)); - flush stdout - end + let notebook_guid_of_filename filename = + try f_ng.f.find filename + with _ -> + f_ng.f.add filename Uuidm.(to_string (create `V4)); + f_ng.f.find filename + + let filename_of_notebook_guid notebook_guid = f_ng.b.find notebook_guid + + let change_filename old_filename new_filename notebook_guid = + f_ng.f.remove old_filename; + f_ng.f.add new_filename notebook_guid + + let ng_kg = make_str_map_r () + + let kernel_guid_of_notebook_guid notebook_guid = + try ng_kg.f.find notebook_guid + with _ -> + ng_kg.f.add notebook_guid Uuidm.(to_string (v3 seed notebook_guid)); + ng_kg.f.find notebook_guid + + let notebook_guid_of_kernel_guid kernel_guid = ng_kg.b.find kernel_guid + + let kernel_guid_of_kernel kernel = kernel.guid + + let kernel_of_notebook_guid notebook_guid = + kernel_of_kernel_guid (kernel_guid_of_notebook_guid notebook_guid) + + let dump_state verbose = + if verbose > 1 then begin + Printf.printf "%36s -> %36s -> %36s\n" "filename" "notebook_guid" "filename"; + f_ng.f.iter (fun k v -> Printf.printf "%36s -> %36s -> %36s\n" k v (f_ng.b.find v)); + Printf.printf "%36s -> %36s -> %36s\n" "notebook_guid" "kernel_guid" "notebook_guid"; + ng_kg.f.iter (fun k v -> Printf.printf "%36s -> %36s -> %36s\n" k v (ng_kg.b.find v)); + flush stdout + end end let resolve_addr addr port = - match Unix.(getaddrinfo addr (string_of_int port) [AI_SOCKTYPE SOCK_STREAM]) with - | {Unix.ai_addr} :: _ -> ai_addr - | [] -> - Printf.eprintf "Unable to resolve '%s' to bind to\n%!" addr; - exit 1 + match Unix.(getaddrinfo addr (string_of_int port) [AI_SOCKTYPE SOCK_STREAM]) with + | {Unix.ai_addr} :: _ -> ai_addr + | [] -> + Printf.eprintf "Unable to resolve '%s' to bind to\n%!" addr; + exit 1 (* check if the given port is free * XXX not sure about this *) let port_available addr port = - let s = Lwt_unix.(socket PF_INET SOCK_STREAM 0) in - lwt status = - try_lwt - Lwt_unix.(bind s (resolve_addr addr port)); - Lwt.return true - with _ -> - Lwt.return false - in - lwt () = Lwt_unix.close s in - Lwt.return status + let s = Lwt_unix.(socket PF_INET SOCK_STREAM 0) in + let status = + Lwt.catch (fun () -> + Lwt_unix.(bind s (resolve_addr addr port)); + Lwt.return true + ) (fun _ -> Lwt.return false) + in + status >>= fun status -> + Lwt_unix.close s >>= fun () -> + Lwt.return status let rec n_ports_available addr port n = - if n=0 then Lwt.return true - else - lwt available = port_available addr port in - if available then n_ports_available addr (port+1) (n-1) - else Lwt.return false + if n=0 then Lwt.return true + else + port_available addr port >>= fun available -> + if available then n_ports_available addr (port+1) (n-1) + else Lwt.return false let rec find_zmq_port_range addr = - let port = Random.int 40000 + 20000 in (* between 20,000 + 60,000 *) - lwt available = n_ports_available addr port 5 in - if available then Lwt.return port - else find_zmq_port_range addr + let port = Random.int 40000 + 20000 in (* between 20,000 + 60,000 *) + n_ports_available addr port 5 >>= fun available -> + if available then Lwt.return port + else find_zmq_port_range addr let connection_file ~ip_addr ~zmq_shell_port ~zmq_iopub_port ~zmq_control_port ~zmq_heartbeat_port ~zmq_stdin_port - = - let open Yojson.Basic in - to_string - (`Assoc [ - "stdin_port", `Int zmq_stdin_port; - "ip", `String ip_addr; - "control_port", `Int zmq_control_port; - "hb_port", `Int zmq_heartbeat_port; - "signature_scheme", `String "hmac-sha256"; - "key", `String ""; - "shell_port", `Int zmq_shell_port; - "transport", `String "tcp"; - "iopub_port", `Int zmq_iopub_port - ]) + = + let open Yojson.Basic in + to_string + (`Assoc [ + "stdin_port", `Int zmq_stdin_port; + "ip", `String ip_addr; + "control_port", `Int zmq_control_port; + "hb_port", `Int zmq_heartbeat_port; + "signature_scheme", `String "hmac-sha256"; + "key", `String ""; + "shell_port", `Int zmq_shell_port; + "transport", `String "tcp"; + "iopub_port", `Int zmq_iopub_port + ]) let write_connection_file ~path @@ -199,101 +200,101 @@ let write_connection_file ~zmq_shell_port ~zmq_iopub_port ~zmq_control_port ~zmq_heartbeat_port ~zmq_stdin_port = - let fname = Filename.concat path (kernel_guid ^ ".json") in - let f = open_out fname in - output_string f - (connection_file ~ip_addr ~zmq_shell_port ~zmq_iopub_port - ~zmq_control_port ~zmq_heartbeat_port ~zmq_stdin_port); - close_out f; - fname + let fname = Filename.concat path (kernel_guid ^ ".json") in + let f = open_out fname in + output_string f + (connection_file ~ip_addr ~zmq_shell_port ~zmq_iopub_port + ~zmq_control_port ~zmq_heartbeat_port ~zmq_stdin_port); + close_out f; + fname let start_kernel ~zmq ~path ~notebook_guid ~ip_addr = - let kernel_guid = M.kernel_guid_of_notebook_guid notebook_guid in - - (* find free ports *) - lwt p = find_zmq_port_range ip_addr in - let zmq_shell_port = p+0 in - let zmq_iopub_port = p+1 in - let zmq_control_port= p+2 in - let zmq_heartbeat_port = p+3 in - let zmq_stdin_port = p+4 in - - let command = - ("", Array.of_list - ([ - "iocaml.top"; - "-ci-shell"; string_of_int zmq_shell_port; - "-ci-iopub"; string_of_int zmq_iopub_port; - "-ci-control"; string_of_int zmq_control_port; - "-ci-heartbeat"; string_of_int zmq_heartbeat_port; - "-ci-stdin"; string_of_int zmq_stdin_port; - "-ci-transport"; "tcp"; - "-ci-ip"; ip_addr; - ] - @ (if !(kernel_args.log_file) = "" then [] else [ "-log"; !(kernel_args.log_file) ]) - @ (if !(kernel_args.init_file) = "" then [] else [ "-init"; !(kernel_args.init_file) ]) - @ (if !(kernel_args.object_info) then [ "-object-info" ] else []) - @ (if !(kernel_args.completion) then [ "-completion" ] else []) - )) - in - let make_socket typ addr port () = - let socket = ZMQ.Socket.(create zmq typ) in - let () = ZMQ.Socket.connect socket ("tcp://" ^ addr ^ ":" ^ string_of_int port) in - Lwt_zmq.Socket.of_socket socket - in - - let identity () = Uuidm.(to_string (create `V4)) in + let kernel_guid = M.kernel_guid_of_notebook_guid notebook_guid in + + (* find free ports *) + find_zmq_port_range ip_addr >>= fun p -> + let zmq_shell_port = p+0 in + let zmq_iopub_port = p+1 in + let zmq_control_port= p+2 in + let zmq_heartbeat_port = p+3 in + let zmq_stdin_port = p+4 in + + let command = + ("", Array.of_list + ([ + "iocaml.top"; + "-ci-shell"; string_of_int zmq_shell_port; + "-ci-iopub"; string_of_int zmq_iopub_port; + "-ci-control"; string_of_int zmq_control_port; + "-ci-heartbeat"; string_of_int zmq_heartbeat_port; + "-ci-stdin"; string_of_int zmq_stdin_port; + "-ci-transport"; "tcp"; + "-ci-ip"; ip_addr; + ] + @ (if !(kernel_args.log_file) = "" then [] else [ "-log"; !(kernel_args.log_file) ]) + @ (if !(kernel_args.init_file) = "" then [] else [ "-init"; !(kernel_args.init_file) ]) + @ (if !(kernel_args.object_info) then [ "-object-info" ] else []) + @ (if !(kernel_args.completion) then [ "-completion" ] else []) + )) + in + let make_socket typ addr port () = + let socket = ZMQ.Socket.(create zmq typ) in + let () = ZMQ.Socket.connect socket ("tcp://" ^ addr ^ ":" ^ string_of_int port) in + Lwt_zmq.Socket.of_socket socket + in + + let identity () = Uuidm.(to_string (create `V4)) in + + (* see kernel/channels.py *) + let shell_socket addr port () = + let socket = ZMQ.Socket.(create zmq dealer) in + let () = ZMQ.Socket.set_identity socket (identity()) in + let () = ZMQ.Socket.connect socket ("tcp://" ^ addr ^ ":" ^ string_of_int port) in + Lwt_zmq.Socket.of_socket socket + in + let iopub_socket addr port () = + let socket = ZMQ.Socket.(create zmq sub) in + let () = ZMQ.Socket.subscribe socket "" in + let () = ZMQ.Socket.set_identity socket (identity()) in + let () = ZMQ.Socket.connect socket ("tcp://" ^ addr ^ ":" ^ string_of_int port) in + Lwt_zmq.Socket.of_socket socket + in + let heartbeat_socket addr port () = + let socket = ZMQ.Socket.(create zmq req) in + let () = ZMQ.Socket.set_linger_period socket 0 in + let () = ZMQ.Socket.connect socket ("tcp://" ^ addr ^ ":" ^ string_of_int port) in + Lwt_zmq.Socket.of_socket socket + in + let kernel = + { + process = Lwt_process.open_process_none command; + guid = kernel_guid; + stdin = make_socket ZMQ.Socket.dealer ip_addr zmq_stdin_port; + control = make_socket ZMQ.Socket.dealer ip_addr zmq_control_port; + shell = shell_socket ip_addr zmq_shell_port; + iopub = iopub_socket ip_addr zmq_iopub_port; + heartbeat = heartbeat_socket ip_addr zmq_heartbeat_port; + } + in + (* add kernel *) + M.add_kernel kernel_guid kernel; + Lwt.return kernel - (* see kernel/channels.py *) - let shell_socket addr port () = - let socket = ZMQ.Socket.(create zmq dealer) in - let () = ZMQ.Socket.set_identity socket (identity()) in - let () = ZMQ.Socket.connect socket ("tcp://" ^ addr ^ ":" ^ string_of_int port) in - Lwt_zmq.Socket.of_socket socket - in - let iopub_socket addr port () = - let socket = ZMQ.Socket.(create zmq sub) in - let () = ZMQ.Socket.subscribe socket "" in - let () = ZMQ.Socket.set_identity socket (identity()) in - let () = ZMQ.Socket.connect socket ("tcp://" ^ addr ^ ":" ^ string_of_int port) in - Lwt_zmq.Socket.of_socket socket - in - let heartbeat_socket addr port () = - let socket = ZMQ.Socket.(create zmq req) in - let () = ZMQ.Socket.set_linger_period socket 0 in - let () = ZMQ.Socket.connect socket ("tcp://" ^ addr ^ ":" ^ string_of_int port) in - Lwt_zmq.Socket.of_socket socket - in - let kernel = - { - process = Lwt_process.open_process_none command; - guid = kernel_guid; - stdin = make_socket ZMQ.Socket.dealer ip_addr zmq_stdin_port; - control = make_socket ZMQ.Socket.dealer ip_addr zmq_control_port; - shell = shell_socket ip_addr zmq_shell_port; - iopub = iopub_socket ip_addr zmq_iopub_port; - heartbeat = heartbeat_socket ip_addr zmq_heartbeat_port; - } - in - (* add kernel *) - M.add_kernel kernel_guid kernel; - Lwt.return kernel - let get_kernel ~zmq ~path ~notebook_guid ~ip_addr = - match M.kernel_of_notebook_guid notebook_guid with - | Some(k) -> Lwt.return k - | None -> - start_kernel ~zmq ~path ~notebook_guid ~ip_addr + match M.kernel_of_notebook_guid notebook_guid with + | Some(k) -> Lwt.return k + | None -> + start_kernel ~zmq ~path ~notebook_guid ~ip_addr let close_kernel guid = - match M.kernel_of_kernel_guid guid with - | None -> () - | Some(kernel) -> - (* kill the kernel *) - kernel.process#terminate; - (* XXX close sockets? *) - (* remove from map *) - M.(delete_kernel guid) + match M.kernel_of_kernel_guid guid with + | None -> () + | Some(kernel) -> + (* kill the kernel *) + kernel.process#terminate; + (* XXX close sockets? *) + (* remove from map *) + M.(delete_kernel guid) diff --git a/makefile b/makefile index f4c9745..e771030 100644 --- a/makefile +++ b/makefile @@ -1,26 +1,7 @@ -.PHONY: iocamlserver.byte iocamlserver.native +.PHONY: all clean -all: iocamlserver.byte -native: iocamlserver.native - -filesys.ml: - ocaml-crunch -o filesys.ml -m plain filesys-1.1 - -tutorial.ml: tutorial/tutorial.ipynb - ocaml-crunch -o tutorial.ml -m plain tutorial - -iocamlserver.byte: filesys.ml tutorial.ml - ocamlbuild -use-ocamlfind iocamlserver.byte - -iocamlserver.native: filesys.ml tutorial.ml - ocamlbuild -use-ocamlfind iocamlserver.native - -install: - cp iocamlserver.byte `opam config var bin`/iocaml +all: + @jbuilder build clean: - ocamlbuild -clean - - rm -f *~ - - rm -f *.json - -rm -f filesys.ml tutorial.ml - + @jbuilder clean diff --git a/pages.ml b/pages.ml index 4a6679d..70b75fd 100644 --- a/pages.ml +++ b/pages.ml @@ -1,4 +1,4 @@ -(* +(* * iocamlserver - IOCaml notebook server * * (c) 2014 MicroJamJar Ltd @@ -11,7 +11,7 @@ (* see ipython/html/templates/page.html etc *) (* - + Cow uses xmlm which is a XML codec. We want to write HTML5. If you have something like; @@ -21,7 +21,7 @@ + {{{stylesheet}}} + + -