Intern node names to permit faster routing.

This commit is contained in:
Tony Garnock-Jones 2012-05-05 11:46:48 -04:00
parent 2f80a54ffe
commit 51cbec0565
12 changed files with 131 additions and 93 deletions

View File

@ -26,12 +26,12 @@ type connection_t = {
mtx: Mutex.t; mtx: Mutex.t;
cin: in_channel; cin: in_channel;
cout: out_channel; cout: out_channel;
name: Uuid.t; name: Node.name;
mutable input_buf: string; mutable input_buf: string;
mutable output_buf: Buffer.t; mutable output_buf: Buffer.t;
mutable frame_max: int; mutable frame_max: int;
mutable connection_closed: bool; mutable connection_closed: bool;
mutable recent_queue_name: string option; mutable recent_queue_name: Node.name option;
mutable delivery_tag: int mutable delivery_tag: int
} }
@ -43,7 +43,7 @@ let amqp_boot (peername, mtx, cin, cout) = {
mtx = mtx; mtx = mtx;
cin = cin; cin = cin;
cout = cout; cout = cout;
name = Uuid.create (); name = Node.name_of_string (Uuid.create ());
input_buf = String.create initial_frame_size; input_buf = String.create initial_frame_size;
output_buf = Buffer.create initial_frame_size; output_buf = Buffer.create initial_frame_size;
frame_max = initial_frame_size; frame_max = initial_frame_size;
@ -251,7 +251,7 @@ let get_recent_queue_name conn =
let expand_mrdq conn queue = let expand_mrdq conn queue =
match queue with match queue with
| "" -> get_recent_queue_name conn | "" -> get_recent_queue_name conn
| other -> other | other -> Node.name_of_string other
let handle_method conn channel m = let handle_method conn channel m =
if channel > 1 then die channel_error "Unsupported channel number" else (); if channel > 1 then die channel_error "Unsupported channel number" else ();
@ -269,27 +269,27 @@ let handle_method conn channel m =
| Channel_close_ok -> | Channel_close_ok ->
() ()
| Exchange_declare (exchange, type_, passive, durable, no_wait, arguments) -> | Exchange_declare (exchange, type_, passive, durable, no_wait, arguments) ->
Node.send_ignore "factory" (Message.create (Sexp.Str type_, Node.send_ignore' "factory" (Message.create (Sexp.Str type_,
Sexp.Arr [Sexp.Str exchange], Sexp.Arr [Sexp.Str exchange],
Sexp.Str conn.name, Sexp.Str conn.name.Node.label,
Sexp.Str "Exchange_declare_reply")) Sexp.Str "Exchange_declare_reply"))
| Queue_declare (queue, passive, durable, exclusive, auto_delete, no_wait, arguments) -> | Queue_declare (queue, passive, durable, exclusive, auto_delete, no_wait, arguments) ->
let queue = (if queue = "" then Uuid.create () else queue) in let queue = (if queue = "" then Uuid.create () else queue) in
conn.recent_queue_name <- Some queue; conn.recent_queue_name <- Some (Node.name_of_string queue);
Node.send_ignore "factory" (Message.create (Sexp.Str "queue", Node.send_ignore' "factory" (Message.create (Sexp.Str "queue",
Sexp.Arr [Sexp.Str queue], Sexp.Arr [Sexp.Str queue],
Sexp.Str conn.name, Sexp.Str conn.name.Node.label,
Sexp.Str "Queue_declare_reply")) Sexp.Str "Queue_declare_reply"))
| Queue_bind (queue, exchange, routing_key, no_wait, arguments) -> | Queue_bind (queue, exchange, routing_key, no_wait, arguments) ->
let queue = expand_mrdq conn queue in let queue = expand_mrdq conn queue in
if not (Node.approx_exists queue) if not (Node.approx_exists queue)
then send_warning conn not_found ("Queue "^queue^" not found") then send_warning conn not_found ("Queue "^queue.Node.label^" not found")
else else
if Node.send exchange (Message.subscribe (Sexp.Str routing_key, if Node.send' exchange (Message.subscribe (Sexp.Str routing_key,
Sexp.Str queue, Sexp.Str queue.Node.label,
Sexp.Str "", Sexp.Str "",
Sexp.Str conn.name, Sexp.Str conn.name.Node.label,
Sexp.Str "Queue_bind_reply")) Sexp.Str "Queue_bind_reply"))
then () then ()
else send_warning conn not_found ("Exchange "^exchange^" not found") else send_warning conn not_found ("Exchange "^exchange^" not found")
| Basic_consume (queue, consumer_tag, no_local, no_ack, exclusive, no_wait, arguments) -> | Basic_consume (queue, consumer_tag, no_local, no_ack, exclusive, no_wait, arguments) ->
@ -297,16 +297,16 @@ let handle_method conn channel m =
let consumer_tag = (if consumer_tag = "" then Uuid.create () else consumer_tag) in let consumer_tag = (if consumer_tag = "" then Uuid.create () else consumer_tag) in
if Node.send queue (Message.subscribe if Node.send queue (Message.subscribe
(Sexp.Str "", (Sexp.Str "",
Sexp.Str conn.name, Sexp.Str conn.name.Node.label,
Sexp.Arr [Sexp.Str "delivery"; Sexp.Str consumer_tag], Sexp.Arr [Sexp.Str "delivery"; Sexp.Str consumer_tag],
Sexp.Str conn.name, Sexp.Str conn.name.Node.label,
Sexp.Arr [Sexp.Str "Basic_consume_reply"; Sexp.Str consumer_tag])) Sexp.Arr [Sexp.Str "Basic_consume_reply"; Sexp.Str consumer_tag]))
then () then ()
else send_warning conn not_found ("Queue "^queue^" not found") else send_warning conn not_found ("Queue "^queue.Node.label^" not found")
| Basic_publish (exchange, routing_key, false, false) -> | Basic_publish (exchange, routing_key, false, false) ->
let (_, (body_size, properties)) = next_header conn in let (_, (body_size, properties)) = next_header conn in
let body = recv_content_body conn body_size in let body = recv_content_body conn body_size in
if Node.post exchange if Node.post' exchange
(Sexp.Str routing_key) (Sexp.Str routing_key)
(Sexp.Hint {Sexp.hint = Sexp.Str "amqp"; (Sexp.Hint {Sexp.hint = Sexp.Str "amqp";
Sexp.body = Sexp.Arr [Sexp.Str exchange; Sexp.body = Sexp.Arr [Sexp.Str exchange;
@ -400,11 +400,11 @@ let start (s, peername) =
amqp_boot amqp_handler amqp_mainloop (s, peername) amqp_boot amqp_handler amqp_mainloop (s, peername)
let init () = let init () =
Node.send_ignore "factory" (Message.create (Sexp.Str "direct", Node.send_ignore' "factory" (Message.create (Sexp.Str "direct",
Sexp.Arr [Sexp.Str "amq.direct"], Sexp.Arr [Sexp.Str "amq.direct"],
Sexp.Str "", Sexp.Str "")); Sexp.Str "", Sexp.Str ""));
Node.send_ignore "factory" (Message.create (Sexp.Str "fanout", Node.send_ignore' "factory" (Message.create (Sexp.Str "fanout",
Sexp.Arr [Sexp.Str "amq.fanout"], Sexp.Arr [Sexp.Str "amq.fanout"],
Sexp.Str "", Sexp.Str "")); Sexp.Str "", Sexp.Str ""));
ignore (Util.create_daemon_thread ignore (Util.create_daemon_thread
"AMQP listener" None (Net.start_net "AMQP" Amqp_spec.port) start) "AMQP listener" None (Net.start_net "AMQP" Amqp_spec.port) start)

View File

@ -20,7 +20,7 @@ open Datastructures
open Status open Status
type t = { type t = {
name: string; name: Node.name;
subscriptions: Subscription.set_t; subscriptions: Subscription.set_t;
mtx: Mutex.t; mtx: Mutex.t;
mutable routing_table: UuidSet.t StringMap.t; mutable routing_table: UuidSet.t StringMap.t;
@ -76,14 +76,16 @@ let route_message info n sexp =
let factory arg = let factory arg =
match arg with match arg with
| (Arr [Str name]) -> | (Arr [Str name_str]) ->
let info = { let info = {
name = name; name = Node.name_of_string name_str;
subscriptions = Subscription.new_set (); subscriptions = Subscription.new_set ();
mtx = Mutex.create (); mtx = Mutex.create ();
routing_table = StringMap.empty; routing_table = StringMap.empty;
} in } in
replace_ok (Node.make_idempotent_named classname name (route_message info)) (Str name) replace_ok
(Node.make_idempotent_named classname info.name (route_message info))
(Str name_str)
| _ -> | _ ->
Problem (Str "bad-arg") Problem (Str "bad-arg")

View File

@ -59,9 +59,9 @@ let factory_handler n sexp =
Log.warn "Node class not found" [Str classname]; Log.warn "Node class not found" [Str classname];
Message.create_failed (Arr [Str "factory"; Str "class-not-found"]) Message.create_failed (Arr [Str "factory"; Str "class-not-found"])
in in
Node.post_ignore reply_sink (Str reply_name) reply (Str "") Node.post_ignore' reply_sink (Str reply_name) reply (Str "")
| m -> | m ->
Util.message_not_understood "factory" m Util.message_not_understood "factory" m
let init () = let init () =
Node.bind_ignore ("factory", Node.make "factory" factory_handler) Node.bind_ignore (Node.name_of_string "factory", Node.make "factory" factory_handler)

View File

@ -20,7 +20,7 @@ open Datastructures
open Status open Status
type t = { type t = {
name: string; name: Node.name;
subscriptions: Subscription.set_t; subscriptions: Subscription.set_t;
mtx: Mutex.t; mtx: Mutex.t;
} }
@ -51,13 +51,15 @@ let route_message info n sexp =
let factory arg = let factory arg =
match arg with match arg with
| (Arr [Str name]) -> | (Arr [Str name_str]) ->
let info = { let info = {
name = name; name = Node.name_of_string name_str;
subscriptions = Subscription.new_set (); subscriptions = Subscription.new_set ();
mtx = Mutex.create (); mtx = Mutex.create ();
} in } in
replace_ok (Node.make_idempotent_named classname name (route_message info)) (Str name) replace_ok
(Node.make_idempotent_named classname info.name (route_message info))
(Str name_str)
| _ -> | _ ->
Problem (Str "bad-arg") Problem (Str "bad-arg")

View File

@ -15,10 +15,12 @@
(* You should have received a copy of the GNU General Public License *) (* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see <http://www.gnu.org/licenses/>. *) (* along with Hop. If not, see <http://www.gnu.org/licenses/>. *)
let n_system_log = Node.name_of_string "system.log"
let hook_log () = let hook_log () =
let old_hook = !Log.hook in let old_hook = !Log.hook in
let new_hook label body = let new_hook label body =
ignore (Node.post "system.log" (Sexp.Str label) body (Sexp.Str "")); ignore (Node.post n_system_log (Sexp.Str label) body (Sexp.Str ""));
old_hook label body old_hook label body
in in
Log.hook := new_hook Log.hook := new_hook

10
meta.ml
View File

@ -17,12 +17,14 @@
open Sexp open Sexp
let n_meta = Node.name_of_string "meta"
let announce_subscription source filter sink name on_off = let announce_subscription source filter sink name on_off =
Node.post_ignore "meta" (Str source) Node.post_ignore n_meta (Str source.Node.label)
(if on_off (if on_off
then Message.subscribed (Str source, filter, Str sink, name) then Message.subscribed (Str source.Node.label, filter, Str sink, name)
else Message.unsubscribed (Str source, filter, Str sink, name)) else Message.unsubscribed (Str source.Node.label, filter, Str sink, name))
(Str "") (Str "")
let init () = let init () =
Node.send_ignore "factory" (Message.create (Str "direct", Arr [Str "meta"], Str "", Str "")) Node.send_ignore' "factory" (Message.create (Str "direct", Arr [Str "meta"], Str "", Str ""))

88
node.ml
View File

@ -25,9 +25,29 @@ and t = {
class_name: string; class_name: string;
handle_message: handle_message_t handle_message: handle_message_t
} }
and name = {
label: string;
mutable binding: t option
}
module NameTable = Weak.Make(struct
type t = name
let equal a b = (a.label = b.label)
let hash a = Hashtbl.hash a.label
end)
module NameSet = Set.Make(struct
type t = name
let compare a b = String.compare a.label b.label
end)
let mutex = Mutex.create () let mutex = Mutex.create ()
let directory = ref StringMap.empty let name_table = NameTable.create 100
let directory = ref NameSet.empty
let name_of_string str =
Util.with_mutex0 mutex (fun () ->
let template = {label = str; binding = None} in
NameTable.merge name_table template)
let local_container_name () = "server" let local_container_name () = "server"
@ -37,27 +57,27 @@ let make class_name handler = {
handle_message = handler handle_message = handler
} }
let lookup name = let lookup name = name.binding
try Some (StringMap.find name !directory)
with Not_found -> None
let all_node_names () = string_map_keys !directory let all_node_names () = NameSet.elements !directory
let all_node_name_strings () = List.map (fun x -> x.label) (all_node_names ())
(* Approximate because it doesn't lock or run in a transaction *) (* Approximate because it doesn't lock or run in a transaction *)
let approx_exists name = StringMap.mem name !directory let approx_exists name =
match name.binding with
| Some _ -> true
| None -> false
let bind (filter, node) = let bind (filter, node) =
if filter = "" if filter.label = ""
then (Log.warn "Binding to empty name forbidden" []; false) then (Log.warn "Binding to empty name forbidden" []; false)
else else
Util.with_mutex0 mutex Util.with_mutex0 mutex (fun () ->
(fun () -> filter.binding <- Some node;
if StringMap.mem filter !directory directory := NameSet.add filter !directory;
then false node.names <- StringSet.add filter.label node.names;
else (directory := StringMap.add filter node !directory; Log.info "Node bound" [Sexp.Str filter.label; Sexp.Str node.class_name];
node.names <- StringSet.add filter node.names; true)
Log.info "Node bound" [Sexp.Str filter; Sexp.Str node.class_name];
true))
(* For use in factory constructor functions, hence the odd return type and values *) (* For use in factory constructor functions, hence the odd return type and values *)
let make_named class_name node_name handler = let make_named class_name node_name handler =
@ -76,19 +96,19 @@ let make_idempotent_named class_name node_name handler =
if bind (node_name, node) then Ok node else Problem (Sexp.Str "bind-failed") if bind (node_name, node) then Ok node else Problem (Sexp.Str "bind-failed")
let unbind name = let unbind name =
Util.with_mutex0 mutex Util.with_mutex0 mutex (fun () ->
(fun () -> match lookup name with
match lookup name with | Some n ->
| Some n -> Log.info "Node unbound" [Sexp.Str name.label; Sexp.Str n.class_name];
Log.info "Node unbound" [Sexp.Str name; Sexp.Str n.class_name]; n.names <- StringSet.remove name.label n.names;
n.names <- StringSet.remove name n.names; name.binding <- None;
directory := StringMap.remove name !directory; directory := NameSet.remove name !directory;
true true
| None -> | None ->
false) false)
let unbind_all n = let unbind_all n =
StringSet.iter (fun name -> ignore (unbind name)) n.names; StringSet.iter (fun name -> ignore (unbind (name_of_string name))) n.names;
n.names <- StringSet.empty n.names <- StringSet.empty
let send name body = let send name body =
@ -97,23 +117,31 @@ let send name body =
(try n.handle_message n body (try n.handle_message n body
with e -> with e ->
Log.warn "Node message handler raised exception" Log.warn "Node message handler raised exception"
[Sexp.Str name; [Sexp.Str name.label;
Sexp.Str (Printexc.to_string e)]); Sexp.Str (Printexc.to_string e)]);
true true
| None -> false | None -> false
let send' str body = send (name_of_string str) body
let post name label body token = let post name label body token =
send name (Message.post (label, body, token)) send name (Message.post (label, body, token))
let post' str label body token = post (name_of_string str) label body token
let bind_ignore (filter, node) = let bind_ignore (filter, node) =
if bind (filter, node) if bind (filter, node)
then () then ()
else Log.warn "Duplicate binding" [Sexp.Str filter] else Log.warn "Duplicate binding" [Sexp.Str filter.label]
let send_ignore name body = let send_ignore name body =
if send name body || name = "" if send name body || name.label = ""
then () then ()
else Log.warn "send to missing node" [Sexp.Str name; body] else Log.warn "send to missing node" [Sexp.Str name.label; body]
let send_ignore' str body = send_ignore (name_of_string str) body
let post_ignore name label body token = let post_ignore name label body token =
send_ignore name (Message.post (label, body, token)) send_ignore name (Message.post (label, body, token))
let post_ignore' str label body token = post_ignore (name_of_string str) label body token

View File

@ -19,7 +19,7 @@ open Sexp
open Status open Status
type t = { type t = {
name: string; name: Node.name;
subscriptions: Subscription.set_t; subscriptions: Subscription.set_t;
ch: Message.t Squeue.t; ch: Message.t Squeue.t;
mutable backlog: Sexp.t Queue.t; mutable backlog: Sexp.t Queue.t;
@ -83,17 +83,17 @@ let shoveller info =
let queue_factory arg = let queue_factory arg =
match arg with match arg with
| (Arr [Str name]) -> | (Arr [Str name_str]) ->
let info = { let info = {
name = name; name = Node.name_of_string name_str;
subscriptions = Subscription.new_set (); subscriptions = Subscription.new_set ();
ch = Squeue.create 1000; ch = Squeue.create 1000;
backlog = Queue.create (); backlog = Queue.create ();
waiters = Queue.create () waiters = Queue.create ()
} in } in
ignore (Util.create_thread name None shoveller info); ignore (Util.create_thread name_str None shoveller info);
let queue_handler n sexp = Squeue.add (Message.message_of_sexp sexp) info.ch in let queue_handler n sexp = Squeue.add (Message.message_of_sexp sexp) info.ch in
replace_ok (Node.make_idempotent_named classname name queue_handler) (Str name) replace_ok (Node.make_idempotent_named classname info.name queue_handler) (Str name_str)
| _ -> | _ ->
Problem (Str "bad-arg") Problem (Str "bad-arg")

View File

@ -31,17 +31,17 @@ let send_sexp_syntax_error ch explanation =
let dispatch_message n ch m = let dispatch_message n ch m =
match m with match m with
| Message.Post (Str name, body, token) -> | Message.Post (Str name, body, token) ->
Node.send_ignore name body Node.send_ignore' name body
| Message.Subscribe (Str filter, sink, name, Str reply_sink, Str reply_name) -> | Message.Subscribe (Str filter, sink, name, Str reply_sink, Str reply_name) ->
if Node.bind(filter, n) if Node.bind (Node.name_of_string filter, n)
then Node.post_ignore then Node.post_ignore'
reply_sink reply_sink
(Str reply_name) (Str reply_name)
(Message.subscribe_ok (Str filter)) (Message.subscribe_ok (Str filter))
(Str "") (Str "")
else Log.warn "Bind failed" [Str filter] else Log.warn "Bind failed" [Str filter]
| Message.Unsubscribe (Str token) -> | Message.Unsubscribe (Str token) ->
if Node.unbind token if Node.unbind (Node.name_of_string token)
then () then ()
else Log.warn "Unbind failed" [Str token] else Log.warn "Unbind failed" [Str token]
| _ -> | _ ->

View File

@ -21,7 +21,7 @@ type t = {
mutable live: bool; mutable live: bool;
uuid: Uuid.t; uuid: Uuid.t;
filter: Sexp.t; filter: Sexp.t;
sink: string; sink: Node.name;
name: Sexp.t name: Sexp.t
} }
@ -31,8 +31,9 @@ let new_set () = ref StringMap.empty
let count subs = StringMap.cardinal !subs let count subs = StringMap.cardinal !subs
let create source subs filter sink name reply_sink reply_name = let create source subs filter sink_str name reply_sink reply_name =
let uuid = Uuid.create () in let uuid = Uuid.create () in
let sink = Node.name_of_string sink_str in
let sub = { let sub = {
live = true; live = true;
uuid = uuid; uuid = uuid;
@ -41,8 +42,8 @@ let create source subs filter sink name reply_sink reply_name =
name = name name = name
} in } in
subs := StringMap.add uuid sub !subs; subs := StringMap.add uuid sub !subs;
Meta.announce_subscription source filter sink name true; Meta.announce_subscription source filter sink_str name true;
Node.post_ignore reply_sink reply_name (Message.subscribe_ok (Sexp.Str uuid)) (Sexp.Str ""); Node.post_ignore' reply_sink reply_name (Message.subscribe_ok (Sexp.Str uuid)) (Sexp.Str "");
sub sub
let delete source subs uuid = let delete source subs uuid =
@ -50,7 +51,7 @@ let delete source subs uuid =
let sub = StringMap.find uuid !subs in let sub = StringMap.find uuid !subs in
sub.live <- false; sub.live <- false;
subs := StringMap.remove uuid !subs; subs := StringMap.remove uuid !subs;
Meta.announce_subscription source sub.filter sub.sink sub.name false; Meta.announce_subscription source sub.filter sub.sink.Node.label sub.name false;
Some sub Some sub
with Not_found -> with Not_found ->
None None

View File

@ -59,7 +59,7 @@ let cleanup_req id exn =
| None -> () | None -> ()
let start (s, peername) = let start (s, peername) =
let id = "http-" ^ Uuid.create () in let id = Node.name_of_string ("http-" ^ Uuid.create ()) in
Util.create_thread (Connections.endpoint_name peername ^ " HTTP service") Util.create_thread (Connections.endpoint_name peername ^ " HTTP service")
(Some (cleanup_req id)) (Some (cleanup_req id))
(Httpd.main (handle_req id)) (Httpd.main (handle_req id))
@ -75,11 +75,11 @@ let api_server_stats _ id r =
|> Httpd.add_date_header |> Httpd.add_date_header
let api_nodes _ id r = let api_nodes _ id r =
Json.resp_ok [] (Json.Rec ["nodes", Json.Arr (List.map Json.str (Node.all_node_names ()))]) Json.resp_ok [] (Json.Rec ["nodes", Json.Arr (List.map Json.str (Node.all_node_name_strings ()))])
|> Httpd.add_date_header |> Httpd.add_date_header
let api_node_info suffix id r = let api_node_info suffix id r =
(match Node.lookup suffix with (match Node.lookup (Node.name_of_string suffix) with
| Some n -> | Some n ->
Json.resp_ok [] (Json.Rec Json.resp_ok [] (Json.Rec
["names", Json.Arr (List.map Json.str (StringSet.elements n.Node.names)); ["names", Json.Arr (List.map Json.str (StringSet.elements n.Node.names));

View File

@ -42,7 +42,8 @@ let rec api_tap_source id r =
if not (Node.bind (id, n)) if not (Node.bind (id, n))
then Httpd.http_error_html 500 "Internal ID collision" [] then Httpd.http_error_html 500 "Internal ID collision" []
else else
let id_block_and_padding = Stringstream.const_flush (id ^ ";" ^ String.make 2048 'h' ^ ";") in let id_block_and_padding =
Stringstream.const_flush (id.Node.label ^ ";" ^ String.make 2048 'h' ^ ";") in
handle_message n (Message.subscribe (Sexp.Str (Node.local_container_name()), handle_message n (Message.subscribe (Sexp.Str (Node.local_container_name()),
Sexp.Str "", Sexp.Str "", Sexp.Str "", Sexp.Str "",
Sexp.Str "", Sexp.Str "")); Sexp.Str "", Sexp.Str ""));
@ -72,7 +73,7 @@ let api_tap_sink irrelevant_id r =
with _ -> Httpd.http_error_html 406 "Bad data parameter" []) in with _ -> Httpd.http_error_html 406 "Bad data parameter" []) in
(match Message.message_of_sexp data with (match Message.message_of_sexp data with
| Message.Post (Sexp.Str name, body, token) -> | Message.Post (Sexp.Str name, body, token) ->
Node.send_ignore name body; Node.send_ignore' name body;
Httpd.resp_generic 202 "Accepted" [] (Httpd.empty_content) Httpd.resp_generic 202 "Accepted" [] (Httpd.empty_content)
| _ -> | _ ->
Httpd.http_error_html 406 "Message not understood" []) Httpd.http_error_html 406 "Message not understood" [])