diff --git a/node.ml b/node.ml index 2779e07..648a08d 100644 --- a/node.ml +++ b/node.ml @@ -41,6 +41,8 @@ let lookup name = try Some (StringMap.find name !directory) with Not_found -> None +let all_node_names () = string_map_keys !directory + (* Approximate because it doesn't lock or run in a transaction *) let approx_exists name = StringMap.mem name !directory diff --git a/ui_main.ml b/ui_main.ml index 337a8f2..61a6539 100644 --- a/ui_main.ml +++ b/ui_main.ml @@ -17,6 +17,7 @@ open Html open Hof +open Datastructures let dispatch_table = ref [] @@ -33,8 +34,13 @@ let handle_dynamic_req id r = Httpd.http_error_html 404 "Not found" [Html.tag "p" [] [Html.text ("No route for URL path "^r.Httpd.path)]] | (prefix, handler) :: rest -> - if Util.starts_with r.Httpd.path prefix - then handler id r + let wholepath = r.Httpd.path in + if Util.starts_with wholepath prefix + then + (let wholepath_len = String.length wholepath in + let prefix_len = String.length prefix in + let suffix = String.sub wholepath prefix_len (wholepath_len - prefix_len) in + handler suffix id r) else search_table rest in search_table !dispatch_table @@ -60,7 +66,7 @@ let start (s, peername) = (s, peername) let boot_time = Unix.time () -let api_server_stats id r = +let api_server_stats _ id r = Json.resp_ok [] (Json.Rec ["connection_count", Json.Num (float_of_int !Connections.connection_count); "boot_time", Json.Num boot_time; @@ -68,6 +74,22 @@ let api_server_stats id r = "classes", Json.Arr (List.map Json.str (Factory.all_class_names ()))]) |> Httpd.add_date_header +let api_nodes _ id r = + Json.resp_ok [] (Json.Rec ["nodes", Json.Arr (List.map Json.str (Node.all_node_names ()))]) + |> Httpd.add_date_header + +let api_node_info suffix id r = + (match Node.lookup suffix with + | Some n -> + Json.resp_ok [] (Json.Rec + ["names", Json.Arr (List.map Json.str (StringSet.elements n.Node.names)); + "class_name", Json.Str n.Node.class_name]) + | None -> + Json.resp 404 "No such node name" [] Json.Nil) + |> Httpd.add_date_header + let init () = register_dispatcher ("/_/server_stats", api_server_stats); + register_dispatcher ("/_/nodes", api_nodes); + register_dispatcher ("/_/node/", api_node_info); ignore (Util.create_thread "HTTP listener" None (Net.start_net "HTTP" 5678) start) diff --git a/ui_relay.ml b/ui_relay.ml index 1d31f21..0ad830e 100644 --- a/ui_relay.ml +++ b/ui_relay.ml @@ -79,7 +79,7 @@ let api_tap_sink irrelevant_id r = | _ -> Httpd.http_error_html 406 "Bad data parameter" []) | _ -> Httpd.http_error_html 406 "Unsupported metadata.type" [] -let api_tap id r = +let api_tap _ id r = match r.Httpd.verb with | "GET" -> api_tap_source id r | "POST" -> api_tap_sink id r diff --git a/web/ui_main.js b/web/ui_main.js index 3d9798c..5fda8bd 100644 --- a/web/ui_main.js +++ b/web/ui_main.js @@ -28,12 +28,6 @@ function refresh_server_stats() { }).error(server_disconnected); } -function refresh_all_classes() { - $.getJSON("/_/all_classes", function (data) { - $("#debug_container").append(JSON.stringify(data)); - }); -} - var Ocamlmsg = { _send: function (msg) { $tap.send({data: JSON.stringify(msg)}); @@ -97,7 +91,6 @@ function reset_tap_stream() { open: function (event, stream) { refresh_server_stats(); - refresh_all_classes(); Ocamlmsg.post(stream.id, {"test":true}); Ocamlmsg.create("fanout", ["system.log"], "completion1"); Ocamlmsg.subscribe("meta", "system.log", "sub_messages", "completion2");