Crude dust-off for building on OSX Sonoma 14.4 with Python 3 and Xcode 15.3

.gitignore

@@ -1,5 +1 @@
 scratch/
-_build/
-*.native
-message.ml
-amqp_spec.ml

README.md

@@ -0,0 +1,196 @@
+# Recursive Message Broker
+
+This is a *sketch* of a recursive messaging protocol, broker, and
+client libraries, inspired by AMQP 0-91,
+[PubSubHubBub](http://code.google.com/p/pubsubhubbub/),
+[STOMP](http://stomp.github.com/) and
+[reversehttp](http://reversehttp.net/). It's quite different to AMQP
+1.0 (but it may be instructive to compare the two approaches).
+
+Currently, the project includes
+
+ - a server (written in OCaml), with adapters for
+    - Hop's own protocol,
+    - a subset of AMQP 0-9-1, and
+    - XHR streaming of messages to and from the broker.
+ - a web-based console for the server
+ - an OSX GUI for the server
+ - messaging for the web
+ - client libraries for various languages (Java, Racket, Javascript)
+
+## A sketch?
+
+Honestly, not meant to be production software... yet.
+
+## Background
+
+Messaging à la AMQP 0-91 can be broken down into a few core pieces:
+
+ - transmission and receipt of messages (publishes, deliveries, and gets)
+
+ - subscription management (subsuming enrollment, bindings, consumers and relays)
+
+ - directory (naming of resources in the broker)
+
+ - object management (creation and destruction of remote resources)
+
+AMQP itself, being a first mover in its space, isn't as orthogonal as
+it could be. It can be greatly simplified without losing anything of
+value. This experiment is intended to demonstrate one possible way of
+paring each of the core pieces of AMQP-style messaging back to their
+essences.
+
+### More detail
+
+TBD.
+
+ - what recursive means in this context
+ - doing things this way gives you shovels (relays) for free
+ - and effortless interop with legacy messaging networks (including UDP, SMTP, IMAP, HTTP etc)
+ - and effortless federation
+ - and a big step closer to a sensible semantics for transactions
+
+ - relays (including active *client* connections!) are just nodes in
+   the network, addressable like any other - so `(post! somerelay
+   (post! someremotenode ...))` and so on is the way to cause things
+   to happen remotely.
+
+## Compiling the server
+
+The server is written in [OCaml](http://caml.inria.fr/). To build and
+run the server, you will need:
+
+ - [OCaml itself](http://caml.inria.fr/download.en.html), version 3.12 or newer
+ - [OCaml Findlib](http://projects.camlcity.org/projects/findlib.html); I have used 1.2.8 and 1.3.1, but older versions may well work
+ - [libev](http://software.schmorp.de/pkg/libev.html) installed somewhere that Findlib can find it
+ - [python](http://www.python.org/) to generate parts of the protocol codecs
+
+Make sure you have `ocamlopt`, `ocamlbuild`, `ocamlfind` etc. on your
+path. Then, in the `server` subdirectory, run `make`. It should first
+compile [Lwt](http://ocsigen.org/lwt/), which is included as a
+third-party library, and then should proceed to compiling the server
+itself.
+
+If `ocamlfind` can't find `libev`, try setting (and exporting) the
+environment variables `C_INCLUDE_PATH` and `LIBRARY_PATH` to point to
+the include and lib directories containing `libev`'s files.
+
+To run the server, simply run `./server/hop_server.native`, or just
+`make run` from within the `server` directory.
+
+## Working with the management and monitoring webpages
+
+If you want to edit and/or recompile the server's built-in webpages,
+you will need to have installed
+
+ - [xsltproc](http://xmlsoft.org/xslt/xsltproc2.html) to make the webpages from the templates
+ - [recess](http://twitter.github.com/recess/) to compile the LESS into CSS
+
+## Compiling the Java client library
+
+You will need a recent JDK, and Ant v1.6 or newer. Change to the
+`java` subdirectory, and run `ant`. You will end up with a file
+`build/lib/hop.jar`, which contains the client library and some test
+programs.
+
+## Run it
+
+Open three terminals. Run the server in one of them. You should see
+output like the following:
+
+    hop ALPHA, Copyright (C) 2012 Tony Garnock-Jones.
+    This program comes with ABSOLUTELY NO WARRANTY. This is free software,
+    and you are welcome to redistribute it under certain conditions.
+    See the GNU General Public License (version 3 or later) for details.
+    info: ("Node bound" "factory" "factory")
+    info: ("Registered node class" "queue")
+    info: ("Registered node class" "fanout")
+    info: ("Registered node class" "direct")
+    info: ("Node bound" "meta" "direct")
+    info: ("Node create ok" "direct" ("meta") "" "" "meta")
+    info: ("Node bound" "amq.direct" "direct")
+    info: ("Node create ok" "direct" ("amq.direct") "" "" "amq.direct")
+    info: ("Node bound" "amq.fanout" "fanout")
+    info: ("Node create ok" "fanout" ("amq.fanout") "" "" "amq.fanout")
+    info: ("Accepting connections" "AMQP" "5672")
+    info: ("Accepting connections" "HTTP" "5678")
+    info: ("Accepting connections" "Hop" "5671")
+    info: ("Waiting for milestone" "AMQP ready")
+    info: ("Achieved milestone" "AMQP ready")
+    info: ("Waiting for milestone" "HTTP ready")
+    info: ("Achieved milestone" "HTTP ready")
+    info: ("Waiting for milestone" "Hop ready")
+    info: ("Achieved milestone" "Hop ready")
+    info: ("Achieved milestone" "Server initialized")
+
+In the second terminal, run the consuming half of the Java test
+program pair:
+
+    java -cp hop.jar hop.Test1 localhost
+
+In the third, run the producing half:
+
+    java -cp hop.jar hop.Test3 localhost
+
+## Wire protocol
+
+Obviously the wire protocol itself here is the simplest thing that
+could possibly work, and you'd never use anything like this
+inefficient in a real system. That said, this is what's there right
+now:
+
+### Message transfer
+
+`(post <routing-key> <message> <subscription-token>)` - Instructs the
+receiving node to route (or process) the given `message` according to
+the given `routing-key`. Different kinds of nodes will do different
+things here, and in particular, will interpret the routing key
+differently. Queues, for example, will ignore the routing key and will
+deliver the message to only one of their active subscribers, whereas
+exchanges will generally match the routing key against their active
+subscriptions and will deliver the message on to all matches.
+
+### Subscription management
+
+`(subscribe <routing-key-filter> <target-node> <target-routing-key>
+<reply-node> <reply-routing-key>)` - Instructs the receiving node to
+create a new subscription. The new subscription will only route
+messages matching the `routing-key-filter`, which is interpreted on a
+per-node-type basis as above for `routing-key`. Matching messages will
+be sent to `target-node` using `post!`, with a routing key of
+`target-routing-key`. The `reply-node` parameter, if nonempty,
+instructs the receiving node to send confirmation of subscription
+(along with a token that can be used with `unsubscribe` below) to the
+given address and routing key. If `reply-node` is empty, no
+confirmation of subscription is sent.
+
+`(unsubscribe <token>)` - Instructs the receiving node to delete a
+previously established subscription. The `token` comes from the
+`subscribe-ok` message sent to `reply-node` after a successful
+`subscribe` operation.
+
+### Object management
+
+`(create <class-name> <argument> <reply-node> <reply-routing-key>)` -
+Instructs the receiving object factory node to construct a new
+instance of the given `class-name`, with the given `argument` supplied
+to the constructor. The `reply-node` and `reply-routing-key` are used
+to send confirmation of completion to some waiting node.
+
+## Copyright and licensing
+
+Hop is Copyright 2010, 2011, 2012 Tony Garnock-Jones
+<tonygarnockjones@gmail.com>.
+
+Hop is free software: you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation, either version 3 of the License, or (at your
+option) any later version.
+
+Hop is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with Hop.  If not, see <http://www.gnu.org/licenses/>.

TODO

@@ -1,3 +0,0 @@
- - ui_relay.ml: deal with Message.Subscribe and .Unsubscribe as well as .Post in api_tap_sink
- - web: add cache control information to served responses
- - use lazy and Lazy.force where appropriate

_tags

@@ -1,3 +0,0 @@
-true: use_unix
-true: use_str
-true: thread

amqp_relay.ml

@@ -1,410 +0,0 @@
-(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
-
-(* This file is part of Hop. *)
-
-(* Hop is free software: you can redistribute it and/or modify it *)
-(* under the terms of the GNU General Public License as published by the *)
-(* Free Software Foundation, either version 3 of the License, or (at your *)
-(* option) any later version. *)
-
-(* Hop is distributed in the hope that it will be useful, but *)
-(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
-(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU *)
-(* General Public License for more details. *)
-
-(* You should have received a copy of the GNU General Public License *)
-(* along with Hop.  If not, see <http://www.gnu.org/licenses/>. *)
-
-open Unix
-open Printf
-open Thread
-open Amqp_spec
-open Amqp_wireformat
-
-type connection_t = {
-    peername: Unix.sockaddr;
-    mtx: Mutex.t;
-    cin: in_channel;
-    cout: out_channel;
-    name: Node.name;
-    mutable input_buf: string;
-    mutable output_buf: Buffer.t;
-    mutable frame_max: int;
-    mutable connection_closed: bool;
-    mutable recent_queue_name: Node.name option;
-    mutable delivery_tag: int
-  }
-
-let initial_frame_size = frame_min_size
-let suggested_frame_max = 131072
-
-let amqp_boot (peername, mtx, cin, cout) = {
-  peername = peername;
-  mtx = mtx;
-  cin = cin;
-  cout = cout;
-  name = Node.name_of_string (Uuid.create ());
-  input_buf = String.create initial_frame_size;
-  output_buf = Buffer.create initial_frame_size;
-  frame_max = initial_frame_size;
-  connection_closed = false;
-  recent_queue_name = None;
-  delivery_tag = 1 (* Not 0: 0 means "all deliveries" in an ack *)
-}
-
-let read_frame conn =
-  let frame_type = input_byte conn.cin in
-  let channel_hi = input_byte conn.cin in
-  let channel_lo = input_byte conn.cin in
-  let channel = (channel_hi lsr 8) lor channel_lo in
-  let length = input_binary_int conn.cin in
-  if length > conn.frame_max
-  then die frame_error "Frame longer than current frame_max"
-  else
-    (really_input conn.cin conn.input_buf 0 length;
-     if input_byte conn.cin <> frame_end
-     then die frame_error "Missing frame_end octet"
-     else (frame_type, channel, length))
-
-let write_frame conn frame_type channel =
-  output_byte conn.cout frame_type;
-  output_byte conn.cout ((channel lsr 8) land 255);
-  output_byte conn.cout (channel land 255);
-  output_binary_int conn.cout (Buffer.length conn.output_buf);
-  Buffer.output_buffer conn.cout conn.output_buf;
-  Buffer.reset conn.output_buf;
-  output_byte conn.cout frame_end
-
-let serialize_method buf m =
-  let (class_id, method_id) = method_index m in
-  write_short buf class_id;
-  write_short buf method_id;
-  write_method m buf
-
-let deserialize_method buf =
-  let class_id = read_short buf in
-  let method_id = read_short buf in
-  read_method class_id method_id buf
-
-let serialize_header buf body_size p =
-  let class_id = class_index p in
-  write_short buf class_id;
-  write_short buf 0;
-  write_longlong buf (Int64.of_int body_size);
-  write_properties p buf
-
-let deserialize_header buf =
-  let class_id = read_short buf in
-  let _ = read_short buf in
-  let body_size = Int64.to_int (read_longlong buf) in
-  (body_size, read_properties class_id buf)
-
-let send_content_body conn channel body =
-  let len = String.length body in
-  let rec send_remainder offset =
-    if offset >= len
-    then ()
-    else
-      let snip_len = min conn.frame_max (len - offset) in
-      Buffer.add_substring conn.output_buf body offset snip_len;
-      write_frame conn frame_body channel;
-      send_remainder (offset + snip_len)
-  in send_remainder 0
-
-let next_frame conn required_type =
-  let (frame_type, channel, length) = read_frame conn in
-  if frame_type <> required_type
-  then die command_invalid (Printf.sprintf "Unexpected frame type %d" frame_type)
-  else (channel, length)
-
-let next_method conn =
-  let (channel, length) = next_frame conn frame_method in
-  (channel, deserialize_method (Ibuffer.create conn.input_buf 0 length))
-
-let next_header conn =
-  let (channel, length) = next_frame conn frame_header in
-  (channel, deserialize_header (Ibuffer.create conn.input_buf 0 length))
-
-let recv_content_body conn body_size =
-  let buf = Buffer.create body_size in
-  while Buffer.length buf < body_size do
-    let (_, length) = next_frame conn frame_body in
-    Buffer.add_substring buf conn.input_buf 0 length
-  done;
-  Buffer.contents buf
-
-let with_conn_mutex conn thunk = Util.with_mutex0 conn.mtx thunk
-
-let send_method conn channel m =
-  with_conn_mutex conn (fun () ->
-    serialize_method conn.output_buf m;
-    write_frame conn frame_method channel;
-    flush conn.cout)
-
-let send_content_method conn channel m p body_str =
-  with_conn_mutex conn (fun () ->
-    serialize_method conn.output_buf m;
-    write_frame conn frame_method 1;
-    serialize_header conn.output_buf (String.length body_str) p;
-    write_frame conn frame_header 1;
-    send_content_body conn 1 body_str;
-    flush conn.cout)
-
-let send_error conn code message =
-  if conn.connection_closed
-  then
-    ()
-  else
-    conn.connection_closed <- true;
-    let m = Connection_close (code, message, 0, 0) in
-    Log.warn "Sending error" [sexp_of_method m];
-    send_method conn 0 m
-
-let send_warning conn code message =
-  let m = Channel_close (code, message, 0, 0) in
-  Log.warn "Sending warning" [sexp_of_method m];
-  send_method conn 1 m
-
-let issue_banner cin cout =
-  let handshake = String.create 8 in
-  try
-    really_input cin handshake 0 8;
-    if String.sub handshake 0 4 <> "AMQP"
-    then (output_string cout "AMQP\000\000\009\001"; false)
-    else true
-  with End_of_file -> false
-
-let reference_to_logs = "See server logs for details"
-let extract_str v =
-  match v with
-  | Sexp.Str s -> s
-  | _ -> reference_to_logs
-
-let reply_to_declaration conn status ok_fn =
-  match Message.message_of_sexp status with
-  | Message.Create_ok info ->
-      send_method conn 1 (ok_fn info)
-  | Message.Create_failed reason ->
-      (match reason with
-      | Sexp.Arr [Sexp.Str "factory"; Sexp.Str "class-not-found"] ->
-	  send_error conn command_invalid "Object type not supported by server"
-      | Sexp.Arr [Sexp.Str "constructor"; Sexp.Str "class-mismatch"] ->
-	  send_error conn not_allowed "Redeclaration with different object type not permitted"
-      | Sexp.Arr [Sexp.Str who; explanation] ->
-	  send_warning conn precondition_failed (who^" failed: "^(extract_str explanation))
-      | _ ->
-	  send_warning conn precondition_failed reference_to_logs)
-  | _ -> die internal_error "Declare reply malformed"
-
-let make_queue_declare_ok info =
-  match info with
-  | Sexp.Str queue_name -> Queue_declare_ok (queue_name, Int32.zero, Int32.zero)
-  | _ -> die internal_error "Unusable queue name in declare response"
-
-let send_delivery conn consumer_tag body_sexp =
-  match body_sexp with
-  | Sexp.Hint {Sexp.hint = Sexp.Str "amqp";
-	       Sexp.body = Sexp.Arr [Sexp.Str exchange;
-				     Sexp.Str routing_key;
-				     properties_sexp;
-				     Sexp.Str body_str]} ->
-      let tag = with_conn_mutex conn (fun () ->
-	let v = conn.delivery_tag in conn.delivery_tag <- v + 1; v)
-      in
-      send_content_method conn 1
-	(Basic_deliver (consumer_tag, Int64.of_int tag, false, exchange, routing_key))
-	(properties_of_sexp basic_class_id properties_sexp)
-	body_str
-  | _ -> die internal_error "Malformed AMQP message body sexp"
-
-let amqp_handler conn n m_sexp =
-  try
-    (match Message.message_of_sexp m_sexp with
-    | Message.Post (Sexp.Str "Exchange_declare_reply", status, _) ->
-	reply_to_declaration conn status (fun (_) -> Exchange_declare_ok)
-    | Message.Post (Sexp.Str "Queue_declare_reply", status, _) ->
-	reply_to_declaration conn status make_queue_declare_ok
-    | Message.Post (Sexp.Str "Queue_bind_reply", status, _) ->
-	(match Message.message_of_sexp status with
-	| Message.Subscribe_ok _ -> send_method conn 1 Queue_bind_ok
-	| _ -> die internal_error "Queue bind reply malformed")
-    | Message.Post (Sexp.Arr [Sexp.Str "Basic_consume_reply"; Sexp.Str consumer_tag], status, _) ->
-	(match Message.message_of_sexp status with
-	| Message.Subscribe_ok _ -> send_method conn 1 (Basic_consume_ok consumer_tag)
-	| _ -> die internal_error "Basic consume reply malformed")
-    | Message.Post (Sexp.Arr [Sexp.Str "delivery"; Sexp.Str consumer_tag], body, _) ->
-	send_delivery conn consumer_tag body
-    | _ ->
-	Log.warn "AMQP outbound relay ignoring message" [m_sexp])
-  with
-  | Amqp_exception (code, message) ->
-      send_error conn code message
-  | exn ->
-      send_error conn internal_error "";
-      raise exn
-
-let get_recent_queue_name conn =
-  match conn.recent_queue_name with
-  | Some q -> q
-  | None -> die syntax_error "Attempt to use nonexistent most-recently-declared-queue name"
-
-let expand_mrdq conn queue =
-  match queue with
-  | "" -> get_recent_queue_name conn
-  | other -> Node.name_of_string other
-
-let handle_method conn channel m =
-  if channel > 1 then die channel_error "Unsupported channel number" else ();
-  match m with
-  | Connection_close (code, text, _, _) ->
-      Log.info "Client closed AMQP connection" [Sexp.Str (string_of_int code); Sexp.Str text];
-      send_method conn channel Connection_close_ok;
-      conn.connection_closed <- true
-  | Channel_open ->
-      conn.delivery_tag <- 1;
-      send_method conn channel Channel_open_ok
-  | Channel_close (code, text, _, _) ->
-      Log.info "Client closed AMQP channel" [Sexp.Str (string_of_int code); Sexp.Str text];
-      send_method conn channel Channel_close_ok;
-  | Channel_close_ok ->
-      ()
-  | Exchange_declare (exchange, type_, passive, durable, no_wait, arguments) ->
-      Node.send_ignore' "factory" (Message.create (Sexp.Str type_,
-						   Sexp.Arr [Sexp.Str exchange],
-						   Sexp.Str conn.name.Node.label,
-						   Sexp.Str "Exchange_declare_reply"))
-  | Queue_declare (queue, passive, durable, exclusive, auto_delete, no_wait, arguments) ->
-      let queue = (if queue = "" then Uuid.create () else queue) in
-      conn.recent_queue_name <- Some (Node.name_of_string queue);
-      Node.send_ignore' "factory" (Message.create (Sexp.Str "queue",
-						   Sexp.Arr [Sexp.Str queue],
-						   Sexp.Str conn.name.Node.label,
-						   Sexp.Str "Queue_declare_reply"))
-  | Queue_bind (queue, exchange, routing_key, no_wait, arguments) ->
-      let queue = expand_mrdq conn queue in
-      if not (Node.approx_exists queue)
-      then send_warning conn not_found ("Queue "^queue.Node.label^" not found")
-      else
-	if Node.send' exchange (Message.subscribe (Sexp.Str routing_key,
-						   Sexp.Str queue.Node.label,
-						   Sexp.Str "",
-						   Sexp.Str conn.name.Node.label,
-						   Sexp.Str "Queue_bind_reply"))
-	then ()
-	else send_warning conn not_found ("Exchange "^exchange^" not found")
-  | Basic_consume (queue, consumer_tag, no_local, no_ack, exclusive, no_wait, arguments) ->
-      let queue = expand_mrdq conn queue in
-      let consumer_tag = (if consumer_tag = "" then Uuid.create () else consumer_tag) in
-      if Node.send queue (Message.subscribe
-			    (Sexp.Str "",
-			     Sexp.Str conn.name.Node.label,
-			     Sexp.Arr [Sexp.Str "delivery"; Sexp.Str consumer_tag],
-			     Sexp.Str conn.name.Node.label,
-			     Sexp.Arr [Sexp.Str "Basic_consume_reply"; Sexp.Str consumer_tag]))
-      then ()
-      else send_warning conn not_found ("Queue "^queue.Node.label^" not found")
-  | Basic_publish (exchange, routing_key, false, false) ->
-      let (_, (body_size, properties)) = next_header conn in
-      let body = recv_content_body conn body_size in
-      if Node.post' exchange
-	  (Sexp.Str routing_key)
-	  (Sexp.Hint {Sexp.hint = Sexp.Str "amqp";
-		      Sexp.body = Sexp.Arr [Sexp.Str exchange;
-					    Sexp.Str routing_key;
-					    sexp_of_properties properties;
-					    Sexp.Str body]})
-	  (Sexp.Str "")
-      then ()
-      else send_warning conn not_found ("Exchange "^exchange^" not found")
-  | Basic_ack (delivery_tag, multiple) ->
-      ()
-  | _ ->
-      let (cid, mid) = method_index m in
-      die not_implemented (Printf.sprintf "Unsupported method (or method arguments) %s"
-			     (method_name cid mid))
-
-let server_properties = table_of_list [
-  ("product", Table_string App_info.product);
-  ("version", Table_string App_info.version);
-  ("copyright", Table_string App_info.copyright);
-  ("licence", Table_string App_info.licence_blurb);
-  ("capabilities", Table_table (table_of_list []));
-]
-
-let check_login_details mechanism response =
-  match mechanism with
-  | "PLAIN" ->
-      (match (Str.split (Str.regexp "\000") response) with
-      | ["guest"; "guest"] -> ()
-      | _ -> die access_refused "Access refused")
-  | "AMQPLAIN" ->
-      (let fields = decode_named_fields (Ibuffer.of_string response) in
-      match (field_lookup_some "LOGIN" fields, field_lookup_some "PASSWORD" fields) with
-      | (Some (Table_string "guest"), Some (Table_string "guest")) -> ()
-      | _ -> die access_refused "Access refused")
-  | _ -> die access_refused  "Bad auth mechanism"
-
-let tune_connection conn frame_max =
-  with_conn_mutex conn (fun () ->
-    conn.input_buf <- String.create frame_max;
-    conn.output_buf <- Buffer.create frame_max;
-    conn.frame_max <- frame_max)
-
-let handshake_and_tune conn =
-  let (major_version, minor_version, revision) = version in
-  send_method conn 0 (Connection_start (major_version, minor_version, server_properties,
-					"PLAIN AMQPLAIN", "en_US"));
-  let (client_properties, mechanism, response, locale) =
-    match next_method conn with
-    | (0, Connection_start_ok props) -> props
-    | _ -> die not_allowed "Expected Connection_start_ok on channel 0"
-  in
-  check_login_details mechanism response;
-  Log.info "Connection from AMQP client" [sexp_of_table client_properties];
-  send_method conn 0 (Connection_tune (1, Int32.of_int suggested_frame_max, 0));
-  let (channel_max, frame_max, heartbeat) =
-    match next_method conn with
-    | (0, Connection_tune_ok props) -> props
-    | _ -> die not_allowed "Expected Connection_tune_ok on channel 0"
-  in
-  if channel_max > 1
-  then die not_implemented "Channel numbers higher than 1 are not supported" else ();
-  if (Int32.to_int frame_max) > suggested_frame_max
-  then die syntax_error "Requested frame max too large" else ();
-  if heartbeat > 0
-  then die not_implemented "Heartbeats not yet implemented (patches welcome)" else ();
-  tune_connection conn (Int32.to_int frame_max);
-  let (virtual_host) =
-    match next_method conn with
-    | (0, Connection_open props) -> props
-    | _ -> die not_allowed "Expected Connection_open on channel 0"
-  in
-  Log.info "Connected to vhost" [Sexp.Str virtual_host];
-  send_method conn 0 Connection_open_ok
-
-let amqp_mainloop conn n =
-  Node.bind_ignore (conn.name, n);
-  (try
-    handshake_and_tune conn;
-    while not conn.connection_closed do
-      let (channel, m) = next_method conn in
-      handle_method conn channel m
-    done
-  with
-  | Amqp_exception (code, message) ->
-      send_error conn code message
-  )
-
-let start (s, peername) =
-  Connections.start_connection "amqp" issue_banner
-    amqp_boot amqp_handler amqp_mainloop (s, peername)
-
-let init () =
-  Node.send_ignore' "factory" (Message.create (Sexp.Str "direct",
-					       Sexp.Arr [Sexp.Str "amq.direct"],
-					       Sexp.Str "", Sexp.Str ""));
-  Node.send_ignore' "factory" (Message.create (Sexp.Str "fanout",
-					       Sexp.Arr [Sexp.Str "amq.fanout"],
-					       Sexp.Str "", Sexp.Str ""));
-  ignore (Util.create_daemon_thread
-	    "AMQP listener" None (Net.start_net "AMQP" Amqp_spec.port) start)

connections.ml

@@ -1,80 +0,0 @@
-(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
-
-(* This file is part of Hop. *)
-
-(* Hop is free software: you can redistribute it and/or modify it *)
-(* under the terms of the GNU General Public License as published by the *)
-(* Free Software Foundation, either version 3 of the License, or (at your *)
-(* option) any later version. *)
-
-(* Hop is distributed in the hope that it will be useful, but *)
-(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
-(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU *)
-(* General Public License for more details. *)
-
-(* You should have received a copy of the GNU General Public License *)
-(* along with Hop.  If not, see <http://www.gnu.org/licenses/>. *)
-
-open Unix
-open Printf
-open Thread
-open Sexp
-
-let connection_mtx = Mutex.create ()
-let connection_count = ref 0
-
-let endpoint_name n =
-  match n with
-  | ADDR_INET (host, port) -> sprintf "%s:%d" (string_of_inet_addr host) port
-  | _ -> "??unknown??"
-
-let flush_output mtx flush_control cout =
-  let rec loop () =
-    match Event.poll (Event.receive flush_control) with
-    | Some () -> ()
-    | None ->
-	let ok = Util.with_mutex0 mtx (fun () -> try flush cout; true with _ -> false) in
-	if ok then (Thread.delay 0.1; loop ()) else ()
-  in loop ()
-
-let connection_main class_name peername cin cout issue_banner boot_fn node_fn mainloop =
-  Log.info ("Accepted "^class_name) [Str (endpoint_name peername)];
-  if issue_banner cin cout
-  then
-    let mtx = Mutex.create () in
-    let flush_control = Event.new_channel () in
-    ignore (Util.create_thread (endpoint_name peername ^ " flush") None
-	      (flush_output mtx flush_control) cout);
-    let shared_state = boot_fn (peername, mtx, cin, cout) in
-    let n = Node.make class_name (node_fn shared_state) in
-    (try
-      mainloop shared_state n
-    with
-    | End_of_file ->
-	Log.info ("Disconnecting "^class_name^" normally") [Str (endpoint_name peername)]
-    | Sys_error message ->
-	Log.warn ("Disconnected "^class_name^" by Sys_error")
-	  [Str (endpoint_name peername); Str message]
-    | exn ->
-	Log.error ("Uncaught exception in "^class_name) [Str (Printexc.to_string exn)]
-    );
-    Node.unbind_all n;
-    Event.sync (Event.send flush_control ())
-  else
-    Log.error ("Disconnected "^class_name^" by failed initial handshake") []
-
-let start_connection' class_name issue_banner boot_fn node_fn mainloop (s, peername) =
-  let cin = in_channel_of_descr s in
-  let cout = out_channel_of_descr s in
-  Util.with_mutex0 connection_mtx (fun () -> connection_count := !connection_count + 1);
-  connection_main class_name peername cin cout issue_banner boot_fn node_fn mainloop;
-  Util.with_mutex0 connection_mtx (fun () -> connection_count := !connection_count - 1);
-  (try flush cout with _ -> ());
-  close s
-
-let start_connection class_name issue_banner boot_fn node_fn mainloop (s, peername) =
-  Util.create_thread
-    (endpoint_name peername ^ " input")
-    None
-    (start_connection' class_name issue_banner boot_fn node_fn mainloop)
-    (s, peername)

directnode.ml

@@ -1,93 +0,0 @@
-(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
-
-(* This file is part of Hop. *)
-
-(* Hop is free software: you can redistribute it and/or modify it *)
-(* under the terms of the GNU General Public License as published by the *)
-(* Free Software Foundation, either version 3 of the License, or (at your *)
-(* option) any later version. *)
-
-(* Hop is distributed in the hope that it will be useful, but *)
-(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
-(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU *)
-(* General Public License for more details. *)
-
-(* You should have received a copy of the GNU General Public License *)
-(* along with Hop.  If not, see <http://www.gnu.org/licenses/>. *)
-
-open Sexp
-open Datastructures
-open Status
-
-type t = {
-    name: Node.name;
-    subscriptions: Subscription.set_t;
-    mtx: Mutex.t;
-    mutable routing_table: UuidSet.t StringMap.t;
-  }
-
-let classname = "direct"
-
-let unsubscribe info uuid =
-  Util.with_mutex0 info.mtx
-    (fun () ->
-      match Subscription.delete info.name info.subscriptions uuid with
-      | Some sub ->
-	  (match sub.Subscription.filter with
-	  | Str binding_key ->
-	      (try
-		let old_set = StringMap.find binding_key info.routing_table in
-		let new_set = UuidSet.remove sub.Subscription.uuid old_set in
-		if UuidSet.is_empty new_set
-		then info.routing_table <- StringMap.remove binding_key info.routing_table
-		else info.routing_table <- StringMap.add binding_key new_set info.routing_table
-	      with Not_found ->
-		())
-	  | _ -> ())
-      | None -> ())
-
-let route_message info n sexp =
-  match Message.message_of_sexp sexp with
-  | Message.Post (Str name, body, token) ->
-      let routing_snapshot = info.routing_table in
-      let matching = (try StringMap.find name routing_snapshot with Not_found -> UuidSet.empty) in
-      UuidSet.iter
-	(fun (uuid) ->
-	  match Subscription.lookup info.subscriptions uuid with
-	  | Some sub ->
-	      ignore (Subscription.send_to_subscription' sub body (unsubscribe info))
-	  | None ->
-	      ())
-	matching
-  | Message.Subscribe (Str binding_key as filter, Str sink, name, Str reply_sink, reply_name) ->
-      Util.with_mutex0 info.mtx
-	(fun () ->
-	  let sub =
-	    Subscription.create
-	      info.name info.subscriptions filter sink name reply_sink reply_name in
-	  let old_set =
-	    (try StringMap.find binding_key info.routing_table with Not_found -> UuidSet.empty) in
-	  let new_set = UuidSet.add sub.Subscription.uuid old_set in
-	  info.routing_table <- StringMap.add binding_key new_set info.routing_table)
-  | Message.Unsubscribe (Str token) ->
-      unsubscribe info token
-  | m ->
-      Util.message_not_understood classname m
-
-let factory arg =
-  match arg with
-  | (Arr [Str name_str]) ->
-      let info = {
-	name = Node.name_of_string name_str;
-	subscriptions = Subscription.new_set ();
-	mtx = Mutex.create ();
-	routing_table = StringMap.empty;
-      } in
-      replace_ok
-	(Node.make_idempotent_named classname info.name (route_message info))
-	(Str name_str)
-  | _ ->
-      Problem (Str "bad-arg")
-
-let init () =
-  Factory.register_class classname factory

doc/hop.md

@@ -0,0 +1,196 @@
+# The Hop Pattern
+
+Hop is a combination of
+
+ - a syntax for encoding data for transport
+ - a subscription and messaging protocol
+ - a design for recursive networks
+
+In this document, I will sketch the third aspect of the system: the
+design for recursive networking.
+
+## Core idea: Abstract Networks
+
+Every virtual machine, TCP connection, overlay network, and other
+object in the system can be viewed abstractly as a communications
+network. This applies just as well to individual TCP connections and
+individual Java objects as it does to AMQP-style exchanges, brokers,
+and queues.
+
+This might not seem like an advantage, but in fact looking at things
+this way permits simple, regular composition of networks (and virtual
+machines, etc.).
+
+### Abstract Networks
+
+The idea of an abstract network that we will be using is this:
+
+A network is a *namespace* within which exist *nodes* which send
+*messages* that are addressed to other *names* in the network. Names
+are mapped back to nodes via a *directory* of some kind. Joining such
+a network is called *enrollment*: it is the process of, first,
+authenticating a node to the network, and second, *binding* of zero or
+more names in the namespace to the new node. These networks also have
+a *routing semantic*: when a message is sent to some name in the
+network, the network will have a characteristic way of using its
+directory to decide which, if any, nodes in the network should receive
+the message.
+
+### A TCP connection, viewed as an abstract network
+
+A single TCP connection can be seen as a network.
+
+ - the set of possible names is exactly `{client, server}`.
+ - joining the network and binding to names happens automatically as
+   part of the creation of the connection.
+ - messages sent by one party are implicitly delivered to the other
+   party.
+
+### A Java virtual machine instance, viewed as an abstract network
+
+A Java virtual machine and all its objects can be seen as a network.
+
+ - the set of possible names is the set of valid (live) pointers to
+   objects.
+ - joining the network and binding to names happens automatically each
+   time a new object is created.
+ - object names are (almost) capabilities.
+ - method calls, returns, and exceptions are the messages sent in the
+   system: calls are sent to object names, returns to continuation
+   names (transient and implicitly specified), and exceptions to
+   handler names (again implicitly specified).
+ - there is a built-in (and unavoidable) notion of *conversation
+   pattern* included in the semantic of this kind of network: each
+   method call message results in either a return message or an
+   exception message.
+
+### The world-wide UDP/IP network, viewed as an abstract network
+
+The entire collection of UDP/IP endpoints can be seen as an abstract
+network.
+
+ - the names are the `{ip, port}` pairs.
+ - joining the network and binding to a name happens in part via the
+   operation of DHCP (giving an IP address) and in part via, for
+   example, BSD sockets' `bind(2)` system call.
+ - messages sent in the system are just UDP packets.
+
+### An AMQP broker, viewed as an abstract network
+
+AMQP 0-9-1 brokers can be seen as abstract networks.
+
+ - the nodes are the exchanges, queues, consumers and active channels
+   in the broker.
+ - some nodes, namely queues and exchanges, join the network via the
+   operation of a broker-internal *factory* node.
+ - other nodes, namely channels and consumers, join the network via
+   connections from the outside world.
+ - name binding for nodes happens at the time they're created.
+
+### An AMQP "direct" exchange, viewed as an abstract network
+
+Exchanges within AMQP 0-9-1 brokers can be seen as abstract
+networks. For example, consider "direct"-style exchanges, though
+similar observations can be made of the other kinds of exchange
+defined by the AMQP specification:
+
+ - the names are the routing-keys to which queues have been bound.
+ - joining the network and binding to names is done via queue binding:
+   queues are the only nodes in AMQP that can join an exchange's
+   network.
+ - messages delivered to an exchange are routed using the exchange's
+   internal routing table (its directory) to zero or more bound
+   queues.
+
+## Bridging between abstract networks
+
+So far, I've mentioned two kinds of network: those where there is no
+explicit notion of a bridge to the outside world, such as individual
+TCP connections, Java virtual machine instances, and the worldwide
+UDP/IP network, and those where some explicit idea of connecting to
+other systems is present, such as AMQP brokers and exchanges.
+
+Considering UDP/IP for a moment, it's clear that the "layer 2"
+protocols underpinning UDP/IP act in some way as connections to other
+fragments of the worldwide network. Similarly, each TCP/IP connection
+has a kind of "border router" at each end embodied in the BSD sockets
+API that routes packets to and from the kernel's TCP stack. Finally,
+Java VM instances have a plethora of options for communicating with
+the outside world and permitting communications from the outside world
+to cause methods to be invoked on Java objects—that is, from the
+abstract point of view, to cause messages to be sent within the VM's
+internal network.
+
+((TODO: distinguish carefully between interior routers and border
+routers: the former glue together subnets of UDP/IP into a single
+worldwide namespace, for example, where the latter permit access to
+other namespaces, or even kinds of namespace, from a given
+network. The former implement a distributed directory and routing
+system, the latter embed entire networks as single nodes in a host
+network.))
+
+It seems clear that every kind of complete computing system has three aspects:
+
+ - a computation facility (which is how it does its job, whatever that may be)
+ - an internal communications facility (its network aspect)
+ - an external communications facility (routing of data to other systems/networks)
+
+The TCP connections that AMQP brokers accept, the bindings between
+AMQP exchanges and queues, the "consumer" relationships between AMQP
+queues and channels,
+
+### Abstract relays
+
+Abstract relays *embed* a remote network as a single node within a
+local network. Messages sent via local names to relay instances are
+transported uninterpreted across some underlying transport to the
+other network, where a corresponding relay instance interprets the
+messages being sent. A symmetric relay setup may also exist, which
+gives a *mutual embedding* of the two networks.
+
+## Core protocol
+
+`post`
+
+`subscribe`
+
+`unsubscribe`
+
+## Refinements
+
+Acknowledgement
+
+Lifetime-coupling
+
+## Frequently useful node classes
+
+Factory
+
+Relay (seen in many various guises)
+
+Exchange
+
+Queue/Buffer
+
+Consumer
+
+Broker (usually explicit only as part of a mutual embedding of a relay
+into a network)
+
+## Elements
+
+An implementation of the Hop pattern will include
+
+Codec
+
+relay
+
+classes
+
+nodes
+
+namespace and a dispatcher
+
+factory
+
+a notion of subscription, same as the notion of binding

experiments/cmsg/.gitignore

@@ -0,0 +1,5 @@
+*.o
+messages.h
+messages.c
+cmsg
+depend.mk

experiments/cmsg/Makefile

@@ -0,0 +1,53 @@
+TARGET = cmsg
+OBJECTS = main.o harness.o net.o util.o relay.o hashtable.o dataq.o sexp.o sexpio.o node.o \
+	queue.o direct.o fanout.o subscription.o meta.o messages.o
+
+UUID_CFLAGS:=$(shell uuid-config --cflags)
+UUID_LDFLAGS:=$(shell uuid-config --ldflags)
+
+ifeq ($(shell pkg-config --exists libevent && echo yes),yes)
+LIBEVENT_CFLAGS:=$(shell pkg-config --cflags libevent)
+LIBEVENT_LDFLAGS:=$(shell pkg-config --libs libevent)
+else
+LIBEVENT_CFLAGS:=
+LIBEVENT_LDFLAGS:=-levent
+endif
+
+# grr
+ifeq ($(shell uname -s),Darwin)
+UUID_LIB=uuid
+else
+UUID_LIB=ossp-uuid
+endif
+
+#CFLAGS = -D_XOPEN_SOURCE=600 -Wall -O0 -g $(UUID_CFLAGS) $(LIBEVENT_CFLAGS)
+CFLAGS = -D_XOPEN_SOURCE=600 -Wall -O3 $(UUID_CFLAGS) $(LIBEVENT_CFLAGS)
+#CFLAGS = -D_XOPEN_SOURCE=600 -Wall -O3 -static $(UUID_CFLAGS) $(LIBEVENT_CFLAGS)
+
+all: $(TARGET)
+
+$(TARGET): $(OBJECTS)
+	$(CC) $(CFLAGS) $(UUID_LDFLAGS) -o $@ $(OBJECTS) -l$(UUID_LIB) $(LIBEVENT_LDFLAGS)
+#	$(CC) $(CFLAGS) $(UUID_LDFLAGS) -o $@ $(OBJECTS) -l$(UUID_LIB) $(LIBEVENT_LDFLAGS) -lrt
+
+%.o: %.c
+	$(CC) $(CFLAGS) -c $<
+
+messages.c: ../../protocol/messages.json codegen.py
+	python codegen.py body > $@
+
+messages.h: ../../protocol/messages.json codegen.py
+	python codegen.py header > $@
+
+clean:
+	rm -f $(TARGET)
+	rm -f $(OBJECTS)
+	rm -rf *.dSYM
+	rm -f depend.mk messages.c messages.h
+
+depend.mk:
+	touch messages.h
+	gcc $(CFLAGS) -M *.c > $@
+	rm messages.h
+	echo "depend.mk:" Makefile *.c >> $@
+-include depend.mk

experiments/cmsg/cmsg_private.h

@@ -0,0 +1,55 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_private_h
+#define cmsg_private_h
+
+typedef struct cmsg_bytes_t {
+  size_t len;
+  unsigned char *bytes;
+} cmsg_bytes_t;
+
+#define CMSG_BYTES(length, bytes_ptr) ((cmsg_bytes_t) { \
+      .len = (length),					\
+      .bytes = (unsigned char *) (bytes_ptr)		\
+    })
+#define EMPTY_BYTES CMSG_BYTES(0, NULL)
+
+static inline cmsg_bytes_t cmsg_cstring_bytes(char const *cstr) {
+  cmsg_bytes_t result;
+  result.len = strlen(cstr);
+  result.bytes = (void *) cstr;
+  return result;
+}
+
+#define CMSG_UUID_BUF_SIZE 36
+extern int gen_uuid(unsigned char *uuid_buf); /* must be exactly CMSG_UUID_BUF_SIZE bytes long */
+
+extern cmsg_bytes_t cmsg_bytes_malloc_dup(cmsg_bytes_t src);
+extern cmsg_bytes_t cmsg_bytes_malloc(size_t amount);
+extern void cmsg_bytes_free(cmsg_bytes_t bytes);
+extern int cmsg_bytes_cmp(cmsg_bytes_t a, cmsg_bytes_t b);
+
+#define ICHECK(result, message) do { if ((result) == -1) { perror(message); exit(2); } } while (0)
+#define BCHECK(result, message) do { if ((result) == 0) { perror(message); exit(2); } } while (0)
+#define PCHECK(result, message) do { if ((result) == NULL) { perror(message); exit(2); } } while (0)
+
+extern __attribute__((noreturn)) void die(char const *format, ...);
+extern void warn(char const *format, ...);
+extern void info(char const *format, ...);
+
+#endif

experiments/cmsg/codegen.py

@@ -0,0 +1,129 @@
+from __future__ import with_statement
+
+## Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+##
+## This file is part of Hop.
+##
+## Hop is free software: you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+##
+## Hop is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+## or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+## License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+copyright_stmt = \
+'''/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+'''
+
+import sys
+import json
+
+def cify(s):
+    s = s.replace('-', '_')
+    s = s.replace(' ', '_')
+    return s
+
+class MessageType:
+    def __init__(self, j):
+        self.wire_selector = j['selector']
+        self.selector = cify(self.wire_selector)
+        self.wire_argnames = j['args']
+        self.argnames = map(cify, self.wire_argnames)
+
+    def format_args(self, template, separator = ', '):
+        return separator.join([template % (x,) for x in self.argnames])
+
+with file("../../protocol/messages.json") as f:
+    spec = map(MessageType, json.load(f)['definitions'])
+
+def entrypoint_header():
+    print copyright_stmt
+    print
+    print '#ifndef cmsg_messages_h'
+    print '#define cmsg_messages_h'
+    print
+    print 'extern void init_messages(void);'
+    print
+    for t in spec:
+        print 'extern sexp_t *selector_%s;' % (t.selector,)
+    print
+    for t in spec:
+        print 'extern sexp_t *message_%s(%s);' % (t.selector, t.format_args('sexp_t *%s'))
+    print
+    print 'typedef union parsed_message_t_ {'
+    for t in spec:
+        if t.argnames:
+            print '  struct { sexp_t %s; } %s;' % (t.format_args('*%s'), t.selector)
+    print '} parsed_message_t;'
+    for t in spec:
+        print
+        print 'static inline int parse_%s(sexp_t *message, parsed_message_t *out) {' % \
+            (t.selector,)
+        print '  if (!sexp_pairp(message)) return 0;'
+        print '  if (sexp_cmp(sexp_head(message), selector_%s) != 0) return 0;' % (t.selector,)
+        for n in t.argnames:
+            print '  if (!sexp_pseudo_pop(&message)) return 0;'
+            print '  out->%s.%s = sexp_head(message);' % (t.selector, n)
+        print '  return sexp_tail(message) == NULL;'
+        print '}'
+    print
+    print '#endif'
+
+def entrypoint_body():
+    print copyright_stmt
+    print
+    print '#include <stdlib.h>'
+    print '#include <string.h>'
+    print '#include <stdio.h>'
+    print '#include <signal.h>'
+    print
+    print '#include <assert.h>'
+    print
+    print '#include "cmsg_private.h"'
+    print '#include "ref.h"'
+    print '#include "sexp.h"'
+    print '#include "messages.h"'
+    print
+    for t in spec:
+        print 'sexp_t *selector_%s = NULL;' % (t.selector,)
+    print
+    print 'void init_messages(void) {'
+    for t in spec:
+        print '  selector_%s = sexp_cstring("%s");' % (t.selector, t.wire_selector)
+    for t in spec:
+        print '  INCREF(selector_%s);' % (t.selector,)
+    print '}'
+    for t in spec:
+        print
+        print 'sexp_t *message_%s(%s) {' % (t.selector, t.format_args('sexp_t *%s'))
+        print '  sexp_t *m = NULL;'
+        for n in reversed(t.argnames):
+            print '  m = sexp_cons(%s, m);' % (n,)
+        print '  return sexp_cons(selector_%s, m);' % (t.selector,)
+        print '}'
+
+if __name__ == '__main__':
+    drivername = sys.argv[1]
+    globals()['entrypoint_' + drivername]()

experiments/cmsg/dataq.c

@@ -0,0 +1,66 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <assert.h>
+
+#include "dataq.h"
+
+#define QLINK(q,x)	(*((void **)(((char *) x) + (q)->link_offset)))
+
+void enqueue(queue_t *q, void *x) {
+  QLINK(q, x) = NULL;
+  if (q->head == NULL) {
+    q->head = x;
+  } else {
+    QLINK(q, q->tail) = x;
+  }
+  q->tail = x;
+  q->count++;
+}
+
+void *dequeue(queue_t *q) {
+  if (q->head == NULL) {
+    return NULL;
+  } else {
+    void *x = q->head;
+    q->head = QLINK(q, x);
+    QLINK(q, x) = NULL;
+    if (q->head == NULL) {
+      q->tail = NULL;
+    }
+    q->count--;
+    return x;
+  }
+}
+
+void queue_append(queue_t *q1, queue_t *q2) {
+  assert(q1->link_offset == q2->link_offset);
+
+  if (q2->head != NULL) {
+    if (q1->head != NULL) {
+      QLINK(q1, q1->tail) = q2->head;
+    } else {
+      q1->head = q2->head;
+    }
+    q1->tail = q2->tail;
+    q2->head = NULL;
+    q2->tail = NULL;
+  }
+}

experiments/cmsg/dataq.h

@@ -0,0 +1,36 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_dataq_h
+#define cmsg_dataq_h
+
+typedef struct queue_t_ {
+  size_t link_offset;
+  int count;
+  void *head;
+  void *tail;
+} queue_t;
+
+#define EMPTY_QUEUE(element_t, link_field_name) \
+  ((queue_t) { offsetof(element_t, link_field_name), 0, NULL, NULL })
+
+extern void enqueue(queue_t *q, void *x);
+extern void *dequeue(queue_t *q);
+
+extern void queue_append(queue_t *q1, queue_t *q2);
+
+#endif

experiments/cmsg/direct.c

@@ -0,0 +1,125 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <errno.h>
+#include <stdint.h>
+#include <stddef.h>
+
+#include <assert.h>
+
+#include <ucontext.h>
+
+#include "cmsg_private.h"
+#include "harness.h"
+#include "ref.h"
+#include "sexp.h"
+#include "hashtable.h"
+#include "node.h"
+#include "messages.h"
+#include "subscription.h"
+#include "sexpio.h"
+
+typedef struct direct_extension_t_ {
+  sexp_t *name;
+  hashtable_t routing_table;
+  hashtable_t subscriptions;
+} direct_extension_t;
+
+static sexp_t *direct_extend(node_t *n, sexp_t *args) {
+  if ((sexp_length(args) == 1) && sexp_stringp(sexp_head(args))) {
+    cmsg_bytes_t name = sexp_data(sexp_head(args));
+    direct_extension_t *d = calloc(1, sizeof(*d));
+    d->name = INCREF(sexp_head(args));
+    init_hashtable(&d->routing_table, 5, NULL, NULL);
+    init_hashtable(&d->subscriptions, 5, NULL, NULL);
+
+    n->extension = d;
+    return bind_node(name, n) ? NULL : sexp_cstring("bind failed");
+  } else {
+    return sexp_cstring("invalid args");
+  }
+}
+
+static void free_direct_chain(void *context, cmsg_bytes_t key, void *value) {
+  free_subscription_chain(value);
+}
+
+static void direct_destructor(node_t *n) {
+  direct_extension_t *d = n->extension;
+  if (d != NULL) { /* can be NULL if direct_extend was given invalid args */
+    DECREF(d->name, sexp_destructor);
+    hashtable_foreach(&d->routing_table, free_direct_chain, NULL);
+    destroy_hashtable(&d->routing_table);
+    destroy_hashtable(&d->subscriptions);
+    free(d);
+  }
+}
+
+static void route_message(direct_extension_t *d, sexp_t *rk, sexp_t *body) {
+  subscription_t *chain = NULL;
+  subscription_t *newchain;
+  hashtable_get(&d->routing_table, sexp_data(rk), (void **) &chain);
+  newchain = send_to_subscription_chain(d->name, &d->subscriptions, chain, body);
+  if (newchain != chain) {
+    hashtable_put(&d->routing_table, sexp_data(rk), newchain);
+  }
+}
+
+static void direct_handle_message(node_t *n, sexp_t *m) {
+  direct_extension_t *d = n->extension;
+  parsed_message_t p;
+
+  if (parse_post(m, &p)) {
+    if (sexp_stringp(p.post.name)) {
+      route_message(d, p.post.name, p.post.body);
+    } else {
+      warn("Non-string routing key in direct\n");
+    }
+    return;
+  }
+
+  if (parse_subscribe(m, &p)) {
+    subscription_t *sub = handle_subscribe_message(d->name, &d->subscriptions, &p);
+    if (sub != NULL) {
+      hashtable_get(&d->routing_table, sexp_data(p.subscribe.filter), (void **) &sub->link);
+      hashtable_put(&d->routing_table, sexp_data(p.subscribe.filter), sub);
+    }
+    return;
+  }
+
+  if (parse_unsubscribe(m, &p)) {
+    handle_unsubscribe_message(d->name, &d->subscriptions, &p);
+    return;
+  }
+
+  warn("Message not understood in direct: ");
+  sexp_writeln(stderr_h, m);
+}
+
+static node_class_t direct_class = {
+  .name = "direct",
+  .extend = direct_extend,
+  .destroy = direct_destructor,
+  .handle_message = direct_handle_message
+};
+
+void init_direct(void) {
+  register_node_class(&direct_class);
+}

experiments/cmsg/direct.h

@@ -0,0 +1,23 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_direct_h
+#define cmsg_direct_h
+
+extern void init_direct(void);
+
+#endif

experiments/cmsg/fanout.c

@@ -0,0 +1,113 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <errno.h>
+#include <stdint.h>
+#include <stddef.h>
+
+#include <assert.h>
+
+#include <ucontext.h>
+
+#include "cmsg_private.h"
+#include "harness.h"
+#include "ref.h"
+#include "sexp.h"
+#include "hashtable.h"
+#include "node.h"
+#include "messages.h"
+#include "subscription.h"
+#include "sexpio.h"
+
+typedef struct fanout_extension_t_ {
+  sexp_t *name;
+  hashtable_t subscriptions;
+} fanout_extension_t;
+
+static sexp_t *fanout_extend(node_t *n, sexp_t *args) {
+  if ((sexp_length(args) == 1) && sexp_stringp(sexp_head(args))) {
+    cmsg_bytes_t name = sexp_data(sexp_head(args));
+    fanout_extension_t *f = calloc(1, sizeof(*f));
+    f->name = INCREF(sexp_head(args));
+    init_hashtable(&f->subscriptions, 5, NULL, (void (*)(void *)) free_subscription);
+
+    n->extension = f;
+    return bind_node(name, n) ? NULL : sexp_cstring("bind failed");
+  } else {
+    return sexp_cstring("invalid args");
+  }
+}
+
+static void fanout_destructor(node_t *n) {
+  fanout_extension_t *f = n->extension;
+  if (f != NULL) { /* can be NULL if fanout_extend was given invalid args */
+    DECREF(f->name, sexp_destructor);
+    destroy_hashtable(&f->subscriptions);
+    free(f);
+  }
+}
+
+struct delivery_context {
+  fanout_extension_t *f;
+  sexp_t *body;
+};
+
+static void send_to_sub(void *contextv, cmsg_bytes_t key, void *subv) {
+  struct delivery_context *context = contextv;
+  subscription_t *sub = subv;
+  send_to_subscription(context->f->name, &context->f->subscriptions, sub, context->body);
+}
+
+static void fanout_handle_message(node_t *n, sexp_t *m) {
+  fanout_extension_t *f = n->extension;
+  parsed_message_t p;
+
+  if (parse_post(m, &p)) {
+    struct delivery_context context;
+    context.f = f;
+    context.body = p.post.body;
+    hashtable_foreach(&f->subscriptions, send_to_sub, &context);
+    return;
+  }
+
+  if (parse_subscribe(m, &p)) {
+    handle_subscribe_message(f->name, &f->subscriptions, &p);
+    return;
+  }
+
+  if (parse_unsubscribe(m, &p)) {
+    handle_unsubscribe_message(f->name, &f->subscriptions, &p);
+    return;
+  }
+
+  warn("Message not understood in fanout: ");
+  sexp_writeln(stderr_h, m);
+}
+
+static node_class_t fanout_class = {
+  .name = "fanout",
+  .extend = fanout_extend,
+  .destroy = fanout_destructor,
+  .handle_message = fanout_handle_message
+};
+
+void init_fanout(void) {
+  register_node_class(&fanout_class);
+}

experiments/cmsg/fanout.h

@@ -0,0 +1,23 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_fanout_h
+#define cmsg_fanout_h
+
+extern void init_fanout(void);
+
+#endif

experiments/cmsg/harness.c

@@ -0,0 +1,334 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <stddef.h>
+#include <errno.h>
+
+#include <sys/time.h>
+
+#include <ucontext.h>
+
+typedef unsigned char u_char;
+#include <event.h>
+
+#include "cmsg_private.h"
+#include "harness.h"
+#include "dataq.h"
+
+#include <assert.h>
+
+/* What is a sane value for STACK_SIZE? */
+#ifdef __APPLE__
+/* Bollocks. Looks like OS X chokes unless STACK_SIZE is a multiple of 32k. */
+# include <AvailabilityMacros.h>
+# if !defined(MAC_OS_X_VERSION_10_6) || MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_6
+/* Hmm, and looks like 10.5 has more aggressive stack requirements than 10.6. */
+#  define STACK_SIZE 65536
+# else
+#  define STACK_SIZE 32768
+# endif
+#elif linux
+# define STACK_SIZE 32768
+#else
+# error Define STACK_SIZE for your platform. It should probably not be less than 32k?
+#endif
+
+/* TODO: reuse stacks (via a freelist) */
+/* TODO: investigate avoiding syscall in swapcontext, setcontext etc. */
+
+IOHandle *stdin_h = NULL;
+IOHandle *stdout_h = NULL;
+IOHandle *stderr_h = NULL;
+
+static volatile int harness_running = 1;
+Process *current_process = NULL;
+
+#define EMPTY_PROCESS_QUEUE EMPTY_QUEUE(Process, link)
+
+static ucontext_t scheduler;
+static queue_t runlist = EMPTY_PROCESS_QUEUE;
+static queue_t deadlist = EMPTY_PROCESS_QUEUE;
+
+static void enqueue_runlist(Process *p) {
+  p->state = PROCESS_RUNNING;
+  enqueue(&runlist, p);
+}
+
+static void schedule(void) {
+  //info("schedule %p\n", current_process);
+  if (current_process == NULL) {
+    ICHECK(setcontext(&scheduler), "schedule setcontext");
+  } else {
+    ICHECK(swapcontext(&current_process->context, &scheduler), "schedule swapcontext");
+  }
+}
+
+void yield(void) {
+  enqueue_runlist(current_process);
+  schedule();
+}
+
+void killproc(void) {
+  assert(current_process->state == PROCESS_RUNNING);
+  current_process->state = PROCESS_DEAD;
+  enqueue(&deadlist, current_process);
+  current_process = NULL;
+  schedule();
+}
+
+void suspend(void) {
+  assert(current_process->state == PROCESS_RUNNING);
+  current_process->state = PROCESS_WAITING;
+  schedule();
+}
+
+int resume(Process *p) {
+  if (p->state == PROCESS_WAITING) {
+    enqueue_runlist(p);
+    return 0;
+  } else {
+    return -1;
+  }
+}
+
+static void driver(void (*f)(void *), void *arg) {
+  f(arg);
+  killproc();
+}
+
+Process *spawn(void (*f)(void *), void *arg) {
+  Process *p = calloc(1, sizeof(*p));
+  PCHECK(p, "spawn calloc");
+
+  p->state = PROCESS_DEAD;
+
+  p->stack_base = malloc(STACK_SIZE);
+  PCHECK(p->stack_base, "stack pointer malloc");
+
+  ICHECK(getcontext(&p->context), "spawn getcontext");
+  p->context.uc_link = NULL;
+  p->context.uc_stack.ss_sp = p->stack_base;
+  p->context.uc_stack.ss_size = STACK_SIZE;
+  p->context.uc_stack.ss_flags = 0;
+  makecontext(&p->context, (void (*)(void)) driver, 2, f, arg);
+
+  p->link = NULL;
+
+  enqueue_runlist(p);
+
+  return p;
+}
+
+typedef struct nap_context_t_ {
+  Process *p;
+  int timeout_fired;
+} nap_context_t;
+
+void nap_isr(int fd, short what, void *arg) {
+  nap_context_t *context = arg;
+  //info("nap_isr %p\n", p);
+  if ((context->p->state == PROCESS_WAITING) && (context->p->wait_flags & EV_TIMEOUT)) {
+    context->timeout_fired = 1;
+    enqueue_runlist(context->p);
+  }
+}
+
+int nap(long millis) {
+  struct event ev;
+  struct timeval tv;
+  nap_context_t context;
+  assert(current_process != NULL);
+  assert(current_process->state == PROCESS_RUNNING);
+  context.p = current_process;
+  context.timeout_fired = 0;
+  tv.tv_sec = millis / 1000;
+  tv.tv_usec = (millis % 1000) * 1000;
+  evtimer_set(&ev, nap_isr, &context);
+  ICHECK(evtimer_add(&ev, &tv), "evtimer_add");
+  current_process->state = PROCESS_WAITING;
+  current_process->wait_flags |= EV_TIMEOUT;
+  schedule();
+  current_process->wait_flags &= ~EV_TIMEOUT;
+  evtimer_del(&ev);
+  return context.timeout_fired;
+}
+
+static void awaken_waiters(IOHandle *h, short mask) {
+  Process *prev = NULL;
+  Process *p;
+  Process *next;
+  for (p = h->waiters; p != NULL; p = next) {
+    next = p->link;
+    assert(p->state == PROCESS_WAITING);
+    if ((p->wait_flags & mask) != 0) {
+      if (prev == NULL) {
+	h->waiters = next;
+      } else {
+	prev->link = next;
+      }
+      enqueue_runlist(p);
+    } else {
+      prev = p;
+    }
+  }
+}
+
+static void input_isr(struct bufferevent *bufev, IOHandle *h) {
+  awaken_waiters(h, EV_READ);
+}
+
+static void output_isr(struct bufferevent *bufev, IOHandle *h) {
+  awaken_waiters(h, EV_WRITE);
+}
+
+static void error_isr(struct bufferevent *bufev, short what, IOHandle *h) {
+  unsigned short kind = what & ~(EVBUFFER_READ | EVBUFFER_WRITE);
+  int saved_errno = errno;
+  info("error_isr 0x%04X fd %d\n", what, h->fd);
+  h->error_direction = what & (EVBUFFER_READ | EVBUFFER_WRITE);
+  if (kind == EVBUFFER_EOF) {
+    h->eof = 1;
+  } else {
+    h->error_kind = kind;
+    h->error_errno = saved_errno;
+  }
+  awaken_waiters(h, EV_READ | EV_WRITE);
+}
+
+IOHandle *new_iohandle(int fd) {
+  IOHandle *h = malloc(sizeof(*h));
+  h->waiters = NULL;
+  h->fd = fd;
+  h->io = bufferevent_new(fd,
+			  (evbuffercb) input_isr,
+			  (evbuffercb) output_isr,
+			  (everrorcb) error_isr,
+			  h);
+  PCHECK(h->io, "bufferevent_new");
+  bufferevent_setwatermark(h->io, EV_READ, 0, 256 * 1024);
+  h->eof = 0;
+  iohandle_clear_error(h);
+  return h;
+}
+
+void delete_iohandle(IOHandle *h) {
+  if (h->waiters) {
+    warn("Deleting IOHandle %p with fd %d: processes are blocked on this handle!\n",
+	 h,
+	 h->fd);
+  }
+  bufferevent_free(h->io);
+  free(h);
+}
+
+void iohandle_clear_error(IOHandle *h) {
+  h->error_direction = 0;
+  h->error_kind = 0;
+  h->error_errno = 0;
+}
+
+static void block_on_io(IOHandle *h, short event) {
+  assert(current_process->link == NULL);
+  current_process->link = h->waiters;
+  h->waiters = current_process;
+  current_process->state = PROCESS_WAITING;
+  current_process->wait_flags |= event;
+  schedule();
+  current_process->wait_flags &= ~event;
+}
+
+cmsg_bytes_t iohandle_readwait(IOHandle *h, size_t at_least) {
+  while (EVBUFFER_LENGTH(h->io->input) < at_least) {
+    if (h->eof || h->error_kind) {
+      return EMPTY_BYTES;
+    }
+    ICHECK(bufferevent_enable(h->io, EV_READ), "bufferevent_enable");
+    block_on_io(h, EV_READ);
+    ICHECK(bufferevent_disable(h->io, EV_READ), "bufferevent_disable");
+  }
+  return CMSG_BYTES(EVBUFFER_LENGTH(h->io->input), EVBUFFER_DATA(h->io->input));
+}
+
+void iohandle_drain(IOHandle *h, size_t count) {
+  evbuffer_drain(h->io->input, count);
+}
+
+void iohandle_write(IOHandle *h, cmsg_bytes_t buf) {
+  ICHECK(bufferevent_write(h->io, buf.bytes, buf.len), "bufferevent_write");
+}
+
+int iohandle_flush(IOHandle *h) {
+  while (EVBUFFER_LENGTH(h->io->output) > 0) {
+    if (h->error_kind) {
+      return -1;
+    }
+    block_on_io(h, EV_WRITE);
+  }
+  return 0;
+}
+
+void iohandle_settimeout(IOHandle *h, int timeout_read, int timeout_write) {
+  bufferevent_settimeout(h->io, timeout_read, timeout_write);
+}
+
+static void clean_dead_processes(void) {
+  Process *deadp;
+  while ((deadp = dequeue(&deadlist)) != NULL) {
+    free(deadp->stack_base);
+    free(deadp);
+  }
+}
+
+void boot_harness(void) {
+  stdin_h = new_iohandle(0);
+  stdout_h = new_iohandle(1);
+  stderr_h = new_iohandle(2);
+
+  ICHECK(getcontext(&scheduler), "boot_harness getcontext");
+
+  while (1) {
+    while (runlist.count) {
+      queue_t work = runlist;
+      runlist = EMPTY_PROCESS_QUEUE;
+      //info("Processing %d jobs\n", work.count);
+      while ((current_process = dequeue(&work)) != NULL) {
+	//info("entering %p\n", current_process);
+	ICHECK(swapcontext(&scheduler, &current_process->context), "boot_harness swapcontext");
+	clean_dead_processes();
+      }
+      //info("Polling for events\n");
+      event_loop(EVLOOP_NONBLOCK);
+    }
+    if (!harness_running) break;
+    //info("Blocking for events\n");
+    event_loop(EVLOOP_ONCE);
+  }
+
+  info("Shutting down.\n");
+
+  delete_iohandle(stdin_h);
+  delete_iohandle(stdout_h);
+  delete_iohandle(stderr_h);
+}
+
+void interrupt_harness(void) {
+  info("Interrupting harness\n");
+  harness_running = 0;
+}

experiments/cmsg/harness.h

@@ -0,0 +1,72 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_harness_h
+#define cmsg_harness_h
+
+typedef void (*process_main_t)(void *);
+
+typedef enum process_state_t_ {
+  PROCESS_DEAD = 0,
+  PROCESS_RUNNING,
+  PROCESS_WAITING
+} process_state_t;
+
+typedef struct Process {
+  process_state_t state;
+  int wait_flags;
+  void *stack_base;
+  ucontext_t context;
+  struct Process *link;
+} Process;
+
+typedef struct IOHandle {
+  Process *waiters;
+  int fd;
+  struct bufferevent *io;
+  int eof;
+  unsigned short error_direction;
+  unsigned short error_kind;
+  int error_errno;
+} IOHandle;
+
+extern IOHandle *stdin_h;
+extern IOHandle *stdout_h;
+extern IOHandle *stderr_h;
+
+extern Process *current_process;
+
+extern void yield(void);
+extern Process *spawn(process_main_t f, void *arg);
+extern int nap(long millis); /* 1 for timeout expired; 0 for resumed early */
+
+extern void suspend(void);
+extern int resume(Process *p);
+
+extern IOHandle *new_iohandle(int fd);
+extern void delete_iohandle(IOHandle *h);
+extern void iohandle_clear_error(IOHandle *h);
+extern cmsg_bytes_t iohandle_readwait(IOHandle *h, size_t at_least);
+extern void iohandle_drain(IOHandle *h, size_t count);
+extern void iohandle_write(IOHandle *h, cmsg_bytes_t buf);
+extern int iohandle_flush(IOHandle *h);
+extern void iohandle_settimeout(IOHandle *h, int timeout_read, int timeout_write);
+
+extern void boot_harness(void);
+extern void interrupt_harness(void);
+
+#endif

experiments/cmsg/hashtable.c

@@ -0,0 +1,159 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdint.h>
+
+#include <assert.h>
+
+#include "cmsg_private.h"
+#include "hashtable.h"
+
+uint32_t hash_bytes(cmsg_bytes_t bytes) {
+  /* http://en.wikipedia.org/wiki/Jenkins_hash_function */
+  uint32_t hash = 0;
+  size_t i;
+
+  for (i = 0; i < bytes.len; i++) {
+    hash += bytes.bytes[i];
+    hash += (hash << 10);
+    hash ^= (hash >> 6);
+  }
+  hash += (hash << 3);
+  hash ^= (hash >> 11);
+  hash += (hash << 15);
+  return hash;
+}
+
+void init_hashtable(hashtable_t *table,
+		    size_t initial_bucket_count,
+		    void *(*dup_value)(void *),
+		    void (*free_value)(void *))
+{
+  table->bucket_count = initial_bucket_count;
+  table->entry_count = 0;
+  table->buckets = NULL;
+  table->dup_value = dup_value;
+  table->free_value = free_value;
+
+  if (initial_bucket_count > 0) {
+    table->buckets = calloc(initial_bucket_count, sizeof(hashtable_entry_t *));
+  }
+}
+
+static void destroy_entry(hashtable_t *table, hashtable_entry_t *entry) {
+  cmsg_bytes_free(entry->key);
+  if (table->free_value != NULL) {
+    table->free_value(entry->value);
+  }
+  free(entry);
+}
+
+void destroy_hashtable(hashtable_t *table) {
+  if (table->buckets != NULL) {
+    int i;
+    for (i = 0; i < table->bucket_count; i++) {
+      hashtable_entry_t *chain = table->buckets[i];
+      table->buckets[i] = NULL;
+      while (chain != NULL) {
+	hashtable_entry_t *next = chain->next;
+	destroy_entry(table, chain);
+	chain = next;
+      }
+    }
+    free(table->buckets);
+  }
+}
+
+static hashtable_entry_t **hashtable_find(hashtable_t *table, cmsg_bytes_t key) {
+  uint32_t h = hash_bytes(key) % table->bucket_count;
+  hashtable_entry_t **entryptr = &(table->buckets[h]);
+  hashtable_entry_t *entry = *entryptr;
+  while (entry != NULL) {
+    if ((entry->key.len == key.len) && !memcmp(entry->key.bytes, key.bytes, key.len)) {
+      break;
+    }
+    entryptr = &entry->next;
+    entry = *entryptr;
+  }
+  return entryptr;
+}
+
+int hashtable_contains(hashtable_t *table, cmsg_bytes_t key) {
+  hashtable_entry_t **entryptr = hashtable_find(table, key);
+  return (*entryptr != NULL);
+}
+
+int hashtable_get(hashtable_t *table, cmsg_bytes_t key, void **valueptr) {
+  hashtable_entry_t **entryptr = hashtable_find(table, key);
+  if (*entryptr == NULL) {
+    return 0;
+  } else {
+    *valueptr = (*entryptr)->value;
+    return 1;
+  }
+}
+
+int hashtable_put(hashtable_t *table, cmsg_bytes_t key, void *value) {
+  /* TODO: grow and rehash */
+  hashtable_entry_t **entryptr = hashtable_find(table, key);
+  if (*entryptr == NULL) {
+    hashtable_entry_t *entry = malloc(sizeof(hashtable_entry_t));
+    entry->next = NULL;
+    entry->key = cmsg_bytes_malloc_dup(key);
+    entry->value = (table->dup_value == NULL) ? value : table->dup_value(value);
+    *entryptr = entry;
+    table->entry_count++;
+    return 1;
+  } else {
+    if (table->free_value != NULL) {
+      table->free_value((*entryptr)->value);
+    }
+    (*entryptr)->value = (table->dup_value == NULL) ? value : table->dup_value(value);
+    return 0;
+  }
+}
+
+int hashtable_erase(hashtable_t *table, cmsg_bytes_t key) {
+  hashtable_entry_t **entryptr = hashtable_find(table, key);
+  if (*entryptr == NULL) {
+    return 0;
+  } else {
+    hashtable_entry_t *entry = *entryptr;
+    *entryptr = entry->next;
+    destroy_entry(table, entry);
+    table->entry_count--;
+    return 1;
+  }
+}
+
+void hashtable_foreach(hashtable_t *table,
+		       hashtable_iterator_t iterator,
+		       void *context)
+{
+  int i;
+  for (i = 0; i < table->bucket_count; i++) {
+    hashtable_entry_t *chain = table->buckets[i];
+    while (chain != NULL) {
+      hashtable_entry_t *next = chain->next;
+      iterator(context, chain->key, chain->value);
+      chain = next;
+    }
+  }
+}

experiments/cmsg/hashtable.h

@@ -0,0 +1,53 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_hashtable_h
+#define cmsg_hashtable_h
+
+typedef struct hashtable_entry_t_ {
+  struct hashtable_entry_t_ *next;
+  cmsg_bytes_t key;
+  void *value;
+} hashtable_entry_t;
+
+typedef struct hashtable_t_ {
+  size_t bucket_count;
+  size_t entry_count;
+  hashtable_entry_t **buckets;
+  void *(*dup_value)(void *);
+  void (*free_value)(void *);
+} hashtable_t;
+
+typedef void (*hashtable_iterator_t)(void *context, cmsg_bytes_t key, void *value);
+
+extern uint32_t hash_bytes(cmsg_bytes_t bytes);
+
+extern void init_hashtable(hashtable_t *table,
+			   size_t initial_bucket_count,
+			   void *(*dup_value)(void *),
+			   void (*free_value)(void *));
+extern void destroy_hashtable(hashtable_t *table);
+
+extern int hashtable_contains(hashtable_t *table, cmsg_bytes_t key);
+extern int hashtable_get(hashtable_t *table, cmsg_bytes_t key, void **valueptr);
+extern int hashtable_put(hashtable_t *table, cmsg_bytes_t key, void *value);
+extern int hashtable_erase(hashtable_t *table, cmsg_bytes_t key);
+extern void hashtable_foreach(hashtable_t *table,
+			      hashtable_iterator_t iterator,
+			      void *context);
+
+#endif

experiments/cmsg/main.c

@@ -0,0 +1,125 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <signal.h>
+
+#include <netinet/in.h>
+#include <ucontext.h>
+
+#include <assert.h>
+
+typedef unsigned char u_char;
+#include <event.h>
+
+#include "cmsg_private.h"
+#include "harness.h"
+#include "net.h"
+#include "ref.h"
+#include "sexp.h"
+#include "hashtable.h"
+#include "node.h"
+#include "queue.h"
+#include "direct.h"
+#include "fanout.h"
+#include "relay.h"
+#include "meta.h"
+#include "messages.h"
+#include "sexpio.h"
+
+#define WANT_CONSOLE_LISTENER 1
+
+static void factory_handle_message(node_t *n, sexp_t *m) {
+  parsed_message_t p;
+
+  if (parse_create(m, &p)) {
+    if (sexp_stringp(p.create.classname)
+	&& sexp_stringp(p.create.reply_sink)
+	&& sexp_stringp(p.create.reply_name)) {
+      cmsg_bytes_t classname_bytes = sexp_data(p.create.classname);
+      node_class_t *nc = lookup_node_class(classname_bytes);
+      if (nc == NULL) {
+	warn("Node class not found <<%.*s>>\n", classname_bytes.len, classname_bytes.bytes);
+      } else {
+	sexp_t *error = NULL;
+	sexp_t *reply;
+	if (new_node(nc, p.create.arg, &error) != NULL) {
+	  reply = message_create_ok(NULL);
+	} else {
+	  reply = message_create_failed(error);
+	}
+	post_node(sexp_data(p.create.reply_sink),
+		  sexp_data(p.create.reply_name),
+		  reply,
+		  sexp_empty_bytes);
+      }
+    }
+    return;
+  }
+
+  warn("Message not understood in factory: ");
+  sexp_writeln(stderr_h, m);
+}
+
+static node_class_t factory_class = {
+  .name = "factory",
+  .extend = NULL,
+  .destroy = NULL,
+  .handle_message = factory_handle_message
+};
+
+static void init_factory(void) {
+  bind_node(cmsg_cstring_bytes("factory"), new_node(&factory_class, NULL, NULL));
+}
+
+#if WANT_CONSOLE_LISTENER
+static void console_listener(void *arg) {
+  IOHandle *in_handle = new_iohandle(0);
+  while (1) {
+    cmsg_bytes_t buf = iohandle_readwait(in_handle, 1);
+    if (buf.len == 0) break;
+    iohandle_drain(in_handle, buf.len);
+  }
+  delete_iohandle(in_handle);
+  interrupt_harness();
+}
+#endif
+
+int main(int argc, char *argv[]) {
+  info("cmsg ALPHA, Copyright (C) 2010, 2011 Tony Garnock-Jones. All rights reserved.\n");
+  event_init();
+  signal(SIGPIPE, SIG_IGN); /* avoid EPIPE when connections drop unexpectedly */
+  info("Using libevent version %s\n", event_get_version());
+  init_sexp();
+  init_messages();
+  init_node(cmsg_cstring_bytes("server"));
+  init_factory();
+  init_queue();
+  init_direct();
+  init_fanout();
+  init_relay();
+  init_meta();
+#if WANT_CONSOLE_LISTENER
+  spawn(console_listener, NULL);
+#endif
+  start_net(5671);
+  boot_harness();
+  done_sexp();
+  return 0;
+}

experiments/cmsg/meta.c

@@ -0,0 +1,54 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <errno.h>
+#include <stdint.h>
+#include <stddef.h>
+
+#include <assert.h>
+
+#include "cmsg_private.h"
+#include "ref.h"
+#include "sexp.h"
+#include "hashtable.h"
+#include "node.h"
+#include "meta.h"
+#include "messages.h"
+
+void init_meta(void) {
+  sexp_t *args;
+  args = INCREF(sexp_cons(sexp_cstring("meta"), NULL));
+  new_node(lookup_node_class(cmsg_cstring_bytes("direct")), args, NULL);
+  DECREF(args, sexp_destructor);
+}
+
+void announce_subscription(sexp_t *source,
+			   sexp_t *filter,
+			   sexp_t *sink,
+			   sexp_t *name,
+			   int onoff)
+{
+  post_node(cmsg_cstring_bytes("meta"),
+	    sexp_data(source),
+	    onoff
+	      ? message_subscribed(source, filter, sink, name)
+	      : message_unsubscribed(source, filter, sink, name),
+	    NULL);
+}

experiments/cmsg/meta.h

@@ -0,0 +1,29 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_meta_h
+#define cmsg_meta_h
+
+extern void init_meta(void);
+
+extern void announce_subscription(sexp_t *source,
+				  sexp_t *filter,
+				  sexp_t *sink,
+				  sexp_t *name,
+				  int onoff);
+
+#endif

experiments/cmsg/misc/direct_scheduling.patch

@@ -0,0 +1,74 @@
+diff --git a/harness.c b/harness.c
+index 9c891b3..74061af 100644
+--- a/harness.c
++++ b/harness.c
+@@ -50,18 +50,38 @@ Process *current_process = NULL;
+ static ucontext_t scheduler;
+ static queue_t runlist = EMPTY_PROCESS_QUEUE;
+ static queue_t deadlist = EMPTY_PROCESS_QUEUE;
++static queue_t current_worklist = EMPTY_PROCESS_QUEUE;
+ 
+ static void enqueue_runlist(Process *p) {
+   p->state = PROCESS_RUNNING;
+   enqueue(&runlist, p);
+ }
+ 
++static void clean_dead_processes(void) {
++  Process *deadp;
++  while ((deadp = dequeue(&deadlist)) != NULL) {
++    free(deadp->stack_base);
++    free(deadp);
++  }
++}
++
+ static void schedule(void) {
+-  //info("schedule %p\n", current_process);
+   if (current_process == NULL) {
+     ICHECK(setcontext(&scheduler), "schedule setcontext");
+   } else {
+-    ICHECK(swapcontext(&current_process->context, &scheduler), "schedule swapcontext");
++    Process *current = current_process;
++    Process *target_process = dequeue(&current_worklist);
++    ucontext_t *target;
++
++    if (target_process == NULL) {
++      target = &scheduler;
++    } else {
++      target = &target_process->context;
++      current_process = target_process;
++    }
++
++    clean_dead_processes(); /* safe because we know we're not dead ourselves at this point */
++    ICHECK(swapcontext(&current->context, target), "schedule swapcontext");
+   }
+ }
+ 
+@@ -255,14 +275,6 @@ void iohandle_settimeout(IOHandle *h, int timeout_read, int timeout_write) {
+   bufferevent_settimeout(h->io, timeout_read, timeout_write);
+ }
+ 
+-static void clean_dead_processes(void) {
+-  Process *deadp;
+-  while ((deadp = dequeue(&deadlist)) != NULL) {
+-    free(deadp->stack_base);
+-    free(deadp);
+-  }
+-}
+-
+ void boot_harness(void) {
+   stdin_h = new_iohandle(0);
+   stdout_h = new_iohandle(1);
+@@ -272,10 +284,10 @@ void boot_harness(void) {
+ 
+   while (1) {
+     while (runlist.count) {
+-      queue_t work = runlist;
++      current_worklist = runlist;
+       runlist = EMPTY_PROCESS_QUEUE;
+-      //info("Processing %d jobs\n", work.count);
+-      while ((current_process = dequeue(&work)) != NULL) {
++      //info("Processing %d jobs\n", current_worklist.count);
++      while ((current_process = dequeue(&current_worklist)) != NULL) {
+ 	//info("entering %p\n", current_process);
+ 	ICHECK(swapcontext(&scheduler, &current_process->context), "boot_harness swapcontext");
+ 	clean_dead_processes();

experiments/cmsg/misc/t0

@@ -0,0 +1,2 @@
+(9:subscribe5:test00:0:5:test05:login)
+(4:post4:meta(9:subscribe0:5:test08:presence5:test01:k)0:)

experiments/cmsg/misc/t1

@@ -0,0 +1,3 @@
+(9:subscribe5:test10:0:5:test15:login)
+(4:post7:factory(6:create5:queue(2:q1)5:test11:k)0:)
+(4:post2:q1(9:subscribe0:5:test18:consumer5:test11:k)0:)

experiments/cmsg/misc/t2

@@ -0,0 +1,4 @@
+(9:subscribe5:test20:0:5:test25:login)
+(4:post2:q1(4:post0:8:message10:)0:)
+(4:post2:q1(4:post0:8:message20:)0:)
+(11:unsubscribe5:test2)

experiments/cmsg/misc/t4

@@ -0,0 +1,4 @@
+(9:subscribe5:test40:0:5:test45:login)
+(4:post7:factory(6:create6:direct(2:dx)5:test41:k)0:)
+(4:post2:dx(9:subscribe1:a5:test48:consumer5:test41:k)0:)
+(4:post2:dx(9:subscribe1:c5:test48:consumer5:test41:k)0:)

experiments/cmsg/misc/t5

@@ -0,0 +1,7 @@
+(9:subscribe5:test50:0:5:test55:login)
+(4:post7:factory(6:create6:direct(2:dx)5:test51:k)0:)
+(4:post7:factory(6:create5:queue(2:q5)5:test51:k)0:)
+(4:post2:q5(9:subscribe0:5:test59:consumer15:test51:k)0:)
+(4:post2:q5(9:subscribe0:5:test59:consumer25:test51:k)0:)
+(4:post2:dx(9:subscribe1:a2:q50:5:test51:k)0:)
+(4:post2:dx(9:subscribe1:b2:q50:5:test51:k)0:)

experiments/cmsg/misc/t6

@@ -0,0 +1,6 @@
+(9:subscribe5:test60:0:5:test65:login)
+(4:post2:dx(4:post1:a9:messageA10:)0:)
+(4:post2:dx(4:post1:a9:messageA20:)0:)
+(4:post2:dx(4:post1:b8:messageB0:)0:)
+(4:post2:dx(4:post1:c8:messageC0:)0:)
+(11:unsubscribe5:test6)

experiments/cmsg/net.c

@@ -0,0 +1,116 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <errno.h>
+
+#include <sys/types.h>
+#include <sys/uio.h>
+#include <unistd.h>
+#include <sys/socket.h>
+#include <netdb.h>
+#include <netinet/in.h>
+#include <netinet/tcp.h>
+#include <fcntl.h>
+#include <sys/wait.h>
+#include <time.h>
+#include <sys/time.h>
+
+#include <stdarg.h>
+#include <assert.h>
+
+typedef unsigned char u_char;
+#include <event.h>
+
+#include "cmsg_private.h"
+#include "relay.h"
+
+static struct event accept_event;
+
+void get_addr_name(char *namebuf, size_t buflen, struct sockaddr_in const *sin) {
+  unsigned char *addr = (unsigned char *) &sin->sin_addr.s_addr;
+  struct hostent *h = gethostbyaddr(addr, 4, AF_INET);
+
+  if (h == NULL) {
+    snprintf(namebuf, buflen, "%u.%u.%u.%u", addr[0], addr[1], addr[2], addr[3]);
+  } else {
+    snprintf(namebuf, buflen, "%s", h->h_name);
+  }
+}
+
+void endpoint_name(struct sockaddr_in const *peername, cmsg_bytes_t result) {
+  char name[256];
+  get_addr_name(name, sizeof(name), peername);
+  snprintf((char *) result.bytes, result.len, "%s:%d", name, ntohs(peername->sin_port));
+}
+
+static void accept_connection(int servfd, short what, void *arg) {
+  struct sockaddr_in s;
+  socklen_t addrlen = sizeof(s);
+  int fd = accept(servfd, (struct sockaddr *) &s, &addrlen);
+
+  if (fd == -1) {
+    if (errno != EAGAIN && errno != EINTR) {
+      warn("accept: errno %d (%s)\n", errno, strerror(errno));
+    }
+    return;
+  }
+
+  {
+    int i = 1;
+    ICHECK(setsockopt(fd, IPPROTO_TCP, TCP_NODELAY, &i, sizeof(i)), "setsockopt TCP_NODELAY");
+  }
+
+  start_relay(&s, fd);
+}
+
+void start_net(int listen_port) {
+  int servfd = socket(AF_INET, SOCK_STREAM, 0);
+  struct sockaddr_in s;
+
+  if (servfd < 0) {
+    die("Could not open listen socket.\n");
+  }
+
+  s.sin_family = AF_INET;
+  s.sin_addr.s_addr = htonl(INADDR_ANY);
+  s.sin_port = htons(listen_port);
+
+  {
+    int i = 1;
+    setsockopt(servfd, SOL_SOCKET, SO_REUSEADDR, &i, sizeof(i)); // don't care if this fails
+  }
+
+  if (bind(servfd, (struct sockaddr *) &s, sizeof(s)) < 0) {
+    die("Could not bind listen socket.\n");
+  }
+
+  if (listen(servfd, 5) < 0) {
+    int savedErrno = errno;
+    die("Could not listen on listen socket (errno %d: %s).\n",
+	savedErrno, strerror(savedErrno));
+  }
+
+  event_set(&accept_event, servfd, EV_READ | EV_PERSIST, accept_connection, NULL);
+  if (event_add(&accept_event, NULL) == -1) {
+    die("Could not add accept_event.");
+  }
+
+  info("Accepting connections on port %d.\n", listen_port);
+}

experiments/cmsg/net.h

@@ -0,0 +1,26 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_net_h
+#define cmsg_net_h
+
+extern void get_addr_name(char *namebuf, size_t buflen, struct sockaddr_in const *sin);
+extern void endpoint_name(struct sockaddr_in const *peername, cmsg_bytes_t result);
+
+extern void start_net(int listen_port);
+
+#endif

experiments/cmsg/node.c

@@ -0,0 +1,194 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <stdint.h>
+
+#include <assert.h>
+
+#include <ucontext.h>
+
+#include "cmsg_private.h"
+#include "ref.h"
+#include "sexp.h"
+#include "harness.h"
+#include "sexpio.h"
+#include "hashtable.h"
+#include "node.h"
+#include "meta.h"
+#include "messages.h"
+
+static cmsg_bytes_t _container_name;
+static hashtable_t node_class_table;
+static hashtable_t directory;
+
+static void *node_incref(void *arg) {
+  return INCREF((node_t *) arg);
+}
+
+static void node_decref(void *arg) {
+  DECREF((node_t *) arg, node_destructor);
+}
+
+void init_node(cmsg_bytes_t container_name) {
+  if (container_name.len == 0) {
+    unsigned char buf[CMSG_UUID_BUF_SIZE];
+    gen_uuid(buf);
+    _container_name = cmsg_bytes_malloc_dup(CMSG_BYTES(CMSG_UUID_BUF_SIZE, buf));
+  } else {
+    _container_name = cmsg_bytes_malloc_dup(container_name);
+  }
+  info("Local container name is <<%.*s>>\n", _container_name.len, _container_name.bytes);
+
+  init_hashtable(&node_class_table,
+		 31,
+		 NULL,
+		 NULL);
+  init_hashtable(&directory,
+		 10007,
+		 node_incref,
+		 node_decref);
+}
+
+cmsg_bytes_t local_container_name(void) {
+  return _container_name;
+}
+
+void register_node_class(node_class_t *nc) {
+  cmsg_bytes_t key = cmsg_cstring_bytes(nc->name);
+  if (hashtable_contains(&node_class_table, key)) {
+    die("Duplicate node class name %s\n", nc->name);
+  }
+  hashtable_put(&node_class_table, key, nc);
+}
+
+node_class_t *lookup_node_class(cmsg_bytes_t name) {
+  node_class_t *nc = NULL;
+  hashtable_get(&node_class_table, name, (void **) &nc);
+  return nc;
+}
+
+static void init_node_names(node_t *n) {
+  init_hashtable(&n->names, 5, NULL, NULL);
+}
+
+node_t *new_node(node_class_t *nc, sexp_t *args, sexp_t **error_out) {
+  node_t *n = malloc(sizeof(*n));
+  n->refcount = ZERO_REFCOUNT();
+  n->node_class = nc;
+  n->extension = NULL;
+  init_node_names(n);
+  if (nc->extend != NULL) {
+    sexp_t *error = nc->extend(n, args);
+    if (error != NULL) {
+      node_destructor(n);
+      if (error_out != NULL) {
+	*error_out = error;
+      } else {
+	warn("Creating node of class %s failed with ", nc->name);
+	sexp_writeln(stderr_h, error);
+      }
+      return NULL;
+    }
+  }
+  return n;
+}
+
+void node_destructor(node_t *n) {
+  if (n->node_class->destroy != NULL) {
+    n->node_class->destroy(n);
+  }
+  unbind_all_names_for_node(n);
+  destroy_hashtable(&n->names);
+  free(n);
+}
+
+node_t *lookup_node(cmsg_bytes_t name) {
+  node_t *n = NULL;
+  hashtable_get(&directory, name, (void **) &n);
+  return n;
+}
+
+static void announce_binding(cmsg_bytes_t name, int onoff) {
+  sexp_t *filter = sexp_bytes(name);
+  INCREF(filter);
+  announce_subscription(sexp_empty_bytes, filter, sexp_empty_bytes, sexp_empty_bytes, onoff);
+  DECREF(filter, sexp_destructor);
+}
+
+int bind_node(cmsg_bytes_t name, node_t *n) {
+  if (name.len == 0) {
+    warn("Binding to empty name forbidden\n");
+    return 0;
+  }
+  if (hashtable_contains(&directory, name)) {
+    return 0;
+  }
+  hashtable_put(&directory, name, n);
+  hashtable_put(&n->names, name, NULL);
+  info("Binding node <<%.*s>> of class %s\n", name.len, name.bytes, n->node_class->name);
+  announce_binding(name, 1);
+  return 1;
+}
+
+int unbind_node(cmsg_bytes_t name) {
+  node_t *n = NULL;
+  hashtable_get(&directory, name, (void **) &n);
+  if (n == NULL) {
+    return 0;
+  } else {
+    info("Unbinding node <<%.*s>> of class %s\n", name.len, name.bytes, n->node_class->name);
+    hashtable_erase(&n->names, name);
+    hashtable_erase(&directory, name);
+    announce_binding(name, 0);
+    return 1;
+  }
+}
+
+static void unbind_on_destroy(void *context, cmsg_bytes_t key, void *value) {
+  unbind_node(key);
+}
+
+void unbind_all_names_for_node(node_t *n) {
+  hashtable_t names = n->names;
+  init_node_names(n);
+  hashtable_foreach(&names, unbind_on_destroy, NULL);
+  destroy_hashtable(&names);
+}
+
+int post_node(cmsg_bytes_t node, cmsg_bytes_t name, sexp_t *body, sexp_t *token) {
+  return send_node_release(node, message_post(sexp_bytes(name), body, token));
+}
+
+int send_node(cmsg_bytes_t node, sexp_t *message) {
+  node_t *n = lookup_node(node);
+  if (n == NULL) {
+    return 0;
+  }
+  n->node_class->handle_message(n, message);
+  return 1;
+}
+
+int send_node_release(cmsg_bytes_t node, sexp_t *message) {
+  int result;
+  INCREF(message);
+  result = send_node(node, message);
+  DECREF(message, sexp_destructor);
+  return result;
+}

experiments/cmsg/node.h

@@ -0,0 +1,60 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_node_h
+#define cmsg_node_h
+
+typedef struct node_t_ {
+  refcount_t refcount;
+  struct node_class_t_ *node_class;
+  hashtable_t names;
+  void *extension; /* Each node class puts something different here in its instances */
+} node_t;
+
+typedef sexp_t *(*node_extension_fn_t)(node_t *n, sexp_t *args);
+typedef void (*node_destructor_fn_t)(node_t *n);
+typedef void (*node_message_handler_fn_t)(node_t *n, sexp_t *m);
+
+typedef struct node_class_t_ {
+  char const *name;
+  node_extension_fn_t extend;
+  node_destructor_fn_t destroy;
+  node_message_handler_fn_t handle_message;
+} node_class_t;
+
+extern void init_node(cmsg_bytes_t container_name);
+
+extern cmsg_bytes_t local_container_name(void);
+
+extern void basic_node_destroy(node_t *n);
+
+extern void register_node_class(node_class_t *nc);
+extern node_class_t *lookup_node_class(cmsg_bytes_t name);
+
+extern node_t *new_node(node_class_t *nc, sexp_t *args, sexp_t **error_out);
+extern void node_destructor(node_t *n);
+
+extern node_t *lookup_node(cmsg_bytes_t name);
+extern int bind_node(cmsg_bytes_t name, node_t *n);
+extern int unbind_node(cmsg_bytes_t name);
+extern void unbind_all_names_for_node(node_t *n);
+
+extern int post_node(cmsg_bytes_t node, cmsg_bytes_t name, sexp_t *body, sexp_t *token);
+extern int send_node(cmsg_bytes_t node, sexp_t *message);
+extern int send_node_release(cmsg_bytes_t node, sexp_t *message);
+
+#endif

experiments/cmsg/queue.c

@@ -0,0 +1,243 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <errno.h>
+#include <stdint.h>
+#include <stddef.h>
+
+#include <assert.h>
+
+#include <ucontext.h>
+
+#include "cmsg_private.h"
+#include "harness.h"
+#include "ref.h"
+#include "sexp.h"
+#include "sexpio.h"
+#include "hashtable.h"
+#include "node.h"
+#include "queue.h"
+#include "dataq.h"
+#include "messages.h"
+#include "subscription.h"
+
+typedef struct queue_extension_t_ {
+  sexp_t *name;
+  sexp_t *backlog_q;
+  queue_t waiter_q;
+  hashtable_t subscriptions;
+  Process *shovel;
+  int shovel_awake;
+} queue_extension_t;
+
+static sexp_t *queue_extend(node_t *n, sexp_t *args) {
+  if ((sexp_length(args) == 1) && sexp_stringp(sexp_head(args))) {
+    cmsg_bytes_t name = sexp_data(sexp_head(args));
+    queue_extension_t *q = calloc(1, sizeof(*q));
+    q->name = INCREF(sexp_head(args));
+    q->backlog_q = INCREF(sexp_new_queue());
+    q->waiter_q = EMPTY_QUEUE(subscription_t, link);
+    init_hashtable(&q->subscriptions, 5, NULL, NULL);
+    q->shovel = NULL;
+    q->shovel_awake = 0;
+
+    n->extension = q;
+    return bind_node(name, n) ? NULL : sexp_cstring("bind failed");
+  } else {
+    return sexp_cstring("invalid args");
+  }
+}
+
+static void queue_destructor(node_t *n) {
+  queue_extension_t *q = n->extension;
+  if (q != NULL) { /* can be NULL if queue_extend was given invalid args */
+    DECREF(q->name, sexp_destructor);
+    DECREF(q->backlog_q, sexp_destructor);
+    {
+      subscription_t *sub = NULL;
+      while ((sub = dequeue(&q->waiter_q)) != NULL) {
+	free_subscription(sub);
+      }
+    }
+    destroy_hashtable(&q->subscriptions);
+    if (q->shovel) {
+      warn("TODO: the shovel needs to be taken down as well here\n");
+      /* The difficulty is that the shovel may be running at the
+	 moment, so careful ordering of operations is required to
+	 avoid referencing deallocated memory. */
+    }
+    free(q);
+  }
+}
+
+static void end_burst(queue_extension_t *q, size_t *burst_count_ptr, size_t total_count) {
+#if 0
+  if (*burst_count_ptr > 0) {
+    info("Queue <<%.*s>>: burst count %lu; total %lu\n",
+	 sexp_data(q->name).len, sexp_data(q->name).bytes,
+	 *burst_count_ptr, total_count);
+  }
+#endif
+  *burst_count_ptr = 0;
+}
+
+static void shoveller(void *qv) {
+  queue_extension_t *q = qv;
+
+  size_t burst_count = 0;
+  size_t total_count = 0;
+  sexp_t *body = NULL; /* held */
+  subscription_t *sub = NULL;
+
+  {
+    cmsg_bytes_t n = sexp_data(q->name);
+    info("Queue <<%.*s>> busy. Shoveller entering\n", n.len, n.bytes);
+  }
+
+ check_for_work:
+  //info("Checking for work\n");
+
+  if (sexp_queue_emptyp(q->backlog_q)) {
+    //info("Backlog empty\n");
+    goto wait_and_shovel;
+  }
+
+  body = INCREF(sexp_dequeue(q->backlog_q)); /* held */
+
+ find_valid_waiter:
+  if (q->waiter_q.count == 0) {
+    //info("No waiters\n");
+    sexp_queue_pushback(q->backlog_q, body);
+    DECREF(body, sexp_destructor);
+    goto wait_and_shovel;
+  }
+
+  sub = dequeue(&q->waiter_q);
+
+  /*
+  info("Delivering to <<%.*s>>/<<%.*s>>...\n",
+       sexp_data(sub->sink).len, sexp_data(sub->sink).bytes,
+       sexp_data(sub->name).len, sexp_data(sub->name).bytes);
+  */
+
+  if (!send_to_subscription(q->name, &q->subscriptions, sub, body)) {
+    goto find_valid_waiter;
+  }
+
+  burst_count++;
+  total_count++;
+
+  //info("Delivery successful\n");
+  DECREF(body, sexp_destructor);
+  enqueue(&q->waiter_q, sub);
+
+  if (burst_count >= 10000) {
+    end_burst(q, &burst_count, total_count);
+    yield();
+  }
+
+  goto check_for_work;
+
+ wait_and_shovel:
+  end_burst(q, &burst_count, total_count);
+  //info("Waiting for throck\n");
+  q->shovel_awake = 0;
+  /* TODO: if the number of active processes is large, assume we have
+     memory pressure, and quit the shovel early rather than waiting
+     for a few milliseconds to see if we're idle. */
+  if (nap(100)) {
+    cmsg_bytes_t n = sexp_data(q->name);
+    info("Queue <<%.*s>> idle. Shoveller exiting\n", n.len, n.bytes);
+    q->shovel = NULL;
+    return;
+  }
+  //info("Throck received!\n");
+  goto check_for_work;
+}
+
+static void throck_shovel(queue_extension_t *q) {
+  //int counter = 0;
+ retry:
+  //printf("throck %d %d %p\n", counter++, q->shovel_awake, q->shovel);
+  if (!q->shovel_awake) {
+    if (!q->shovel) {
+      q->shovel_awake = 1;
+      q->shovel = spawn(shoveller, q);
+    } else {
+      if (resume(q->shovel) == -1) {
+	/* The nap() in the shoveller returned and scheduled the
+	   shoveller *just* before we got to it, but the shoveller
+	   hasn't had a chance to run yet, so hasn't been able to
+	   clear q->shovel and exit. The resume() attempt failed
+	   because q->shovel's state is PROCESS_RUNNING, now that it
+	   has been scheduled by the return of nap(), so we know that
+	   we should back off and try again from the top. */
+	yield();
+	goto retry;
+      } else {
+	/* The resume() was successful, i.e. the nap() hadn't returned
+	   before we tried to resume(). We know that nap() will return
+	   zero (since the timeout didn't fire before the process was
+	   resumed), and so the existing shoveller will continue
+	   running. */
+	q->shovel_awake = 1;
+      }
+    }
+  }
+}
+
+static void queue_handle_message(node_t *n, sexp_t *m) {
+  queue_extension_t *q = n->extension;
+  parsed_message_t p;
+
+  if (parse_post(m, &p)) {
+    sexp_enqueue(q->backlog_q, p.post.body);
+    throck_shovel(q);
+    return;
+  }
+
+  if (parse_subscribe(m, &p)) {
+    subscription_t *sub = handle_subscribe_message(q->name, &q->subscriptions, &p);
+    if (sub != NULL) {
+      enqueue(&q->waiter_q, sub);
+      throck_shovel(q);
+    }
+    return;
+  }
+
+  if (parse_unsubscribe(m, &p)) {
+    handle_unsubscribe_message(q->name, &q->subscriptions, &p);
+    return;
+  }
+
+  warn("Message not understood in queue: ");
+  sexp_writeln(stderr_h, m);
+}
+
+static node_class_t queue_class = {
+  .name = "queue",
+  .extend = queue_extend,
+  .destroy = queue_destructor,
+  .handle_message = queue_handle_message
+};
+
+void init_queue(void) {
+  register_node_class(&queue_class);
+}

experiments/cmsg/queue.h

@@ -0,0 +1,23 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_queue_h
+#define cmsg_queue_h
+
+extern void init_queue(void);
+
+#endif

experiments/cmsg/ref.h

@@ -0,0 +1,56 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_ref_h
+#define cmsg_ref_h
+
+typedef struct refcount_t_ {
+  unsigned int count;
+} refcount_t;
+
+#define ZERO_REFCOUNT() ((refcount_t) { .count = 0 })
+
+#define INCREF(x) ({				\
+      typeof(x) __x = (x);			\
+      if (__x != NULL) {			\
+	__x->refcount.count++;			\
+      }						\
+      __x;					\
+    })
+
+#define UNGRAB(x) ({				\
+      typeof(x) __x = (x);			\
+      if (__x != NULL) {			\
+	assert(__x->refcount.count);		\
+	__x->refcount.count--;			\
+      }						\
+      __x;					\
+    })
+
+#define DECREF(x, dtor) ({			\
+    typeof(x) __x = (x);			\
+    if (__x != NULL) {				\
+      assert(__x->refcount.count);		\
+      (__x->refcount.count)--;			\
+      if (__x->refcount.count == 0) {		\
+	(dtor)(__x);				\
+      }						\
+    }						\
+    (typeof(__x)) 0;				\
+  })
+
+#endif

experiments/cmsg/relay.c

@@ -0,0 +1,234 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <errno.h>
+
+#include <sys/types.h>
+#include <sys/uio.h>
+#include <unistd.h>
+#include <sys/socket.h>
+#include <netdb.h>
+#include <netinet/in.h>
+#include <fcntl.h>
+#include <sys/wait.h>
+#include <time.h>
+#include <sys/time.h>
+
+#include <assert.h>
+
+typedef unsigned char u_char;
+#include <event.h>
+
+#include "cmsg_private.h"
+#include "harness.h"
+#include "relay.h"
+#include "net.h"
+#include "ref.h"
+#include "sexp.h"
+#include "sexpio.h"
+#include "hashtable.h"
+#include "node.h"
+#include "messages.h"
+
+#define WANT_MESSAGE_TRACE 0
+
+typedef struct relay_extension_t_ {
+  struct sockaddr_in peername;
+  char peername_str[256];
+  sexp_t *remote_container_name;
+  int fd;
+  IOHandle *outh;
+} relay_extension_t;
+
+static long connection_count = 0;
+
+static void stats_printer(void *arg) {
+  while (1) {
+    info("%ld connections active\n", connection_count);
+    nap(1000);
+  }
+}
+
+void init_relay(void) {
+  spawn(stats_printer, NULL);
+}
+
+static sexp_t *relay_extend(node_t *n, sexp_t *args) {
+  /* TODO: outbound connections; args==NULL -> server relay, nonNULL -> outbound. */
+  n->extension = calloc(1, sizeof(relay_extension_t));
+  return NULL;
+}
+
+static void relay_destructor(node_t *n) {
+  relay_extension_t *r = n->extension;
+  delete_iohandle(r->outh);
+  r->outh = NULL;
+  if (close(r->fd) == -1) {
+    /* log errors as warnings here and keep on trucking */
+    warn("Closing file descriptor %d produced errno %d: %s\n",
+	 r->fd, errno, strerror(errno));
+  }
+  DECREF(r->remote_container_name, sexp_destructor);
+  free(r);
+}
+
+static void relay_handle_message(node_t *n, sexp_t *m) {
+  relay_extension_t *r = n->extension;
+
+#if WANT_MESSAGE_TRACE
+  info("fd %d <-- ", r->fd);
+  sexp_writeln(stderr_h, m);
+#endif
+
+  BCHECK(!sexp_write(r->outh, m), "relay_handle_message sexp_write");
+}
+
+static node_class_t relay_class = {
+  .name = "relay",
+  .extend = relay_extend,
+  .destroy = relay_destructor,
+  .handle_message = relay_handle_message
+};
+
+static void send_error(IOHandle *h, char const *message, sexp_t *details) {
+  sexp_t *m = message_error(sexp_cstring(message), details);
+  INCREF(m);
+  warn("Sending error: ");
+  sexp_writeln(stderr_h, m);
+  iohandle_clear_error(h);
+  BCHECK(!sexp_write(h, m), "send_error sexp_write");
+  DECREF(m, sexp_destructor);
+  iohandle_flush(h); /* ignore result here, there's not much we can do with it */
+}
+
+static void send_sexp_syntax_error(IOHandle *h, char const *message) {
+  char const *url = "http://people.csail.mit.edu/rivest/Sexp.txt";
+  send_error(h, message, sexp_cstring(url));
+}
+
+static void relay_main(node_t *n) {
+  relay_extension_t *r = n->extension;
+  IOHandle *inh = new_iohandle(r->fd);
+  sexp_t *message = NULL; /* held */
+  parsed_message_t p;
+
+  INCREF(n); /* because the caller doesn't hold a ref, and we need to
+		drop ours on our death */
+
+  info("Accepted connection from %s on fd %d\n", r->peername_str, r->fd);
+  connection_count++;
+
+  iohandle_write(r->outh, cmsg_cstring_bytes("(3:hop1:0)"));
+  ICHECK(iohandle_flush(r->outh), "iohandle_flush greeting");
+
+  {
+    sexp_t *s = message_subscribe(sexp_bytes(local_container_name()),
+				  sexp_empty_bytes, sexp_empty_bytes,
+				  sexp_empty_bytes, sexp_empty_bytes);
+    INCREF(s);
+    sexp_write(r->outh, s);
+    DECREF(s, sexp_destructor);
+  }
+
+  //iohandle_settimeout(r->inh, 3, 0);
+
+  while (1) {
+    DECREF(message, sexp_destructor);
+    message = NULL;
+    if (!sexp_read(inh, &message)) goto network_error;
+    INCREF(message);
+
+#if WANT_MESSAGE_TRACE
+    info("fd %d --> ", r->fd);
+    sexp_writeln(stderr_h, message);
+#endif
+
+    if (parse_post(message, &p) && sexp_stringp(p.post.name)) {
+      cmsg_bytes_t nodename = sexp_data(p.post.name);
+      if (!send_node(nodename, p.post.body)) {
+	warn("Was asked to post to unknown node <<%.*s>>\n", nodename.len, nodename.bytes);
+      }
+    } else if (parse_subscribe(message, &p)
+	       && sexp_stringp(p.subscribe.filter)
+	       && sexp_stringp(p.subscribe.reply_sink)
+	       && sexp_stringp(p.subscribe.reply_name)) {
+      if (bind_node(sexp_data(p.subscribe.filter), n)) {
+	post_node(sexp_data(p.subscribe.reply_sink),
+		  sexp_data(p.subscribe.reply_name),
+		  message_subscribe_ok(p.subscribe.filter),
+		  sexp_empty_bytes);
+
+	DECREF(r->remote_container_name, sexp_destructor);
+	r->remote_container_name = INCREF(p.subscribe.filter);
+      } else {
+	cmsg_bytes_t filter = sexp_data(p.subscribe.filter);
+	warn("Bind failed <<%.*s>>\n", filter.len, filter.bytes);
+      }
+    } else if (parse_unsubscribe(message, &p)
+	       && sexp_stringp(p.unsubscribe.token)) {
+      cmsg_bytes_t id = sexp_data(p.unsubscribe.token);
+      if (!unbind_node(id)) {
+	warn("Unbind failed <<%.*s>>\n", id.len, id.bytes);
+      }
+    } else {
+      send_error(r->outh, "message not understood", message);
+      goto protocol_error;
+    }
+  }
+
+ network_error:
+  if (inh->eof) {
+    info("Disconnecting fd %d normally.\n", r->fd);
+  } else {
+    switch (inh->error_kind) {
+      case SEXP_ERROR_OVERFLOW:
+	send_sexp_syntax_error(r->outh, "sexp too big");
+	break;
+
+      case SEXP_ERROR_SYNTAX:
+	send_sexp_syntax_error(r->outh, "sexp syntax error");
+	break;
+
+      default:
+	warn("Relay handle error 0x%04X on fd %d: %d, %s\n",
+	     inh->error_kind, r->fd, inh->error_errno, strerror(inh->error_errno));
+	break;
+    }
+  }
+
+ protocol_error:
+  DECREF(message, sexp_destructor);
+  delete_iohandle(inh);
+  unbind_all_names_for_node(n);
+  DECREF(n, node_destructor);
+
+  connection_count--;
+}
+
+void start_relay(struct sockaddr_in const *peername, int fd) {
+  node_t *n = new_node(&relay_class, NULL, NULL);
+  relay_extension_t *r = n->extension;
+  r->peername = *peername;
+  endpoint_name(&r->peername, CMSG_BYTES(sizeof(r->peername_str), r->peername_str));
+  r->remote_container_name = NULL;
+  r->fd = fd;
+  r->outh = new_iohandle(r->fd);
+  spawn((process_main_t) relay_main, n);
+}

experiments/cmsg/relay.h

@@ -0,0 +1,25 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_relay_h
+#define cmsg_relay_h
+
+extern void init_relay(void);
+
+extern void start_relay(struct sockaddr_in const *peername, int fd);
+
+#endif

experiments/cmsg/sexp.c

@@ -0,0 +1,255 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+
+#include <assert.h>
+
+#include "cmsg_private.h"
+#include "ref.h"
+#include "sexp.h"
+
+static sexp_t *freelist = NULL;
+
+sexp_t *sexp_empty_bytes = NULL;
+
+void init_sexp(void) {
+  sexp_empty_bytes = INCREF(sexp_cstring(""));
+}
+
+void done_sexp(void) {
+  int count = 0;
+
+  DECREF(sexp_empty_bytes, sexp_destructor);
+  sexp_empty_bytes = NULL;
+
+  while (freelist != NULL) {
+    sexp_t *x = freelist;
+    freelist = x->data.pair.tail;
+    free(x);
+    count++;
+  }
+  info("Released %d cached sexp shells.\n", count);
+}
+
+static inline sexp_t *alloc_shell(sexp_type_t kind) {
+  sexp_t *x = freelist;
+  if (x == NULL) {
+    x = malloc(sizeof(*x));
+  } else {
+    freelist = x->data.pair.tail;
+  }
+  x->refcount = ZERO_REFCOUNT();
+  x->kind = kind;
+  return x;
+}
+
+static inline void release_shell(sexp_t *x) {
+  x->data.pair.tail = freelist;
+  freelist = x;
+}
+
+sexp_t *sexp_incref(sexp_t *x) {
+  return INCREF(x);
+}
+
+sexp_t *sexp_decref(sexp_t *x) {
+  return DECREF(x, sexp_destructor);
+}
+
+void sexp_data_destructor(sexp_data_t *data) {
+  cmsg_bytes_free(data->data);
+  free(data);
+}
+
+void sexp_destructor(sexp_t *x) {
+ tail_recursion:
+  switch (x->kind) {
+    case SEXP_BYTES:
+      cmsg_bytes_free(x->data.bytes);
+      break;
+    case SEXP_SLICE:
+      DECREF(x->data.slice.data, sexp_data_destructor);
+      break;
+    case SEXP_DISPLAY_HINT:
+    case SEXP_PAIR: {
+      sexp_t *next = x->data.pair.tail;
+      DECREF(x->data.pair.head, sexp_destructor);
+      if (next != NULL) {
+	if (next->refcount.count == 1) {
+	  release_shell(x);
+	  x = next;
+	  goto tail_recursion;
+	} else {
+	  DECREF(next, sexp_destructor);
+	}
+      }
+      break;
+    }
+    default:
+      die("Unknown sexp kind %d in dtor\n", x->kind);
+  }
+  release_shell(x);
+}
+
+sexp_data_t *sexp_data_copy(cmsg_bytes_t body, size_t offset, size_t length) {
+  assert(offset + length <= body.len);
+  return sexp_data_alias(cmsg_bytes_malloc_dup(CMSG_BYTES(length, body.bytes + offset)));
+}
+
+sexp_data_t *sexp_data_alias(cmsg_bytes_t body) {
+  sexp_data_t *data = malloc(sizeof(*data));
+  data->refcount = ZERO_REFCOUNT();
+  data->data = body;
+  return data;
+}
+
+sexp_t *sexp_cstring(char const *str) {
+  return sexp_bytes(cmsg_cstring_bytes(str));
+}
+
+sexp_t *sexp_bytes(cmsg_bytes_t bytes) {
+  sexp_t *x = alloc_shell(SEXP_BYTES);
+  x->data.bytes = cmsg_bytes_malloc_dup(bytes);
+  return x;
+}
+
+sexp_t *sexp_slice(sexp_data_t *data, size_t offset, size_t length) {
+  sexp_t *x = alloc_shell(SEXP_SLICE);
+  x->data.slice.data = INCREF(data);
+  x->data.slice.offset = offset;
+  x->data.slice.length = length;
+  return x;
+}
+
+sexp_t *sexp_display_hint(sexp_t *hint, sexp_t *body) {
+  sexp_t *x = alloc_shell(SEXP_DISPLAY_HINT);
+  assert(sexp_simple_stringp(hint));
+  assert(sexp_simple_stringp(body));
+  x->data.pair.head = INCREF(hint);
+  x->data.pair.tail = INCREF(body);
+  return x;
+}
+
+sexp_t *sexp_cons(sexp_t *head, sexp_t *tail) {
+  sexp_t *x = alloc_shell(SEXP_PAIR);
+  x->data.pair.head = INCREF(head);
+  x->data.pair.tail = INCREF(tail);
+  return x;
+}
+
+cmsg_bytes_t sexp_data(sexp_t *x) {
+ restart:
+  switch (x->kind) {
+    case SEXP_BYTES:
+      return x->data.bytes;
+    case SEXP_SLICE:
+      return CMSG_BYTES(x->data.slice.length,
+			x->data.slice.data->data.bytes + x->data.slice.offset);
+    case SEXP_DISPLAY_HINT:
+      x = x->data.pair.tail;
+      goto restart;
+    default:
+      die("Unknown sexp kind %d in data accessor\n", x->kind);
+  }
+}
+
+int sexp_cmp(sexp_t *a, sexp_t *b) {
+ tail:
+  if (a == b) return 0;
+  if (sexp_stringp(a) && sexp_stringp(b)) {
+    return cmsg_bytes_cmp(sexp_data(a), sexp_data(b));
+  }
+  if (sexp_pairp(a) && sexp_pairp(b)) {
+    int result = sexp_cmp(sexp_head(a), sexp_head(b));
+    if (result) return result;
+    a = sexp_tail(a);
+    b = sexp_tail(b);
+    goto tail;
+  }
+  if (a == NULL) return -1;
+  if (b == NULL) return 1;
+  if (a->kind < b->kind) return -1;
+  return 1;
+}
+
+sexp_t *sexp_assoc(sexp_t *list, cmsg_bytes_t key) {
+  while (list != NULL) {
+    sexp_t *candidate = sexp_head(list);
+    if (sexp_stringp(candidate)) {
+      cmsg_bytes_t candidate_data = sexp_data(candidate);
+      if ((candidate_data.len == key.len)
+	  && (!memcmp(candidate_data.bytes, key.bytes, key.len))) {
+	return candidate;
+      }
+    }
+    list = sexp_tail(list);
+  }
+  return NULL;
+}
+
+size_t sexp_length(sexp_t *list) {
+  size_t result = 0;
+  while (sexp_pairp(list)) {
+    result++;
+    list = sexp_tail(list);
+  }
+  return result;
+}
+
+sexp_t *sexp_new_queue(void) {
+  return sexp_cons(NULL, NULL);
+}
+
+int sexp_queue_emptyp(sexp_t *q) {
+  return sexp_head(q) == NULL;
+}
+
+void sexp_queue_pushback(sexp_t *q, sexp_t *x) {
+  sexp_t *cell = sexp_cons(x, sexp_head(q));
+  if (sexp_head(q) == NULL) {
+    sexp_settail(q, cell);
+  }
+  sexp_sethead(q, cell);
+}
+
+void sexp_enqueue(sexp_t *q, sexp_t *x) {
+  sexp_t *cell = sexp_cons(x, NULL);
+  if (sexp_head(q) == NULL) {
+    sexp_sethead(q, cell);
+  } else {
+    sexp_settail(sexp_tail(q), cell);
+  }
+  sexp_settail(q, cell);
+}
+
+sexp_t *sexp_dequeue(sexp_t *q) {
+  if (sexp_head(q) == NULL) {
+    return NULL;
+  } else {
+    sexp_t *x = INCREF(sexp_head(sexp_head(q)));
+    sexp_t *cell = sexp_tail(sexp_head(q));
+    sexp_sethead(q, cell);
+    if (cell == NULL) {
+      sexp_settail(q, NULL);
+    }
+    UNGRAB(x);
+    return x;
+  }
+}

experiments/cmsg/sexp.h

@@ -0,0 +1,162 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_sexp_h
+#define cmsg_sexp_h
+
+typedef struct sexp_data_t_ {
+  refcount_t refcount;
+  cmsg_bytes_t data;
+} sexp_data_t;
+
+typedef enum sexp_type_t_ {
+  SEXP_BYTES,
+  SEXP_SLICE,
+  SEXP_DISPLAY_HINT,
+  SEXP_PAIR
+} sexp_type_t;
+
+typedef struct sexp_t_ {
+  refcount_t refcount;
+  sexp_type_t kind;
+  union {
+    cmsg_bytes_t bytes;
+    struct {
+      sexp_data_t *data;
+      size_t offset;
+      size_t length;
+    } slice;
+    struct {
+      struct sexp_t_ *head;
+      struct sexp_t_ *tail;
+    } pair; /* and display-hint */
+  } data;
+} sexp_t;
+
+extern sexp_t *sexp_empty_bytes;
+
+extern void init_sexp(void);
+extern void done_sexp(void);
+
+extern sexp_t *sexp_incref(sexp_t *x);
+extern sexp_t *sexp_decref(sexp_t *x);
+
+extern void sexp_data_destructor(sexp_data_t *data);
+extern void sexp_destructor(sexp_t *x);
+
+extern sexp_data_t *sexp_data_copy(cmsg_bytes_t body, size_t offset, size_t length);
+extern sexp_data_t *sexp_data_alias(cmsg_bytes_t body);
+
+extern sexp_t *sexp_cstring(char const *str);
+extern sexp_t *sexp_bytes(cmsg_bytes_t bytes);
+extern sexp_t *sexp_slice(sexp_data_t *data, size_t offset, size_t length);
+extern sexp_t *sexp_display_hint(sexp_t *hint, sexp_t *body);
+extern sexp_t *sexp_cons(sexp_t *head, sexp_t *tail);
+
+static inline int sexp_simple_stringp(sexp_t *x) {
+  return (x != NULL) && ((x->kind == SEXP_BYTES) || (x->kind == SEXP_SLICE));
+}
+
+static inline int sexp_stringp(sexp_t *x) {
+  return sexp_simple_stringp(x) || ((x != NULL) && (x->kind == SEXP_DISPLAY_HINT));
+}
+
+static inline int sexp_pairp(sexp_t *x) {
+  return (x != NULL) && (x->kind == SEXP_PAIR);
+}
+
+extern cmsg_bytes_t sexp_data(sexp_t *x);
+extern int sexp_cmp(sexp_t *a, sexp_t *b);
+
+static inline sexp_t *sexp_head(sexp_t *x) {
+  assert(x->kind == SEXP_PAIR);
+  return x->data.pair.head;
+}
+
+static inline sexp_t *sexp_tail(sexp_t *x) {
+  assert(x->kind == SEXP_PAIR);
+  return x->data.pair.tail;
+}
+
+static inline sexp_t *sexp_hint(sexp_t *x) {
+  assert(x->kind == SEXP_DISPLAY_HINT);
+  return x->data.pair.head;
+}
+
+static inline sexp_t *sexp_body(sexp_t *x) {
+  assert(x->kind == SEXP_DISPLAY_HINT);
+  return x->data.pair.tail;
+}
+
+#define sexp_setter_(settername,fieldname)			\
+  static inline sexp_t *settername(sexp_t *x, sexp_t *y) {	\
+    sexp_t *old;						\
+    assert(x->kind == SEXP_PAIR);				\
+    INCREF(y);							\
+    old = x->data.pair.fieldname;				\
+    x->data.pair.fieldname = y;					\
+    DECREF(old, sexp_destructor);				\
+    return x;							\
+  }
+
+sexp_setter_(sexp_sethead, head)
+sexp_setter_(sexp_settail, tail)
+
+static inline sexp_t *sexp_push(sexp_t *oldstack, sexp_t *val) {
+  sexp_t *newstack = INCREF(sexp_cons(val, oldstack));
+  DECREF(oldstack, sexp_destructor);
+  return newstack;
+}
+
+static inline sexp_t *sexp_pop(sexp_t *oldstack, sexp_t **valp) {
+  sexp_t *nextstack = INCREF(sexp_tail(oldstack));
+  sexp_t *val = INCREF(sexp_head(oldstack));
+  DECREF(oldstack, sexp_destructor);
+  UNGRAB(val);
+  if (valp != NULL) {
+    *valp = val;
+  }
+  return nextstack;
+}
+
+static inline int sexp_pseudo_pop(sexp_t **px) {
+  *px = sexp_tail(*px);
+  return sexp_pairp(*px);
+}
+
+static inline sexp_t *sexp_listtail(sexp_t *list, size_t dropcount) {
+  while (dropcount) {
+    list = sexp_tail(list);
+    dropcount--;
+  }
+  return list;
+}
+
+static inline sexp_t *sexp_listref(sexp_t *list, size_t index) {
+  return sexp_head(sexp_listtail(list, index));
+}
+
+extern sexp_t *sexp_assoc(sexp_t *list, cmsg_bytes_t key);
+extern size_t sexp_length(sexp_t *list);
+
+extern sexp_t *sexp_new_queue(void);
+extern int sexp_queue_emptyp(sexp_t *q);
+extern void sexp_queue_pushback(sexp_t *q, sexp_t *x);
+extern void sexp_enqueue(sexp_t *q, sexp_t *x);
+extern sexp_t *sexp_dequeue(sexp_t *q);
+
+#endif

experiments/cmsg/sexpio.c

@@ -0,0 +1,247 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <ctype.h>
+
+#include <assert.h>
+
+#include <ucontext.h>
+
+#include "cmsg_private.h"
+#include "ref.h"
+#include "sexp.h"
+#include "harness.h"
+#include "sexpio.h"
+
+/* TODO: limit size of individual simple strings */
+/* TODO: limit nesting of sexps */
+
+static sexp_t *read_simple_string(IOHandle *h, cmsg_bytes_t buf) {
+  int i = 0;
+  sexp_t *result;
+
+  while (1) {
+    buf = iohandle_readwait(h, buf.len + 1);
+    if (buf.len == 0) return NULL;
+    /* Don't reset i to zero: avoids scanning the beginning of the
+       number repeatedly */
+
+    while (i < buf.len) {
+      if (i > 10) {
+	/* More than ten digits of length prefix. We're unlikely to be
+	   able to cope with anything that large. */
+	h->error_kind = SEXP_ERROR_OVERFLOW;
+	return NULL;
+      }
+      if (buf.bytes[i] == ':') {
+	size_t count;
+	buf.bytes[i] = '\0';
+	count = atoi((char *) buf.bytes);
+	iohandle_drain(h, i + 1);
+	buf = iohandle_readwait(h, count);
+	if (buf.len < count) {
+	  /* Error or EOF. */
+	  return NULL;
+	}
+	buf.len = count;
+	result = sexp_bytes(buf);
+	iohandle_drain(h, count);
+	return result;
+      }
+
+      if (!isdigit(buf.bytes[i])) {
+	h->error_kind = SEXP_ERROR_SYNTAX;
+	return NULL;
+      }
+
+      i++;
+    }
+  }
+}
+
+sexp_t *sexp_read_atom(IOHandle *h) {
+  return read_simple_string(h, EMPTY_BYTES);
+}
+
+#define READ1					\
+  buf = iohandle_readwait(h, 1);		\
+  if (buf.len == 0) goto error;
+
+int sexp_read(IOHandle *h, sexp_t **result_ptr) {
+  cmsg_bytes_t buf;
+  sexp_t *stack = NULL; /* held */
+  sexp_t *hint = NULL; /* held */
+  sexp_t *body = NULL; /* held */
+  sexp_t *accumulator = NULL; /* not held */
+
+  while (1) {
+    READ1;
+    switch (buf.bytes[0]) {
+      case '[': {
+	iohandle_drain(h, 1);
+	hint = INCREF(read_simple_string(h, EMPTY_BYTES));
+	if (hint == NULL) goto error;
+	READ1;
+	if (buf.bytes[0] != ']') {
+	  h->error_kind = SEXP_ERROR_SYNTAX;
+	  goto error;
+	}
+	iohandle_drain(h, 1);
+      skip_whitespace_in_display_hint:
+	READ1;
+	if (isspace(buf.bytes[0])) {
+	  iohandle_drain(h, 1);
+	  goto skip_whitespace_in_display_hint;
+	}
+	body = INCREF(read_simple_string(h, EMPTY_BYTES));
+	if (body == NULL) goto error;
+	accumulator = sexp_display_hint(hint, body);
+	DECREF(hint, sexp_destructor); /* these could be UNGRABs */
+	DECREF(body, sexp_destructor);
+	break;
+      }
+
+      case '(':
+	iohandle_drain(h, 1);
+	stack = sexp_push(stack, sexp_cons(NULL, NULL));
+	continue;
+
+      case ')': {
+	sexp_t *current;
+	if (stack == NULL) {
+	  h->error_kind = SEXP_ERROR_SYNTAX;
+	  goto error;
+	}
+	stack = sexp_pop(stack, &current);
+	INCREF(current);
+	iohandle_drain(h, 1);
+	accumulator = INCREF(sexp_head(current));
+	DECREF(current, sexp_destructor);
+	UNGRAB(accumulator);
+	break;
+      }
+
+      default:
+	if (isspace(buf.bytes[0])) {
+	  iohandle_drain(h, 1);
+	  continue;
+	}
+	buf.len = 1; /* needed to avoid reading too much in read_simple_string */
+	accumulator = read_simple_string(h, buf);
+	if (accumulator == NULL) goto error;
+	break;
+    }
+
+    if (stack == NULL) {
+      *result_ptr = accumulator;
+      return 1;
+    } else {
+      sexp_t *current = sexp_head(stack); /* not held */
+      sexp_t *cell = sexp_cons(accumulator, NULL);
+      if (sexp_tail(current) == NULL) {
+	sexp_sethead(current, cell);
+      } else {
+	sexp_settail(sexp_tail(current), cell);
+      }
+      sexp_settail(current, cell);
+    }
+  }
+
+ error:
+  DECREF(stack, sexp_destructor);
+  DECREF(hint, sexp_destructor);
+  DECREF(body, sexp_destructor);
+  return 0;
+}
+
+void write_simple_string(IOHandle *h, sexp_t *x) {
+  cmsg_bytes_t data = sexp_data(x);
+  char lenstr[16];
+  snprintf(lenstr, sizeof(lenstr), "%u:", (unsigned int) data.len);
+  lenstr[sizeof(lenstr) - 1] = '\0';
+  iohandle_write(h, cmsg_cstring_bytes(lenstr));
+  iohandle_write(h, data);
+}
+
+unsigned short sexp_write(IOHandle *h, sexp_t *x) {
+  sexp_t *stack = NULL; /* held */
+  sexp_t *current = x;
+
+ write1:
+  if (current == NULL) {
+    iohandle_write(h, cmsg_cstring_bytes("()"));
+  } else {
+    switch (current->kind) {
+      case SEXP_BYTES:
+      case SEXP_SLICE:
+	write_simple_string(h, current);
+	break;
+
+      case SEXP_DISPLAY_HINT:
+	iohandle_write(h, cmsg_cstring_bytes("["));
+	write_simple_string(h, sexp_hint(current));
+	iohandle_write(h, cmsg_cstring_bytes("]"));
+	write_simple_string(h, sexp_body(current));
+	break;
+
+      case SEXP_PAIR:
+	iohandle_write(h, cmsg_cstring_bytes("("));
+	stack = sexp_push(stack, current);
+	break;
+
+      default:
+	die("Unknown sexp kind %d in sexp_write\n", current->kind);
+    }
+  }
+
+ check_stack:
+  if (stack == NULL) {
+    return 0;
+  }
+
+  {
+    sexp_t *cell = sexp_head(stack);
+    if (cell == NULL) {
+      iohandle_write(h, cmsg_cstring_bytes(")"));
+      stack = sexp_pop(stack, NULL); /* no need to worry about incref/decref: val is NULL! */
+      goto check_stack;
+    }
+
+    if (sexp_pairp(cell)) {
+      current = sexp_head(cell);
+      sexp_sethead(stack, sexp_tail(cell));
+      goto write1;
+    }
+
+    return SEXP_ERROR_SYNTAX;
+  }
+}
+
+unsigned short sexp_writeln(IOHandle *h, sexp_t *x) {
+  unsigned short result;
+
+  fflush(NULL);
+  result = sexp_write(h, x);
+  if (result == 0) {
+    iohandle_write(h, cmsg_cstring_bytes("\n"));
+    ICHECK(iohandle_flush(h), "sexp_writeln iohandle_flush");
+  }
+  return result;
+}

experiments/cmsg/sexpio.h

@@ -0,0 +1,29 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_sexpio_h
+#define cmsg_sexpio_h
+
+#define SEXP_ERROR_OVERFLOW	0x8000
+#define SEXP_ERROR_SYNTAX	0x8001
+
+extern sexp_t *sexp_read_atom(IOHandle *h);
+extern int sexp_read(IOHandle *h, sexp_t **result_ptr);
+extern unsigned short sexp_write(IOHandle *h, sexp_t *x);
+extern unsigned short sexp_writeln(IOHandle *h, sexp_t *x);
+
+#endif

experiments/cmsg/subscription.c

@@ -0,0 +1,158 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <errno.h>
+#include <stdint.h>
+#include <stddef.h>
+
+#include <assert.h>
+
+#include <ucontext.h>
+
+#include "cmsg_private.h"
+#include "ref.h"
+#include "sexp.h"
+#include "hashtable.h"
+#include "node.h"
+#include "meta.h"
+#include "messages.h"
+#include "subscription.h"
+
+void free_subscription(subscription_t *sub) {
+  DECREF(sub->uuid, sexp_destructor);
+  DECREF(sub->filter, sexp_destructor);
+  DECREF(sub->sink, sexp_destructor);
+  DECREF(sub->name, sexp_destructor);
+  free(sub);
+}
+
+void free_subscription_chain(subscription_t *chain) {
+  while (chain != NULL) {
+    subscription_t *next = chain->link;
+    free_subscription(chain);
+    chain = next;
+  }
+}
+
+/* Returns true if the subscription has not been unsubscribed and the
+   destination of the subscription exists. */
+int send_to_subscription(sexp_t *source,
+			 hashtable_t *subscriptions,
+			 subscription_t *sub,
+			 sexp_t *body)
+{
+  if (sub->uuid == NULL) {
+    free_subscription(sub);
+    return 0;
+  } else if (!post_node(sexp_data(sub->sink), sexp_data(sub->name), body, sub->uuid)) {
+    announce_subscription(source, sub->filter, sub->sink, sub->name, 0);
+    hashtable_erase(subscriptions, sexp_data(sub->uuid));
+    free_subscription(sub);
+    return 0;
+  } else {
+    return 1;
+  }
+}
+
+subscription_t *send_to_subscription_chain(sexp_t *source,
+					   hashtable_t *subscriptions,
+					   subscription_t *chain,
+					   sexp_t *body)
+{
+  subscription_t *top = chain;
+  subscription_t *prev = NULL;
+  while (chain != NULL) {
+    subscription_t *next = chain->link;
+    if (!send_to_subscription(source, subscriptions, chain, body)) {
+      if (prev == NULL) {
+	top = next;
+      } else {
+	prev->link = next;
+      }
+    }
+    prev = chain;
+    chain = next;
+  }
+  return top;
+}
+
+subscription_t *handle_subscribe_message(sexp_t *source,
+					 hashtable_t *subscriptions,
+					 parsed_message_t *p)
+{
+  unsigned char uuid[CMSG_UUID_BUF_SIZE];
+  if (gen_uuid(uuid) != 0) {
+    warn("Could not generate UUID\n");
+    return NULL;
+  } else {
+    subscription_t *sub = malloc(sizeof(*sub));
+
+    sub->uuid = INCREF(sexp_bytes(CMSG_BYTES(sizeof(uuid), uuid)));
+    sub->filter = p->subscribe.filter;
+    sub->sink = p->subscribe.sink;
+    sub->name = p->subscribe.name;
+    sub->link = NULL;
+
+    if (!sexp_stringp(sub->filter) || !sexp_stringp(sub->sink) || !sexp_stringp(sub->name)
+	|| !sexp_stringp(p->subscribe.reply_sink) || !sexp_stringp(p->subscribe.reply_name)) {
+      DECREF(sub->uuid, sexp_destructor);
+      free(sub);
+      warn("Bad sink/name/reply_sink/reply_name in subscribe");
+      return NULL;
+    }
+
+    INCREF(sub->filter);
+    INCREF(sub->sink);
+    INCREF(sub->name);
+
+    hashtable_put(subscriptions, sexp_data(sub->uuid), sub);
+
+    announce_subscription(source, sub->filter, sub->sink, sub->name, 1);
+
+    post_node(sexp_data(p->subscribe.reply_sink),
+	      sexp_data(p->subscribe.reply_name),
+	      message_subscribe_ok(sub->uuid),
+	      sexp_empty_bytes);
+
+    return sub;
+  }
+}
+
+void handle_unsubscribe_message(sexp_t *source,
+				hashtable_t *subscriptions,
+				parsed_message_t *p)
+{
+  cmsg_bytes_t uuid;
+  subscription_t *sub;
+
+  if (!sexp_stringp(p->unsubscribe.token)) {
+    warn("Invalid unsubscription\n");
+    return;
+  }
+
+  uuid = sexp_data(p->unsubscribe.token);
+  if (hashtable_get(subscriptions, uuid, (void **) &sub)) {
+    /* TODO: clean up more eagerly perhaps? */
+    announce_subscription(source, sub->filter, sub->sink, sub->name, 0);
+    DECREF(sub->uuid, sexp_destructor);
+    sub->uuid = NULL;
+    hashtable_erase(subscriptions, uuid);
+  }
+}

experiments/cmsg/subscription.h

@@ -0,0 +1,49 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef cmsg_subscription_h
+#define cmsg_subscription_h
+
+typedef struct subscription_t_ {
+  sexp_t *uuid;
+  sexp_t *filter;
+  sexp_t *sink;
+  sexp_t *name;
+  struct subscription_t_ *link;
+} subscription_t;
+
+extern void free_subscription(subscription_t *sub);
+extern void free_subscription_chain(subscription_t *chain);
+
+extern int send_to_subscription(sexp_t *source,
+				hashtable_t *subscriptions,
+				subscription_t *sub,
+				sexp_t *body);
+extern subscription_t *send_to_subscription_chain(sexp_t *source,
+						  hashtable_t *subscriptions,
+						  subscription_t *chain,
+						  sexp_t *body);
+
+extern subscription_t *handle_subscribe_message(sexp_t *source,
+						hashtable_t *subscriptions,
+						parsed_message_t *p);
+
+extern void handle_unsubscribe_message(sexp_t *source,
+				       hashtable_t *subscriptions,
+				       parsed_message_t *p);
+
+#endif

experiments/cmsg/util.c

@@ -0,0 +1,113 @@
+/* Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+ *
+ * This file is part of Hop.
+ *
+ * Hop is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Hop is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+
+#include <assert.h>
+#include <stdarg.h>
+
+/* OSSP UUID */
+#include <uuid.h>
+
+#include "cmsg_private.h"
+
+#define UUID_CHECK(context)					\
+  if (result != UUID_RC_OK) {					\
+    warn("gen_uuid failed with %d at %s\n", result, context);	\
+    return result;						\
+  }
+
+int gen_uuid(unsigned char *uuid_buf) {
+  uuid_rc_t result;
+  uuid_t *uuid;
+  unsigned char temp_buf[UUID_LEN_STR + 1];
+  unsigned char *temp_buf_ptr = &temp_buf[0]; /* odd API */
+  size_t uuid_buf_len = UUID_LEN_STR + 1;
+
+  assert(CMSG_UUID_BUF_SIZE == UUID_LEN_STR);
+
+  result = uuid_create(&uuid);
+  UUID_CHECK("uuid_create");
+
+  result = uuid_make(uuid, UUID_MAKE_V4);
+  UUID_CHECK("uuid_make");
+
+  result = uuid_export(uuid, UUID_FMT_STR, &temp_buf_ptr, &uuid_buf_len);
+  UUID_CHECK("uuid_export");
+  assert(uuid_buf_len == (UUID_LEN_STR + 1));
+
+  memcpy(uuid_buf, temp_buf, CMSG_UUID_BUF_SIZE);
+
+  result = uuid_destroy(uuid);
+  UUID_CHECK("uuid_destroy");
+
+  return UUID_RC_OK;
+}
+
+cmsg_bytes_t cmsg_bytes_malloc_dup(cmsg_bytes_t src) {
+  cmsg_bytes_t result;
+  result.len = src.len;
+  result.bytes = malloc(src.len);
+  if (result.bytes != NULL) {
+    memcpy(result.bytes, src.bytes, src.len);
+  }
+  return result;
+}
+
+cmsg_bytes_t cmsg_bytes_malloc(size_t amount) {
+  cmsg_bytes_t result;
+  result.len = amount;
+  result.bytes = malloc(amount);
+  return result;
+}
+
+void cmsg_bytes_free(cmsg_bytes_t bytes) {
+  free(bytes.bytes);
+}
+
+int cmsg_bytes_cmp(cmsg_bytes_t a, cmsg_bytes_t b) {
+  if (a.len < b.len) return -1;
+  if (a.len > b.len) return 1;
+  return memcmp(a.bytes, b.bytes, a.len);
+}
+
+void die(char const *format, ...) {
+  va_list vl;
+  va_start(vl, format);
+  fprintf(stderr, "ERROR: ");
+  vfprintf(stderr, format, vl);
+  va_end(vl);
+  exit(1);
+}
+
+void warn(char const *format, ...) {
+  va_list vl;
+  va_start(vl, format);
+  fprintf(stderr, "WARNING: ");
+  vfprintf(stderr, format, vl);
+  va_end(vl);
+}
+
+void info(char const *format, ...) {
+  va_list vl;
+  va_start(vl, format);
+  fprintf(stderr, "INFO: ");
+  vfprintf(stderr, format, vl);
+  va_end(vl);
+}

experiments/erlang/.gitignore

@@ -0,0 +1,2 @@
+ebin
+erl_crash.dump

experiments/erlang/Makefile

@@ -0,0 +1,17 @@
+all: compile
+
+compile:
+	./rebar compile
+
+clean:
+	./rebar clean
+	-rmdir ebin
+
+veryclean: clean
+	rm -rf rel
+	rm -f erl_crash.dump
+
+run: compile
+	erl -pa ebin \
+		-boot start_sasl \
+		-run hop_demo start 5671

experiments/erlang/include/hop.hrl

@@ -0,0 +1,18 @@
+%% Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+%%
+%% This file is part of Hop.
+%%
+%% Hop is free software: you can redistribute it and/or modify it
+%% under the terms of the GNU General Public License as published by
+%% the Free Software Foundation, either version 3 of the License, or
+%% (at your option) any later version.
+%%
+%% Hop is distributed in the hope that it will be useful, but WITHOUT
+%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+%% or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+%% License for more details.
+%%
+%% You should have received a copy of the GNU General Public License
+%% along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+-record(hop_sub, {ref, filter, sink, name}).

experiments/erlang/src/hop.app.src

@@ -0,0 +1,8 @@
+%% -*- erlang -*-
+{application, hop,
+ [{description, "Hop"},
+  {vsn, "0.0.1"},
+  {registered, []},
+  {applications, [kernel,
+                  stdlib]},
+  {env, []}]}.

experiments/erlang/src/hop.erl

@@ -0,0 +1,61 @@
+%% Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+%%
+%% This file is part of Hop.
+%%
+%% Hop is free software: you can redistribute it and/or modify it
+%% under the terms of the GNU General Public License as published by
+%% the Free Software Foundation, either version 3 of the License, or
+%% (at your option) any later version.
+%%
+%% Hop is distributed in the hope that it will be useful, but WITHOUT
+%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+%% or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+%% License for more details.
+%%
+%% You should have received a copy of the GNU General Public License
+%% along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+-module(hop).
+
+-export([name/0, register_idempotent/3, class_of/1, send/2, post/4]).
+
+name() ->
+    list_to_binary(atom_to_list(node())).
+
+register_idempotent(Name, Pid, ClassModule) ->
+    case global:register_name(Name, Pid) of
+        yes ->
+            ok;
+        no ->
+            case class_of(Name) of
+                undefined ->
+                    register_idempotent(Name, Pid, ClassModule);
+                ClassModule ->
+                    ok;
+                _ ->
+                    {error, <<"class-mismatch">>}
+            end
+    end.
+
+class_of(Name) ->
+    case global:whereis_name(Name) of
+        undefined ->
+            undefined;
+        Pid ->
+            gen_server:call(Pid, hop_class_module)
+    end.
+
+send(<<>>, _Body) ->
+    ok;
+send(Name, Body) ->
+    case global:whereis_name(Name) of
+        undefined ->
+            error_logger:warning_report({?MODULE, send, undefined_name, Name}),
+            false;
+        Pid ->
+            Pid ! {hop, Body},
+            true
+    end.
+
+post(Sink, Name, Body, Token) ->
+    send(Sink, [<<"post">>, Name, Body, Token]).

experiments/erlang/src/hop_demo.erl

@@ -0,0 +1,27 @@
+%% Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+%%
+%% This file is part of Hop.
+%%
+%% Hop is free software: you can redistribute it and/or modify it
+%% under the terms of the GNU General Public License as published by
+%% the Free Software Foundation, either version 3 of the License, or
+%% (at your option) any later version.
+%%
+%% Hop is distributed in the hope that it will be useful, but WITHOUT
+%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+%% or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+%% License for more details.
+%%
+%% You should have received a copy of the GNU General Public License
+%% along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+-module(hop_demo).
+
+-export([start/1]).
+
+start([Port]) ->
+    hop_factory:start_link([]),
+    ok = hop_factory:register_class(<<"queue">>, hop_queue),
+    hop_server:start_link(hop_relay, "0.0.0.0", list_to_integer(Port),
+                          [{reuseaddr, true}, {active, false}],
+                          []).

experiments/erlang/src/hop_factory.erl

@@ -0,0 +1,80 @@
+%% Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+%%
+%% This file is part of Hop.
+%%
+%% Hop is free software: you can redistribute it and/or modify it
+%% under the terms of the GNU General Public License as published by
+%% the Free Software Foundation, either version 3 of the License, or
+%% (at your option) any later version.
+%%
+%% Hop is distributed in the hope that it will be useful, but WITHOUT
+%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+%% or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+%% License for more details.
+%%
+%% You should have received a copy of the GNU General Public License
+%% along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+-module(hop_factory).
+
+-behaviour(gen_server).
+-export([init/1, terminate/2, code_change/3, handle_call/3, handle_cast/2, handle_info/2]).
+
+-export([start_link/1, register_class/2]).
+
+start_link(Args) ->
+    gen_server:start_link({local, ?MODULE}, ?MODULE, Args, []).
+
+register_class(ClassName, ClassModule) ->
+    gen_server:call(?MODULE, {register_class, ClassName, ClassModule}).
+
+%%---------------------------------------------------------------------------
+
+-record(state, {classes}).
+
+init([]) ->
+    yes = global:register_name(<<"factory">>, self()),
+    {ok, #state{classes = []}}.
+
+terminate(_Reason, _State) ->
+    ok.
+
+code_change(_OldVsn, State, _Extra) ->
+    {ok, State}.
+
+handle_call({register_class, ClassName, ClassModule}, _From, State = #state{classes = Classes}) ->
+    {reply, ok, State#state{classes = [{ClassName, ClassModule} | Classes]}};
+handle_call(_Request, _From, State) ->
+    {stop, {bad_call, _Request}, State}.
+
+handle_cast(_Request, State) ->
+    {stop, {bad_cast, _Request}, State}.
+
+handle_info({hop, Sexp}, State = #state{classes = Classes}) ->
+    case Sexp of
+        [<<"create">>, ClassName, Arg, ReplySink, ReplyName] ->
+            Reply =
+                case lists:keysearch(ClassName, 1, Classes) of
+                    false ->
+                        error_logger:warning_report({?MODULE, class_not_found, ClassName}),
+                        [<<"create-failed">>, [<<"factory">>, <<"class-not-found">>]];
+                    {value, {_, ClassModule}} ->
+                        case catch ClassModule:hop_create(Arg) of
+                            {ok, Info} ->
+                                [<<"create-ok">>, Info];
+                            {error, Info} ->
+                                [<<"create-failed">>, [<<"constructor">>, Info]];
+                            Otherwise ->
+                                error_logger:warning_report({?MODULE, creation_failed,
+                                                             Sexp, Otherwise}),
+                                [<<"create-failed">>, [<<"constructor">>]]
+                        end
+                end,
+            hop:post(ReplySink, ReplyName, Reply, <<>>),
+            {noreply, State};
+        _ ->
+            error_logger:warning_report({?MODULE, message_not_understood, Sexp}),
+            {noreply, State}
+    end;
+handle_info(_Message, State) ->
+    {stop, {bad_info, _Message}, State}.

experiments/erlang/src/hop_queue.erl

@@ -0,0 +1,125 @@
+%% Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+%%
+%% This file is part of Hop.
+%%
+%% Hop is free software: you can redistribute it and/or modify it
+%% under the terms of the GNU General Public License as published by
+%% the Free Software Foundation, either version 3 of the License, or
+%% (at your option) any later version.
+%%
+%% Hop is distributed in the hope that it will be useful, but WITHOUT
+%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+%% or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+%% License for more details.
+%%
+%% You should have received a copy of the GNU General Public License
+%% along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+-module(hop_queue).
+
+-behaviour(gen_server).
+-export([init/1, terminate/2, code_change/3, handle_call/3, handle_cast/2, handle_info/2]).
+
+-export([hop_create/1]).
+
+-include("hop.hrl").
+
+hop_create([Name]) ->
+    {ok, Pid} = gen_server:start(?MODULE, [], []),
+    case hop:register_idempotent(Name, Pid, ?MODULE) of
+        ok ->
+            {ok, []};
+        {error, Info} ->
+            gen_server:cast(Pid, shutdown),
+            {error, Info}
+    end.
+
+%%---------------------------------------------------------------------------
+
+-record(state, {backlog, waiters}).
+
+tick(State) ->
+    tick(State, 2).
+
+tick(State, 0) ->
+    {0, State};
+tick(State = #state{backlog = Backlog, waiters = Waiters}, TicksLeft) ->
+    case queue:out(Waiters) of
+        {empty, _} ->
+            {infinity, State};
+        {{value, WaiterRef}, WaitersRemainder} ->
+            case get(WaiterRef) of
+                undefined ->
+                    tick(State#state{waiters = WaitersRemainder}, TicksLeft);
+                #hop_sub{ref = Ref, sink = Sink, name = Name} ->
+                    case queue:out(Backlog) of
+                        {empty, _} ->
+                            {infinity, State};
+                        {{value, Message}, BacklogRemainder} ->
+                            case hop:post(Sink, Name, Message, term_to_binary(Ref)) of
+                                true ->
+                                    NewState = State#state{backlog = BacklogRemainder,
+                                                           waiters = queue:in(WaiterRef,
+                                                                              WaitersRemainder)},
+                                    tick(NewState, TicksLeft - 1);
+                                false ->
+                                    tick(State#state{waiters = WaitersRemainder}, TicksLeft)
+                            end
+                    end
+            end
+    end.
+
+noreply(State) ->
+    {Timeout, NewState} = tick(State),
+    {noreply, NewState, Timeout}.
+
+reply(Reply, State) ->
+    {Timeout, NewState} = tick(State),
+    {reply, Reply, NewState, Timeout}.
+
+init([]) ->
+    {ok, #state{backlog = queue:new(), waiters = queue:new()}}.
+
+terminate(_Reason, _State) ->
+    ok.
+
+code_change(_OldVsn, State, _Extra) ->
+    {ok, State}.
+
+handle_call(hop_class_module, _From, State) ->
+    reply(?MODULE, State);
+handle_call(_Request, _From, State) ->
+    {stop, {bad_call, _Request}, State}.
+
+handle_cast(shutdown, State) ->
+    {stop, normal, State};
+handle_cast(_Request, State) ->
+    {stop, {bad_cast, _Request}, State}.
+
+handle_info({hop, Sexp}, State = #state{backlog = OldBacklog, waiters = OldWaiters}) ->
+    noreply(case Sexp of
+                [<<"post">>, _Name, Body, _Token] ->
+                    State#state{backlog = queue:in(Body, OldBacklog)};
+                [<<"subscribe">>, Filter, Sink, Name, ReplySink, ReplyName] ->
+                    SubRef = make_ref(),
+                    Sub = #hop_sub{ref = SubRef, filter = Filter, sink = Sink, name = Name},
+                    put(SubRef, Sub),
+                    _ = hop:post(ReplySink, ReplyName,
+                                 [<<"subscribe-ok">>, term_to_binary(SubRef)], <<>>),
+                    State#state{waiters = queue:in(SubRef, OldWaiters)};
+                [<<"unsubscribe">>, Token] ->
+                    case catch binary_to_term(Token) of
+                        SubRef when is_reference(SubRef) ->
+                            erase(SubRef),
+                            State;
+                        _ ->
+                            State
+                    end;
+                _ ->
+                    error_logger:warning_report({?MODULE, message_not_understood, Sexp}),
+                    State
+            end);
+handle_info(timeout, State) ->
+    noreply(State);
+handle_info(_Message, State) ->
+    {stop, {bad_info, _Message}, State}.

experiments/erlang/src/hop_relay.erl

@@ -0,0 +1,129 @@
+%% Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+%%
+%% This file is part of Hop.
+%%
+%% Hop is free software: you can redistribute it and/or modify it
+%% under the terms of the GNU General Public License as published by
+%% the Free Software Foundation, either version 3 of the License, or
+%% (at your option) any later version.
+%%
+%% Hop is distributed in the hope that it will be useful, but WITHOUT
+%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+%% or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+%% License for more details.
+%%
+%% You should have received a copy of the GNU General Public License
+%% along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+-module(hop_relay).
+
+-behaviour(gen_server).
+-export([init/1, terminate/2, code_change/3, handle_call/3, handle_cast/2, handle_info/2]).
+
+-export([hop_create/1, start_link/1]).
+
+hop_create([HostBin, PortBin]) ->
+    Host = binary_to_list(HostBin),
+    Port = list_to_integer(binary_to_list(PortBin)),
+    case gen_tcp:connect(Host, Port, [{active, false}]) of
+        {ok, Sock} ->
+            {ok, Pid} = start_link([Sock]),
+            {ok, []};
+        {error, Reason} ->
+            {error, iolist_to_binary(io_lib:format("Connect failed: ~p", [Reason]))}
+    end.
+
+start_link(Args) ->
+    gen_server:start_link(?MODULE, Args, []).
+
+%%---------------------------------------------------------------------------
+
+-record(state, {sock, parser}).
+
+send(Sexp, State = #state{sock = Sock}) ->
+    %% Using port_command is dicey, but done to avoid selective
+    %% receive in gen_tcp:send/2, which causes crippling slowdown when
+    %% the queue of outbound sexps waiting to be relayed gets long.
+    port_command(Sock, sexp:format_iolist(Sexp)),
+    State.
+
+request_data(Sock) ->
+    %% We use prim_inet:async_recv here, again to avoid selective
+    %% receives.
+    {ok, _Ref} = prim_inet:async_recv(Sock, 0, -1),
+    ok.
+
+send_error(Message, Details, State) ->
+    send([<<"error">>, list_to_binary(Message), Details], State).
+
+handle_sexp1(Sexp, State) ->
+    error_logger:info_report({?MODULE, self(), Sexp}),
+    handle_sexp(Sexp, State).
+
+handle_sexp([<<"post">>, Name, Body, _Token], State) ->
+    _ = hop:send(Name, Body),
+    State;
+handle_sexp([<<"subscribe">>, Filter, _Sink, _Name, ReplySink, ReplyName], State) ->
+    case global:register_name(Filter, self()) of
+        yes ->
+            _ = hop:post(ReplySink, ReplyName, [<<"subscribe-ok">>, Filter], <<>>),
+            State;
+        no ->
+            error_logger:warning_report({?MODULE, bind_failed, Filter}),
+            State
+    end;
+handle_sexp([<<"unsubscribe">>, Token], State) ->
+    global:unregister_name(Token), %% TODO security problem
+    State;
+handle_sexp(Other, State) ->
+    send_error("Message not understood", [Other], State).
+
+%%---------------------------------------------------------------------------
+
+init([Sock]) ->
+    {ok, #state{sock = Sock, parser = sexp:parse_state()}}.
+
+terminate(_Reason, _State) ->
+    ok.
+
+code_change(_OldVsn, State, _Extra) ->
+    {ok, State}.
+
+handle_call(_Request, _From, State) ->
+    {stop, {bad_call, _Request}, State}.
+
+handle_cast({socket_control_transferred, Sock}, State0 = #state{sock = Sock}) ->
+    inet:setopts(Sock, [binary]),
+    request_data(Sock),
+    State1 = send([<<"hop">>], State0),
+    State2 = send([<<"subscribe">>, hop:name(), <<>>, <<>>, <<>>, <<>>], State1),
+    {noreply, State2};
+handle_cast(_Request, State) ->
+    {stop, {bad_cast, _Request}, State}.
+
+handle_info({hop, Sexp}, State) ->
+    {noreply, send(Sexp, State)};
+handle_info({inet_async, Sock, _Ref, {ok, Bin}}, State = #state{sock = Sock, parser = Parser})
+  when is_binary(Bin) ->
+    case catch sexp:parse(Bin, Parser) of
+        {'EXIT', Reason} ->
+            {stop,
+             {received_syntax_error, Reason},
+             send_error("Syntax error",
+                        [<<"http://people.csail.mit.edu/rivest/Sexp.txt">>],
+                        State)};
+        {Terms, NewParser} ->
+            NewState = lists:foldl(fun handle_sexp/2, State#state{parser = NewParser}, Terms),
+            request_data(Sock),
+            {noreply, NewState}
+    end;
+handle_info({tcp_closed, Sock}, State = #state{sock = Sock}) ->
+    {stop, normal, State};
+handle_info({inet_reply, Sock, _}, State = #state{sock = Sock}) ->
+    %% These are the replies to the raw port_command we're doing above
+    %% in send/2. We ignore them because higher level protocols deal
+    %% with acknowledgements and errors, and we trust that the socket
+    %% will close eventually if write failures start to happen.
+    {noreply, State};
+handle_info(_Message, State) ->
+    {stop, {bad_info, _Message}, State}.

experiments/erlang/src/hop_server.erl

@@ -0,0 +1,79 @@
+%%---------------------------------------------------------------------------
+%% Copyright (c) 2007 Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
+%% Copyright (c) 2007 LShift Ltd. <query@lshift.net>
+%%
+%% Permission is hereby granted, free of charge, to any person
+%% obtaining a copy of this software and associated documentation
+%% files (the "Software"), to deal in the Software without
+%% restriction, including without limitation the rights to use, copy,
+%% modify, merge, publish, distribute, sublicense, and/or sell copies
+%% of the Software, and to permit persons to whom the Software is
+%% furnished to do so, subject to the following conditions:
+%%
+%% The above copyright notice and this permission notice shall be
+%% included in all copies or substantial portions of the Software.
+%%
+%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+%% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+%% NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+%% BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+%% ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+%% CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+%% SOFTWARE.
+%%---------------------------------------------------------------------------
+
+-module(hop_server).
+
+-behaviour(gen_server).
+
+-export([start_link/5]).
+-export([init/1, terminate/2, code_change/3, handle_call/3, handle_cast/2, handle_info/2]).
+
+start_link(Module, Host, Port, ListenOpts, ModuleOpts) ->
+    gen_server:start_link(?MODULE, [Module, Host, Port, ListenOpts, ModuleOpts], []).
+
+%---------------------------------------------------------------------------
+
+accept_and_start(Module, ModuleOpts, LSock) ->
+    spawn_link(fun () ->
+		       case gen_tcp:accept(LSock) of
+			   {ok, Sock} ->
+			       accept_and_start(Module, ModuleOpts, LSock),
+			       {ok, Pid} = gen_server:start(Module, [Sock | ModuleOpts], []),
+			       gen_tcp:controlling_process(Sock, Pid),
+			       gen_server:cast(Pid, {socket_control_transferred, Sock});
+			   {error, Reason} ->
+			       exit({error, Reason})
+		       end
+	       end).
+
+ip_listen_opt(any) ->
+    [];
+ip_listen_opt(Host) ->
+    {ok, IP} = inet:getaddr(Host, inet),
+    [{ip, IP}].
+
+%---------------------------------------------------------------------------
+
+init([Module, Host, Port, ListenOpts, ModuleOpts]) ->
+    {ok, LSock} = gen_tcp:listen(Port, ip_listen_opt(Host) ++ ListenOpts),
+    accept_and_start(Module, ModuleOpts, LSock),
+    {ok, LSock}.
+
+terminate(_Reason, State) ->
+    LSock = State,
+    gen_tcp:close(LSock),
+    ok.
+
+code_change(_OldVsn, State, _Extra) ->
+    {ok, State}.
+
+handle_call(_Request, _From, State) ->
+    {reply, ignored, State}.
+
+handle_cast(_Request, State) ->
+    {noreply, State}.
+
+handle_info(_Message, State) ->
+    {noreply, State}.

experiments/erlang/src/sexp.erl

@@ -0,0 +1,122 @@
+%% Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+%%
+%% This file is part of Hop.
+%%
+%% Hop is free software: you can redistribute it and/or modify it
+%% under the terms of the GNU General Public License as published by
+%% the Free Software Foundation, either version 3 of the License, or
+%% (at your option) any later version.
+%%
+%% Hop is distributed in the hope that it will be useful, but WITHOUT
+%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+%% or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+%% License for more details.
+%%
+%% You should have received a copy of the GNU General Public License
+%% along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+-module(sexp).
+%% SPKI SEXP.
+
+-export([lex_state/0, lex/1, lex/2]).
+-export([parse_state/0, parse/1, parse/2]).
+-export([format/1, format_iolist/1]).
+
+%% Lexer states
+-record(init, {}).
+-record(str, {remaining, pieces_rev}).
+-record(strlen, {value}).
+
+%% Parser states
+-record(parser, {lexer, stack}).
+
+-define(ZERO, 48).
+-define(NINE, 57).
+
+lex_state() ->
+    #init{}.
+
+lex(Chunk) ->
+    lex(Chunk, lex_state()).
+
+lex(<<"(", Rest/binary>>, State = #init{}) ->
+    {Events, FinalState} = lex(Rest, State),
+    {[open | Events], FinalState};
+lex(<<")", Rest/binary>>, State = #init{}) ->
+    {Events, FinalState} = lex(Rest, State),
+    {[close | Events], FinalState};
+lex(<<"[", Rest/binary>>, State = #init{}) ->
+    {Events, FinalState} = lex(Rest, State),
+    {[hint_open | Events], FinalState};
+lex(<<"]", Rest/binary>>, State = #init{}) ->
+    {Events, FinalState} = lex(Rest, State),
+    {[hint_close | Events], FinalState};
+lex(<<D, Rest/binary>>, #init{}) when D >= ?ZERO andalso D =< ?NINE ->
+    lex(Rest, #strlen{value = D - ?ZERO});
+lex(<<X, Rest/binary>>, State = #init{}) when X =< 32 ->
+    lex(Rest, State);
+lex(<<D, Rest/binary>>, #strlen{value = V}) when D >= ?ZERO andalso D =< ?NINE ->
+    lex(Rest, #strlen{value = V * 10 + D - ?ZERO});
+lex(<<":", Rest/binary>>, #strlen{value = V}) ->
+    lex(Rest, #str{remaining = V, pieces_rev = []});
+lex(Chunk, #str{remaining = Len, pieces_rev = PiecesRev}) ->
+    case Chunk of
+        <<Piece:Len/binary, Rest/binary>> ->
+            {Events, FinalState} = lex(Rest, #init{}),
+            {[{str, iolist_to_binary(lists:reverse([Piece | PiecesRev]))} | Events], FinalState};
+        _ ->
+            {[], #str{remaining = Len - size(Chunk), pieces_rev = [Chunk | PiecesRev]}}
+    end;
+lex(<<>>, State) ->
+    {[], State}.
+
+parse_state() ->
+    #parser{lexer = lex_state(), stack = []}.
+
+parse(Chunk) ->
+    Inert = parse_state(),
+    case parse(Chunk, Inert) of
+        {Terms, Inert} -> {ok, Terms, Inert};
+        {Terms, Other} -> {more, Terms, Other}
+    end.
+
+parse(Chunk, #parser{lexer = Lexer, stack = Stack}) ->
+    {Events, NewLexer} = lex(Chunk, Lexer),
+    {Terms, NewStack} = parse_events(Events, Stack),
+    {Terms, #parser{lexer = NewLexer, stack = NewStack}}.
+
+parse_events([open | Rest], Stack) ->
+    parse_events(Rest, [[] | Stack]);
+parse_events([close | Rest], [AccRev]) when is_list(AccRev) ->
+    {Terms, NewStack} = parse_events(Rest, []),
+    {[lists:reverse(AccRev) | Terms], NewStack};
+parse_events([close | Rest], [AccRev, AccRevOuter | Stack]) when is_list(AccRev) ->
+    parse_events(Rest, [[lists:reverse(AccRev) | AccRevOuter] | Stack]);
+parse_events([hint_open | Rest], Stack) ->
+    parse_events(Rest, [hint | Stack]);
+parse_events([{str, Bin} | Rest], [hint | Stack]) ->
+    parse_events(Rest, [{hint, Bin} | Stack]);
+parse_events([hint_close | Rest], Stack = [{hint, _} | _]) ->
+    parse_events(Rest, Stack);
+parse_events([{str, BodyBin} | Rest], [{hint, HintBin} | Stack]) ->
+    {Terms, NewStack} = parse_events(Rest, Stack),
+    {[{HintBin, BodyBin} | Terms], NewStack};
+parse_events([{str, Bin} | Rest], Stack = []) ->
+    {Terms, NewStack} = parse_events(Rest, Stack),
+    {[Bin | Terms], NewStack};
+parse_events([{str, Bin} | Rest], [AccRev | Stack]) when is_list(AccRev) ->
+    parse_events(Rest, [[Bin | AccRev] | Stack]);
+parse_events([], Stack) ->
+    {[], Stack}.
+
+format(Sexp) ->
+    iolist_to_binary(format_iolist(Sexp)).
+
+format_bin(Bin) -> [integer_to_list(size(Bin)), $:, Bin].
+
+format_iolist(Bin) when is_binary(Bin) ->
+    format_bin(Bin);
+format_iolist({H, B}) when is_binary(H) andalso is_binary(B) ->
+    [$[, format_bin(H), $], format_bin(B)];
+format_iolist(Sexps) when is_list(Sexps) ->
+    [$(, [format_iolist(Sexp) || Sexp <- Sexps], $)].

experiments/lisp/main.lisp

@@ -0,0 +1,33 @@
+(ql:quickload "flexi-streams")
+;(ql:quickload "babel")
+(ql:quickload "usocket")
+(ql:quickload "cl-match")
+
+(ql:quickload "gbbopen")
+(require :portable-threads)
+
+(load "packages.lisp")
+(load "sexp.lisp")
+(load "network.lisp")
+
+(in-package :cl-user)
+
+;; (defun handle-connection (stream)
+;;   (spki-sexp:write-sexp (spki-sexp:read-sexp stream) stream))
+
+;; (defun start-server (port)
+;;   (usocket:socket-server "localhost" port 'handle-connection '()
+;; 			 :in-new-thread t
+;; 			 :multi-threading t
+;; 			 :reuse-address t
+;; 			 :element-type '(unsigned-byte 8)))
+
+;; (start-server 5671)
+
+(smsg-network:serve-on-port 5671)
+
+;; (let ((server-socket (socket-listen "localhost" 5671
+;; 				    :reuse-address t
+;; 				    :element-type unsigned-integer)))
+;;   (loop for conn = (socket-accept server-socket)
+;;        do (handle-connection conn)))

experiments/lisp/network.lisp

@@ -0,0 +1,47 @@
+(in-package :smsg-network)
+
+(defun command-loop (in out route)
+  (loop (let ((command (read-sexp in)))
+	  (when (not (handle-inbound-command command in out route))
+	    (return)))))
+
+(defun handle-inbound-command (command in out route)
+  (ematch-sexp command
+    (("subscribe" filter sink name reply-sink reply-name)
+     (if (rebind-node filter nil route)
+	 (when (plusp (length reply-sink))
+	   (post reply-sink reply-name (sexp-build ("subscribe-ok" (= filter)))))
+	 (report! `(rebind-failed ,command))))
+    (("unsubscribe" id)
+     (when (not (rebind-node id route nil))
+       (report! `(rebind-failed ,command))))
+    (("post" name body token)
+     (send name body))))
+
+(defun relay (in out localname servermode)
+  (flet ((route (message)
+	   (write-sexp message out)
+	   (write-byte 13 out)
+	   (write-byte 10 out)))
+    (if servermode
+	(route (sexp-quote ("hop" "0")))
+	(ematch-sexp (read-sexp in)
+	  (("hop" "0") t)))
+    (force-output out)
+    (route (sexp-build ("subscribe" (= localname) "" "" "" "")))
+    (command-loop in out #'route)))
+
+(defun handle-connection (stream)
+  (relay stream stream (sexp-quote "smsg") t))
+
+(defun serve-on-port (port)
+  (usocket:socket-server "localhost" port 'handle-connection '()
+			 :in-new-thread t
+			 :multi-threading t
+			 :reuse-address t
+			 :element-type '(unsigned-byte 8)))
+
+(defun client (localname hostname portnumber)
+  (let ((s (usocket:socket-stream
+	    (usocket:socket-connect hostname portnumber :element-type '(unsigned-byte 8)))))
+    (relay s s localname nil)))

experiments/lisp/packages.lisp

@@ -0,0 +1,33 @@
+(defpackage :spki-sexp
+  (:use :cl :flexi-streams :cl-match)
+  (:shadow :read-from-string)
+
+  (:export :read-sexp :write-sexp
+
+	   :display-hint
+	   :make-display-hint
+	   :display-hint-p
+	   :copy-display-hint
+	   :display-hint-hint
+	   :display-hint-body
+
+	   :syntax-error
+	   :bad-length-prefix
+	   :bad-display-hint
+	   :bad-input-character
+	   :unexpected-close-paren
+
+	   :match-failure
+
+	   :convert-sexp
+	   :sexp-quote
+	   :sexp-build
+
+	   :match-sexp
+	   :ematch-sexp))
+
+(defpackage :smsg-network
+  (:use :cl :flexi-streams :spki-sexp)
+  (:export :relay
+	   :serve-on-port
+	   :client))

experiments/lisp/sexp.lisp

@@ -0,0 +1,142 @@
+;; SPKI SEXPs for Common Lisp
+
+(in-package :spki-sexp)
+
+(define-condition syntax-error (error) ())
+(define-condition bad-length-prefix (syntax-error) ())
+(define-condition bad-display-hint (syntax-error) ())
+(define-condition bad-input-character (syntax-error) ())
+(define-condition unexpected-close-paren (syntax-error) ())
+
+(define-condition match-failure (error) ())
+
+(defstruct display-hint hint body)
+
+(defun write-integer (n output-stream)
+  (labels ((w (n)
+	     (when (plusp n)
+	       (multiple-value-bind (top-half lower-digit)
+		   (floor n 10)
+		 (w top-half)
+		 (write-byte (+ lower-digit 48) output-stream)))))
+    (if (zerop n)
+	(write-byte 48 output-stream)
+	(w n))))
+
+(defun write-sexp (sexp &optional (output-stream *standard-output*))
+  (etypecase sexp
+    ((array (unsigned-byte 8))
+     (write-integer (length sexp) output-stream)
+     (write-byte 58 output-stream) ;; #\:
+     (write-sequence sexp output-stream))
+    (cons
+     (write-byte 40 output-stream) ;; #\(
+     (loop for v in sexp do (write-sexp v output-stream))
+     (write-byte 41 output-stream)) ;; #\)
+    (display-hint
+     (write-byte 91 output-stream)
+     (write-sexp (display-hint-hint sexp) output-stream)
+     (write-byte 93 output-stream)
+     (write-sexp (display-hint-body sexp) output-stream))
+    (string
+     (write-sexp (flexi-streams:string-to-octets sexp :external-format :utf-8) output-stream))))
+
+(defun read-simple-string (input-stream &optional (len 0))
+  (loop (let ((c (read-byte input-stream)))
+	  (if (eql c 58) ;; #\:
+	      (let ((buf (make-array len :element-type '(unsigned-byte 8))))
+		(read-sequence buf input-stream)
+		(return buf))
+	      (let ((v (digit-char-p c)))
+		(if v
+		    (setq len (+ (* len 10) v))
+		    (error 'bad-length-prefix)))))))
+
+(defun read-sexp-list (input-stream)
+  (loop for v = (read-sexp-inner input-stream)
+     until (eq v 'end-of-list-marker)
+     collect v))
+
+(defun read-sexp-inner (input-stream)
+  (let (result)
+    (tagbody :retry
+       (setq result
+	     (let ((c (read-byte input-stream)))
+	       (cond
+		 ((eql c 40) (read-sexp-list input-stream)) ;; #\(
+		 ((eql c 41) 'end-of-list-marker) ;; #\)
+		 ((eql c 91) ;; #\[
+		  (let ((hint (read-simple-string input-stream)))
+		    (when (not (eql (read-byte input-stream) 93)) ;; #\]
+		      (error 'bad-display-hint))
+		    (make-display-hint :hint hint :body (read-simple-string input-stream))))
+		 ((<= 48 c 57) (read-simple-string input-stream (- c 48))) ;; digits
+		 ((<= c 32) ;; whitespace - convenience for testing
+		  (go :retry))
+		 (t (error 'bad-input-character))))))
+    result))
+
+(defun read-sexp (&optional (input-stream *standard-input*))
+  (let ((v (read-sexp-inner input-stream)))
+    (if (eq v 'end-of-list-marker)
+	(error 'unexpected-close-paren)
+	v)))
+
+(defun convert-sexp (val)
+  (etypecase val
+    ((array (unsigned-byte 8)) val)
+    (cons (cons (convert-sexp (car val))
+		(convert-sexp (cdr val))))
+    (null nil)
+    (display-hint (make-display-hint
+		   :hint (convert-sexp (display-hint-hint val))
+		   :body (convert-sexp (display-hint-body val))))
+    (string (flexi-streams:string-to-octets val :external-format :utf-8))))
+
+(defmacro sexp-quote (val)
+  `(quote ,(convert-sexp val)))
+
+(defun build-sexp (stx)
+  (etypecase stx
+    ((array (unsigned-byte 8)) stx)
+    (cons (if (eq (car stx) '=)
+	      (cadr stx)
+	      `(cons ,(build-sexp (car stx))
+		     ,(build-sexp (cdr stx)))))
+    (null 'nil)
+    (display-hint `(make-display-hint
+		    :hint ,(build-sexp (display-hint-hint stx))
+		    :body ,(build-sexp (display-hint-body stx))))
+    (string (flexi-streams:string-to-octets stx :external-format :utf-8))))
+
+(defmacro sexp-build (template)
+  (build-sexp template))
+
+(defun convert-match-pattern (pattern)
+  (etypecase pattern
+    ((array (unsigned-byte 8)) `(array (1 (unsigned-byte 8)) ,(coerce pattern 'list)))
+    (cons `(cons ,(convert-match-pattern (car pattern))
+		 ,(convert-match-pattern (cdr pattern))))
+    (null 'nil)
+    (display-hint `(struct display-hint
+			   (:hint ,(convert-match-pattern (display-hint-hint pattern)))
+			   (:body ,(convert-match-pattern (display-hint-body pattern)))))
+    (string (convert-match-pattern
+	     (flexi-streams:string-to-octets pattern :external-format :utf-8)))
+    (symbol pattern)))
+
+(defmacro match-sexp (val &rest clauses)
+  `(cl-match:match ,val
+     ,@(mapcar (lambda (clause)
+		 `(,(convert-match-pattern (car clause)) ,@(cdr clause)))
+	       clauses)))
+
+(defmacro ematch-sexp (val &rest clauses)
+  `(match-sexp ,val ,@clauses (_ (error 'match-failure))))
+
+;; Useful for testing
+(defun read-from-string (str &optional (external-format :utf-8))
+  (read-sexp (flexi-streams:make-flexi-stream
+	      (flexi-streams:make-in-memory-input-stream
+	       (flexi-streams:string-to-octets str :external-format external-format))
+	      :external-format external-format)))

experiments/pharo/.gitignore

@@ -0,0 +1,6 @@
+Hop.changes
+Hop.image
+PharoDebug.log
+PharoV10.sources
+.DS_Store
+package-cache/*.mcz

experiments/python/.gitignore

@@ -0,0 +1 @@
+*.pyc

experiments/python/Makefile

@@ -0,0 +1,4 @@
+all:
+
+clean:
+	rm -f hop/*.pyc

experiments/python/hop/__init__.py

@@ -0,0 +1,9 @@
+from dispatch import *
+from namespace import *
+from relay import *
+import factory
+import queue
+
+import logging
+logging.basicConfig(level = logging.DEBUG)
+TcpRelayServer()

experiments/python/hop/dispatch.py

@@ -0,0 +1,50 @@
+## Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+##
+## This file is part of Hop.
+##
+## Hop is free software: you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+##
+## Hop is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+## or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+## License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+import logging
+
+class HopNode:
+    def handle_hop(self, msg):
+        raw_dispatch(self, 'hop_', msg)
+
+    def error(self, message, details):
+        logging.error('%r: %s: %r' % (self, message, details))
+
+class HopRelayMixin:
+    def inbound_hop(self, msg):
+        raw_dispatch(self, 'inbound_hop_', msg)
+
+def raw_dispatch(self, prefix, msg):
+    if type(msg) is not list or len(msg) < 1:
+        self.error('Invalid message', [])
+        return
+
+    raw_selector = msg[0]
+    selector = prefix + raw_selector
+    args = msg[1:]
+    handler = getattr(self, selector, None)
+
+    if not handler:
+        self.error('Unsupported message or arity', [raw_selector])
+        return
+
+    try:
+        handler(*args)
+    except Exception:
+        import traceback
+        traceback.print_exc()
+        self.error('Exception handling message', [raw_selector])

experiments/python/hop/factory.py

@@ -0,0 +1,43 @@
+## Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+##
+## This file is part of Hop.
+##
+## Hop is free software: you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+##
+## Hop is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+## or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+## License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+import dispatch
+import namespace
+
+class Factory(dispatch.HopNode):
+    def __init__(self):
+        self.classes = {}
+
+    def register(self, classname, classval):
+        self.classes[classname] = classval
+
+    def hop_create(self, classname, arg, replysink, replyname):
+        if classname not in self.classes:
+            namespace.post(replysink, replyname,
+                           ['create-failed', ['factory', 'class-not-found']], '')
+            return
+
+        try:
+            node = self.classes[classname](arg)
+            namespace.post(replysink, replyname, ['create-ok', node.node_info()], '')
+        except Exception, e:
+            import traceback
+            traceback.print_exc()
+            namespace.post(replysink, replyname, ['create-failed', ['constructor', str(e)]], '')
+
+default_factory = Factory()
+namespace.bind('factory', default_factory)

experiments/python/hop/namespace.py

@@ -0,0 +1,54 @@
+## Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+##
+## This file is part of Hop.
+##
+## Hop is free software: you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+##
+## Hop is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+## or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+## License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+import uuid
+import logging
+
+class Namespace:
+    def __init__(self):
+        self.nodename = str(uuid.uuid4())
+        self.bindings = {}
+
+    def bind(self, name, node):
+        if name in self.bindings:
+            return False
+        self.bindings[name] = node
+        return True
+
+    def unbind(self, name):
+        del self.bindings[name]
+
+    def send(self, name, msg):
+        ## logging.debug('SENDING TO %s: %r' % (name, msg))
+        if name:
+            if name in self.bindings:
+                self.bindings[name].handle_hop(msg)
+                return True
+            else:
+                logging.warning("Send to unbound name: %s" % (name,))
+                return False
+        else:
+            return False
+
+    def post(self, sink, name, body, token):
+        return self.send(sink, ['post', name, body, token])
+
+default_namespace = Namespace()
+bind = default_namespace.bind
+unbind = default_namespace.unbind
+send = default_namespace.send
+post = default_namespace.post

experiments/python/hop/queue.py

@@ -0,0 +1,62 @@
+## Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+##
+## This file is part of Hop.
+##
+## Hop is free software: you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+##
+## Hop is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+## or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+## License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+from __future__ import with_statement
+
+import logging
+import threading
+import Queue as builtin_Queue
+
+import namespace
+import factory
+import dispatch
+import subscription
+
+Q = builtin_Queue.Queue
+
+class Queue(dispatch.HopNode):
+    def __init__(self, arg):
+        self.name = arg[0]
+        self.backlog = Q()
+        self.waiters = Q()
+        self.thread = threading.Thread(target = self.queue_main)
+        self.thread.start()
+        if not namespace.bind(self.name, self):
+            raise Exception("duplicate name")
+
+    def node_info(self):
+        return []
+
+    def hop_subscribe(self, filter, sink, name, replysink, replyname):
+        sub = subscription.Subscription(filter, sink, name)
+        self.waiters.put(sub)
+        namespace.post(replysink, replyname, ['subscribe-ok', sub.uuid], '')
+
+    def hop_post(self, name, body, token):
+        self.backlog.put(body)
+
+    def queue_main(self):
+        while True:
+            body = self.backlog.get()
+            while True:
+                waiter = self.waiters.get()
+                if not waiter.deliver(body):
+                    continue
+                self.waiters.put(waiter)
+                break
+
+factory.default_factory.register('queue', Queue)

experiments/python/hop/relay.py

@@ -0,0 +1,101 @@
+## Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+##
+## This file is part of Hop.
+##
+## Hop is free software: you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+##
+## Hop is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+## or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+## License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+from __future__ import with_statement
+
+import logging
+import threading
+import socket
+
+import namespace
+import sexp
+from dispatch import HopRelayMixin
+
+class HopRelay(HopRelayMixin):
+    def __init__(self, in_ch, out_ch, ns = None, peer_address = None):
+        self.lock = threading.Lock()
+        self.in_ch = in_ch
+        self.out_ch = out_ch
+        self.peer_address = peer_address
+        self.thread = threading.Thread(target = self.relay_main)
+        self.namespace = ns if ns else namespace.default_namespace
+        self.thread.start()
+
+    def write(self, x):
+        if self.out_ch:
+            with self.lock:
+                try:
+                    sexp.write_sexp(self.out_ch, x)
+                    self.out_ch.flush()
+                except Exception:
+                    ## Don't care, here - we assume that any write
+                    ## error will be reflected in the socket closing
+                    ## in a little while in any case.
+                    pass
+
+    def error(self, message, details):
+        self.write(['error', message, details])
+
+    def handle_hop(self, msg):
+        self.write(msg)
+
+    def inbound_hop_post(self, name, body, token):
+        self.namespace.send(name, body)
+
+    def inbound_hop_subscribe(self, filter, sink, name, replysink, replyname):
+        if self.namespace.bind(filter, self):
+            self.namespace.post(replysink, replyname, ['subscribe-ok', filter], '')
+
+    def inbound_hop_unsubscribe(self, token):
+        self.namespace.unbind(token)
+
+    def relay_main(self):
+        self.write(['subscribe', self.namespace.nodename, '', '', '', ''])
+        try:
+            while True:
+                try:
+                    m = sexp.read_sexp(self.in_ch)
+                except sexp.SyntaxError, e:
+                    self.error('Syntax error', ["http://people.csail.mit.edu/rivest/Sexp.txt"])
+                    return
+                self.inbound_hop(m)
+        except EOFError:
+            pass
+        finally:
+            o = self.out_ch
+            i = self.in_ch
+            self.out_ch = None
+            self.in_ch = None
+            i.close()
+            o.close()
+
+class TcpRelayServer:
+    def __init__(self, host = '0.0.0.0', port = 5671):
+        self.listen_address = (host, port)
+        self.server_socket = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
+        self.server_socket.setsockopt(socket.SOL_SOCKET, socket.SO_REUSEADDR, 1)
+        self.server_socket.bind(self.listen_address)
+        self.server_socket.listen(4)
+        self.thread = threading.Thread(target = self.listen_main)
+        self.thread.start()
+
+    def listen_main(self):
+        logging.info("Accepting connections on %r" % (self.listen_address,))
+        while True:
+            conn, addr = self.server_socket.accept()
+            conn.send(sexp.format(['hop']))
+            HopRelay(conn.makefile(mode = 'r'), conn.makefile(mode = 'w'), peer_address = addr)

experiments/python/hop/sexp.py

@@ -0,0 +1,88 @@
+## Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+##
+## This file is part of Hop.
+##
+## Hop is free software: you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+##
+## Hop is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+## or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+## License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+# SPKI SEXP
+
+import StringIO
+
+class SyntaxError(Exception): pass
+
+def write_sexp_str(f, x):
+    f.write(str(len(x)))
+    f.write(':')
+    f.write(x)
+
+def write_sexp(f, sexp):
+    if type(sexp) is list:
+        f.write('(')
+        for x in sexp: write_sexp(f, x)
+        f.write(')')
+        return
+    if type(sexp) is str:
+        write_sexp_str(f, sexp)
+        return
+    if type(sexp) is tuple:
+        f.write('[')
+        write_sexp_str(f, sexp[0])
+        f.write(']')
+        write_sexp_str(f, sexp[1])
+        return
+
+def next(f, n):
+    chunk = f.read(n)
+    if len(chunk) < n: raise EOFError("reading sexp")
+    return chunk
+
+def skipws(f):
+    while True:
+        c = next(f, 1)
+        if not c.isspace(): return c
+
+def read_sexp(f):
+    c = skipws(f)
+    if c == '(':
+        l = []
+        while True:
+            val = read_sexp(f)
+            if val is None: return l
+            l.append(val)
+    if c == '[':
+        h = read_sexp(f)
+        c = skipws(f)
+        if c != ']': raise SyntaxError("Missing hint close bracket")
+        b = read_sexp(f)
+        return (h, b)
+    if c.isdigit():
+        size = ord(c) - 48
+        while True:
+            c = next(f, 1)
+            if c == ':': return next(f, size)
+            if not c.isdigit(): raise SyntaxError("Illegal character in byte vector length")
+            size = size * 10 + ord(c) - 48
+    if c == ')':
+        return None
+    raise SyntaxError("Illegal character in sexp")
+
+def parse(s):
+    return read_sexp(StringIO.StringIO(s))
+
+def format(x):
+    f = StringIO.StringIO()
+    write_sexp(f, x)
+    v = f.getvalue()
+    f.close()
+    return v

experiments/python/hop/subscription.py

@@ -0,0 +1,31 @@
+## Copyright 2010, 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+##
+## This file is part of Hop.
+##
+## Hop is free software: you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+##
+## Hop is distributed in the hope that it will be useful, but WITHOUT
+## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+## or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+## License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+
+import uuid
+
+import namespace
+
+class Subscription:
+    def __init__(self, filter, sink, name):
+        self.live = True
+        self.filter = filter
+        self.sink = sink
+        self.name = name
+        self.uuid = str(uuid.uuid4())
+
+    def deliver(self, body):
+        return self.live and namespace.post(self.sink, self.name, body, self.uuid)

experiments/speedtest/.gitignore

@@ -0,0 +1,2 @@
+consumer
+producer

experiments/speedtest/Makefile

@@ -0,0 +1,7 @@
+all: consumer producer
+
+clean:
+	rm -f consumer producer
+
+%: %.c
+	$(CC) -O3 -o $@ $<

experiments/speedtest/consumer.c

@@ -0,0 +1,154 @@
+/* Copyright (C) 2010, 2011 Tony Garnock-Jones. All rights reserved. */
+
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <errno.h>
+
+#include <sys/types.h>
+#include <sys/uio.h>
+#include <unistd.h>
+#include <sys/socket.h>
+#include <netdb.h>
+#include <netinet/in.h>
+#include <netinet/tcp.h>
+#include <fcntl.h>
+#include <sys/wait.h>
+#include <time.h>
+#include <sys/time.h>
+
+#include <assert.h>
+
+#define EXPECTEDPREFIX "(4:post8:consumer8:"
+
+static size_t hunt_for_latencies_in(char *buf, size_t count) {
+  struct timeval now;
+  char *pos = buf;
+  char *sentinel = buf + count;
+  size_t msgsize = 0;
+
+  gettimeofday(&now, NULL);
+
+  while (1) {
+    char *openptr = memchr(pos, '(', sentinel - pos);
+    char *closeptr;
+    uint32_t s, us;
+
+    if (openptr == NULL) break;
+
+    closeptr = memchr(openptr + 1, ')', sentinel - (openptr + 1));
+    if (closeptr == NULL) break;
+
+    memcpy(&s, openptr + strlen(EXPECTEDPREFIX), sizeof(uint32_t));
+    memcpy(&us, openptr + strlen(EXPECTEDPREFIX) + sizeof(uint32_t), sizeof(uint32_t));
+    s = ntohl(s);
+    us = ntohl(us);
+
+    if (s != 0 || us != 0) {
+      double delta = (now.tv_sec - s) * 1000000.0 + (now.tv_usec - us);
+      printf("Latency %g microseconds (%g milliseconds)\n", delta, delta / 1000.0);
+    }
+
+    msgsize = closeptr + 1 - openptr;
+
+    pos = closeptr + 1;
+  }
+
+  return msgsize;
+}
+
+int main(int argc, char *argv[]) {
+  int fd = socket(AF_INET, SOCK_STREAM, 0);
+  struct sockaddr_in s;
+  FILE *f;
+  struct timeval start_time;
+  long bytecount = -1;
+  size_t message_size = 0;
+  long last_report_bytecount = 0;
+  char idchar = '1';
+  char *qclass = "queue";
+
+  if (argc < 2) {
+    fprintf(stderr, "Usage: test1 <serverhostname> [<idchar> [<qclass>]]\n");
+    exit(1);
+  }
+
+  if (argc > 2) {
+    idchar = argv[2][0];
+  }
+  printf("Idchar: '%c'\n", idchar);
+
+  if (argc > 3) {
+    qclass = argv[3];
+  }
+  printf("Qclass: %s\n", qclass);
+
+  {
+    struct hostent *h = gethostbyname(argv[1]);
+    if (h == NULL) {
+      fprintf(stderr, "serverhostname lookup: %d\n", h_errno);
+      exit(1);
+    }
+    s.sin_family = AF_INET;
+    s.sin_addr.s_addr = * (uint32_t *) h->h_addr_list[0];
+    s.sin_port = htons(5671);
+  }
+
+  if (connect(fd, (struct sockaddr *) &s, sizeof(s)) < 0) return 1;
+
+  {
+    int i = 1;
+    setsockopt(fd, IPPROTO_TCP, TCP_NODELAY, &i, sizeof(i));
+  }
+
+  f = fdopen(fd, "a+");
+
+  fprintf(f, "(9:subscribe5:test%c0:0:5:test%c5:login)\n", idchar, idchar);
+  fprintf(f, "(4:post7:factory(6:create%d:%s(2:q1)5:test%c1:k)0:)\n",
+	  (int) strlen(qclass), qclass, idchar);
+  fflush(f);
+  usleep(100000);
+  fprintf(f, "(4:post2:q1(9:subscribe0:5:test%c8:consumer5:test%c1:k)0:)\n", idchar, idchar);
+  fflush(f);
+
+  while (1) {
+    char buf[1024];
+    size_t n = read(fd, buf, sizeof(buf));
+    if (n == 0) break;
+    if (n >= strlen(EXPECTEDPREFIX)) {
+      if (!memcmp(buf, EXPECTEDPREFIX, strlen(EXPECTEDPREFIX))) {
+	if (bytecount == -1) {
+	  printf("Buffer at start: <<%.*s>>\n", (int) n, buf);
+	  printf("Starting.\n");
+	  bytecount = 0;
+	  gettimeofday(&start_time, NULL);
+	}
+      }
+    }
+    if (bytecount >= 0) {
+      size_t detected_msgsize = hunt_for_latencies_in(buf, n);
+      bytecount += n;
+      if (detected_msgsize != 0 && message_size == 0) {
+	message_size = detected_msgsize;
+	printf("message_size = %lu\n", message_size);
+      }
+      if (message_size != 0) {
+	if ((bytecount - last_report_bytecount) > (100000 * message_size)) {
+	  struct timeval now;
+	  double delta;
+	  gettimeofday(&now, NULL);
+	  delta = (now.tv_sec - start_time.tv_sec) + (now.tv_usec - start_time.tv_usec) / 1000000.0;
+	  printf("So far received %ld bytes in %g seconds = %g bytes/sec and %g msgs/sec\n",
+		 bytecount,
+		 delta,
+		 bytecount / delta,
+		 bytecount / (delta * message_size));
+	  fflush(stdout);
+	  last_report_bytecount = bytecount;
+	}
+      }
+    }
+  }
+
+  return 0;
+}

experiments/speedtest/producer.c

@@ -0,0 +1,149 @@
+/* Copyright (C) 2010, 2011 Tony Garnock-Jones. All rights reserved. */
+
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <errno.h>
+
+#include <sys/types.h>
+#include <sys/uio.h>
+#include <unistd.h>
+#include <sys/socket.h>
+#include <netdb.h>
+#include <netinet/in.h>
+#include <netinet/tcp.h>
+#include <fcntl.h>
+#include <sys/wait.h>
+#include <time.h>
+#include <sys/time.h>
+
+#include <assert.h>
+
+static size_t build_message(char *message, uint32_t s, uint32_t us) {
+  char const *msg_prefix = "(4:post2:q1(4:post0:8:";
+  char const *msg_suffix = "0:)0:)";
+  size_t prefix_len = strlen(msg_prefix);
+  size_t suffix_len = strlen(msg_suffix);
+  uint32_t v;
+  size_t total_len = 0;
+
+  memcpy(message + total_len, msg_prefix, prefix_len);
+  total_len += prefix_len;
+  v = htonl(s);
+  memcpy(message + total_len, &v, sizeof(uint32_t));
+  total_len += sizeof(uint32_t);
+  v = htonl(us);
+  memcpy(message + total_len, &v, sizeof(uint32_t));
+  total_len += sizeof(uint32_t);
+  memcpy(message + total_len, msg_suffix, suffix_len);
+  total_len += suffix_len;
+
+  /*
+  printf("%d<<", total_len);
+  fwrite(message, total_len, 1, stdout);
+  printf(">>\n");
+  */
+  return total_len;
+}
+
+int main(int argc, char *argv[]) {
+  int fd = socket(AF_INET, SOCK_STREAM, 0);
+  struct sockaddr_in s;
+  FILE *f;
+  struct timeval start_time;
+  long bytecount = 0;
+  int i;
+  unsigned long hz_limit = 1000000;
+  unsigned long msgcount = 10000000;
+
+  assert(sizeof(uint32_t) == 4);
+
+  if (argc < 2) {
+    fprintf(stderr, "Usage: test1 <serverhostname> [<hz_limit> [<msgcount>]]\n");
+    exit(1);
+  }
+
+  if (argc > 2) {
+    hz_limit = strtoul(argv[2], NULL, 0);
+  }
+  printf("hz_limit = %lu\n", hz_limit);
+
+  if (argc > 3) {
+    msgcount = strtoul(argv[3], NULL, 0);
+  }
+  printf("msgcount = %lu\n", msgcount);
+
+  {
+    struct hostent *h = gethostbyname(argv[1]);
+    if (h == NULL) {
+      fprintf(stderr, "serverhostname lookup: %d\n", h_errno);
+      exit(1);
+    }
+    s.sin_family = AF_INET;
+    s.sin_addr.s_addr = * (uint32_t *) h->h_addr_list[0];
+    s.sin_port = htons(5671);
+  }
+
+  if (connect(fd, (struct sockaddr *) &s, sizeof(s)) < 0) return 1;
+
+  {
+    int i = 1;
+    setsockopt(fd, IPPROTO_TCP, TCP_NODELAY, &i, sizeof(i));
+  }
+
+  f = fdopen(fd, "a+");
+
+  fprintf(f, "(9:subscribe5:test30:0:5:test35:login)");
+  fflush(f);
+
+  usleep(100000);
+  {
+    char buf[4096];
+    size_t n = read(fd, buf, sizeof(buf));
+    printf("Received: <<%.*s>>\n", (int) n, buf);
+  }
+
+  gettimeofday(&start_time, NULL);
+
+  for (i = 0; i < msgcount; i++) {
+    char message[1024];
+    size_t msglen;
+    while (1) {
+      struct timeval now;
+      double delta;
+      gettimeofday(&now, NULL);
+      delta = (now.tv_sec - start_time.tv_sec) + (now.tv_usec - start_time.tv_usec) / 1000000.0;
+      if (i / delta <= hz_limit) break;
+      fflush(f);
+      usleep(1000);
+    }
+    if ((i % (hz_limit / 4)) == 0) {
+      struct timeval now;
+      gettimeofday(&now, NULL);
+      msglen = build_message(message, now.tv_sec, now.tv_usec);
+    } else {
+      msglen = build_message(message, 0, 0);
+    }
+    fwrite(message, msglen, 1, f);
+    bytecount += msglen;
+    if ((bytecount % 100000) < msglen) {
+      struct timeval now;
+      double delta;
+      gettimeofday(&now, NULL);
+      delta = (now.tv_sec - start_time.tv_sec) + (now.tv_usec - start_time.tv_usec) / 1000000.0;
+      printf("So far sent %ld bytes in %g seconds = %g bytes/sec and %g msgs/sec\n",
+	     bytecount,
+	     delta,
+	     bytecount / delta,
+	     bytecount / (delta * msglen));
+      fflush(stdout);
+    }
+  }
+
+  fprintf(f, "(11:unsubscribe5:test3)");
+  fflush(f);
+
+  fclose(f);
+
+  return 0;
+}

factory.ml

@@ -1,67 +0,0 @@
-(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
-
-(* This file is part of Hop. *)
-
-(* Hop is free software: you can redistribute it and/or modify it *)
-(* under the terms of the GNU General Public License as published by the *)
-(* Free Software Foundation, either version 3 of the License, or (at your *)
-(* option) any later version. *)
-
-(* Hop is distributed in the hope that it will be useful, but *)
-(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
-(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU *)
-(* General Public License for more details. *)
-
-(* You should have received a copy of the GNU General Public License *)
-(* along with Hop.  If not, see <http://www.gnu.org/licenses/>. *)
-
-open Printf
-open Sexp
-open Datastructures
-
-type factory_t = Sexp.t -> (Sexp.t, Sexp.t) Status.t
-
-let mutex = Mutex.create ()
-let classes = ref StringMap.empty
-
-let register_class name factory =
-  Util.with_mutex0 mutex
-    (fun () ->
-      if StringMap.mem name !classes
-      then (Log.error "Duplicate node class name" [Str name];
-	    exit 1)
-      else (Log.info "Registered node class" [Str name];
-	    classes := StringMap.add name factory !classes))
-
-let all_class_names () =
-  Datastructures.string_map_keys !classes
-
-let lookup_class name =
-  try Some (StringMap.find name !classes)
-  with Not_found -> None
-
-let factory_handler n sexp =
-  match Message.message_of_sexp sexp with
-  | Message.Create (Str classname, arg, Str reply_sink, Str reply_name) ->
-      let reply =
-	match lookup_class classname with
-	| Some factory ->
-	    (match factory arg with
-	    | Status.Ok info ->
-		Log.info "Node create ok"
-		  [Str classname; arg; Str reply_sink; Str reply_name; info];
-		Message.create_ok info
-	    | Status.Problem explanation ->
-		Log.info "Node create failed"
-		  [Str classname; arg; Str reply_sink; Str reply_name; explanation];
-		Message.create_failed (Arr [Str "constructor"; explanation]))
-	| None ->
-	    Log.warn "Node class not found" [Str classname];
-	    Message.create_failed (Arr [Str "factory"; Str "class-not-found"])
-      in
-      Node.post_ignore' reply_sink (Str reply_name) reply (Str "")
-  | m ->
-      Util.message_not_understood "factory" m
-
-let init () =
-  Node.bind_ignore (Node.name_of_string "factory", Node.make "factory" factory_handler)

hop_server.ml

@@ -1,59 +0,0 @@
-(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
-
-(* This file is part of Hop. *)
-
-(* Hop is free software: you can redistribute it and/or modify it *)
-(* under the terms of the GNU General Public License as published by the *)
-(* Free Software Foundation, either version 3 of the License, or (at your *)
-(* option) any later version. *)
-
-(* Hop is distributed in the hope that it will be useful, but *)
-(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
-(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU *)
-(* General Public License for more details. *)
-
-(* You should have received a copy of the GNU General Public License *)
-(* 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 old_hook = !Log.hook in
-  let new_hook label body =
-    ignore (Node.post n_system_log (Sexp.Str label) body (Sexp.Str ""));
-    old_hook label body
-  in
-  Log.hook := new_hook
-
-let create_ready_file () =
-  match Config.get "ready-file" with
-  | Some ready_file_path ->
-      Log.info "Creating ready file" [Sexp.Str ready_file_path];
-      close_out (open_out ready_file_path)
-  | None ->
-      ()
-
-let _ =
-  Printf.printf "%s %s, %s\n%s\n%!"
-    App_info.product App_info.version App_info.copyright App_info.licence_blurb;
-  Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
-  Uuid.init ();
-  Config.init ();
-  Factory.init ();
-  Queuenode.init ();
-  Fanoutnode.init ();
-  Directnode.init ();
-  Meta.init ();
-  hook_log ();
-  Amqp_relay.init ();
-  Ui_main.init ();
-  Ui_relay.init ();
-  Relay.init ();
-  Server_control.run_until "AMQP ready";
-  Server_control.run_until "HTTP ready";
-  Server_control.run_until "Hop ready";
-  if Server_control.is_running ()
-  then (create_ready_file ();
-	Server_control.milestone "Server initialized";
-	Server_control.run_forever ())
-  else ()

httpd.ml

@@ -1,393 +0,0 @@
-(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
-
-(* This file is part of Hop. *)
-
-(* Hop is free software: you can redistribute it and/or modify it *)
-(* under the terms of the GNU General Public License as published by the *)
-(* Free Software Foundation, either version 3 of the License, or (at your *)
-(* option) any later version. *)
-
-(* Hop is distributed in the hope that it will be useful, but *)
-(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
-(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU *)
-(* General Public License for more details. *)
-
-(* You should have received a copy of the GNU General Public License *)
-(* along with Hop.  If not, see <http://www.gnu.org/licenses/>. *)
-
-open Unix
-
-type version = [`HTTP_1_0 | `HTTP_1_1]
-type resp_version = [version | `SAME_AS_REQUEST]
-type content = Fixed of string | Variable of Stringstream.t
-type completion = Completion_normal | Completion_error
-
-type body = {
-    headers: (string * string) list;
-    content: content
-  }
-
-let empty_content = Fixed ""
-let empty_body = {headers = []; content = empty_content}
-
-type req = {
-    verb: string;
-    path: string;
-    query: (string * string option) list;
-    req_version: version;
-    req_body: body
-  }
-
-type resp = {
-    resp_version: resp_version;
-    status: int;
-    reason: string;
-    resp_body: body;
-    completion_callbacks: (completion -> unit) list
-  }
-
-exception HTTPError of (int * string * body)
-
-let html_content_type = "text/html;charset=utf-8"
-let text_content_type = "text/plain;charset=utf-8"
-
-let content_type_header_name = "Content-Type"
-
-let html_content_type_header = (content_type_header_name, html_content_type)
-let text_content_type_header = (content_type_header_name, text_content_type)
-
-let disable_cache_headers () =
-  ["Expires", "Thu, 01 Jan 1981 00:00:00 GMT";
-   "Last-Modified", Httpd_date.http_gmtime (Unix.time ());
-   "Cache-Control", "no-cache, must-revalidate, max-age=0";
-   "Pragma", "no-cache"]
-
-let add_headers headers resp =
-  let b = resp.resp_body in
-  {resp with resp_body = {b with headers = b.headers @ headers}}
-
-let add_disable_cache_headers resp = add_headers (disable_cache_headers ()) resp
-
-let add_date_header resp = add_headers ["Date", Httpd_date.http_gmtime (Unix.time ())] resp
-
-let add_completion_callback cb resp =
-  {resp with completion_callbacks = cb :: resp.completion_callbacks}
-
-let http_error code reason body = raise (HTTPError (code, reason, body))
-
-let http_error_plain code reason =
-  http_error code reason
-    {headers = [text_content_type_header]; content = Fixed reason}
-
-let http_error_html_doc code reason doc =
-  http_error code reason
-    {headers = [html_content_type_header];
-     content = Variable (Html.stream_of_html_doc doc)}
-
-let html_error_doc code reason extra_body =
-  let code_str = string_of_int code in
-  (Html.html_document (code_str^" "^reason) []
-     ((Html.tag "h1" [] [Html.text reason]) :: extra_body))
-
-let http_error_html code reason extra_body =
-  http_error_html_doc code reason (html_error_doc code reason extra_body)
-
-let resp_generic code reason headers content =
-  { resp_version = `SAME_AS_REQUEST;
-    status = code;
-    reason = reason;
-    resp_body = {headers = headers; content = content};
-    completion_callbacks = [] }
-
-let resp_generic_ok headers content =
-  resp_generic 200 "OK" headers content
-
-let resp_html_doc code reason extra_headers doc =
-  resp_generic code reason
-    (html_content_type_header :: extra_headers)
-    (Variable (Html.stream_of_html_doc doc))
-
-let resp_html_doc_ok extra_headers doc = resp_html_doc 200 "OK" extra_headers doc
-
-let resp_html code reason extra_headers title content =
-  resp_html_doc code reason extra_headers (Html.html_document title [] content)
-
-let resp_html_ok extra_headers title content =
-  resp_html 200 "OK" extra_headers title content
-
-let resp_plain code reason extra_headers text =
-  resp_generic code reason
-    (text_content_type_header :: extra_headers)
-    (Fixed text)
-
-let resp_plain_ok extra_headers text =
-  resp_plain 200 "OK" extra_headers text
-
-let resp_redirect_permanent new_path =
-  resp_html_doc 301 "Moved permanently" ["Location", new_path]
-    (html_error_doc 301 "Moved permanently"
-       [Html.text "The document has moved ";
-	Html.tag "a" ["href", new_path] [Html.text "here"];
-	Html.text "."])
-
-let escape_url_char c =
-  match c with
-  | '%' -> Some (fun (s, pos) -> ("%25", pos + 1))
-  | ' ' -> Some (fun (s, pos) -> ("%20", pos + 1))
-  | _ -> None
-let url_escape s = Util.strsub escape_url_char s
-
-let unescape_url_hex_code (s, pos) =
-  let len = String.length s in
-  if len - pos >= 3
-  then
-    let v1 = Util.unhex_char (String.get s (pos + 1)) in
-    let v2 = Util.unhex_char (String.get s (pos + 2)) in
-    if v1 = -1 || v2 = -1
-    then http_error_html 400 ("Bad percent escaping: '"^String.sub s pos 3^"'") []
-    else (String.make 1 (Char.chr (v1 * 16 + v2)), pos + 3)
-  else http_error_html 400 ("Bad percent escaping: '"^String.sub s pos (len - pos)^"'") []
-
-let unescape_url_char c =
-  match c with
-  | '%' -> Some unescape_url_hex_code
-  | _ -> None
-
-let url_unescape s = Util.strsub unescape_url_char s
-
-let render_header cout (k, v) =
-  output_string cout k;
-  output_string cout ": ";
-  output_string cout v;
-  output_string cout "\r\n"
-
-let render_chunk cout (chunk, should_flush) =
-  (match chunk with
-  | "" -> ()
-  | _ ->
-      output_string cout (Printf.sprintf "%x\r\n" (String.length chunk));
-      output_string cout chunk;
-      output_string cout "\r\n");
-  if should_flush then flush cout else ()
-
-let render_fixed_content cout s headers_only =
-  render_header cout ("Content-Length", string_of_int (String.length s));
-  output_string cout "\r\n";
-  if headers_only then () else output_string cout s
-
-let string_of_content c =
-  match c with
-  | Fixed s -> s
-  | Variable s -> Stringstream.to_string s
-
-let render_content cout v c headers_only =
-  match c with
-  | Fixed s ->
-      render_fixed_content cout s headers_only
-  | Variable s ->
-      match v with
-      | `HTTP_1_0 ->
-	  render_fixed_content cout (Stringstream.to_string s) headers_only
-      | `HTTP_1_1 ->
-	  if headers_only
-	  then (output_string cout "\r\n")
-	  else (render_header cout ("Transfer-Encoding", "chunked");
-		output_string cout "\r\n";
-		Stringstream.iter (render_chunk cout) s;
-		output_string cout "0\r\n\r\n")
-
-let render_body cout v b headers_only =
-  List.iter (render_header cout) b.headers;
-  render_content cout v b.content headers_only
-
-let string_of_version v =
-  match v with
-  | `HTTP_1_0 -> "HTTP/1.0"
-  | `HTTP_1_1 -> "HTTP/1.1"
-
-let version_of_string v =
-  match v with
-  | "HTTP/1.0" -> `HTTP_1_0
-  | "HTTP/1.1" -> `HTTP_1_1
-  | _ -> http_error_html 400 "Invalid HTTP version" []
-
-let render_req cout r =
-  output_string cout (r.verb^" "^url_escape r.path^" "^string_of_version r.req_version^"\r\n");
-  render_body cout r.req_version r.req_body false
-
-let render_resp cout req_version req_verb r =
-  let resp_version =
-    (match r.resp_version with
-    | `SAME_AS_REQUEST -> req_version
-    | #version as v -> v)
-  in
-  output_string cout
-    (string_of_version resp_version^" "^string_of_int r.status^" "^r.reason^"\r\n");
-  render_body cout resp_version r.resp_body (match req_verb with "HEAD" -> true | _ -> false)
-
-let split_query p =
-  match Str.bounded_split (Str.regexp "\\?") p 2 with
-  | path :: query :: _ -> (path, query)
-  | path :: [] -> (path, "")
-  | [] -> ("", "")
-
-let parse_urlencoded_binding s =
-  match Str.bounded_split (Str.regexp "=") s 2 with
-  | k :: v :: _ -> (url_unescape k, Some (url_unescape v))
-  | k :: [] -> (url_unescape k, None)
-  | [] -> ("", None)
-
-let parse_urlencoded q =
-  let pieces = Str.split (Str.regexp "&") q in
-  List.map parse_urlencoded_binding pieces
-
-let find_header' name hs =
-  let lc_name = String.lowercase name in
-  let rec search hs =
-    match hs with
-    | [] -> raise Not_found
-    | (k, v) :: hs' ->
-	if String.lowercase k = lc_name
-	then v
-	else search hs'
-  in
-  search hs
-
-let find_header name hs =
-  try Some (find_header' name hs) with Not_found -> None
-
-let find_param name params =
-  try Some (List.assoc name params) with Not_found -> None
-
-let input_crlf cin =
-  let line = input_line cin in
-  let len = String.length line in
-  if len > 0 && String.get line (len - 1) = '\r'
-  then String.sub line 0 (len - 1)
-  else line
-
-let rec parse_headers cin =
-  match Str.bounded_split (Str.regexp ":") (input_crlf cin) 2 with
-  | [] ->
-      []
-  | [k; v] ->
-      (k, Util.strip v) :: parse_headers cin
-  | k :: _ ->
-      http_error_html 400 ("Bad header: "^k) []
-
-let parse_chunks cin =
-  fun () ->
-    let hexlen_str = input_crlf cin in
-    let chunk_len = Util.unhex hexlen_str in
-    let buffer = String.make chunk_len '\000' in
-    really_input cin buffer 0 chunk_len;
-    (if input_crlf cin <> "" then http_error_html 400 "Invalid chunk boundary" [] else ());
-    if chunk_len = 0 then None else Some (buffer, false)
-
-let parse_body cin =
-  let headers = parse_headers cin in
-  match find_header "Transfer-Encoding" headers with
-  | None | Some "identity" ->
-      (match find_header "Content-Length" headers with
-      | None ->
-	  (* http_error_html 411 "Length required" [] *)
-	  {headers = headers; content = empty_content}
-      | Some length_str ->
-	  let length = int_of_string length_str in
-	  let buffer = String.make length '\000' in
-	  really_input cin buffer 0 length;
-	  {headers = headers; content = Fixed buffer})
-  | Some "chunked" ->
-      {headers = headers; content = Variable (Stringstream.from_iter (parse_chunks cin))}
-  | Some unsupported ->
-      http_error_html 400 ("Unsupported Transfer-Encoding: "^unsupported) []
-
-let rec parse_req cin spurious_newline_credit =
-  match Str.bounded_split (Str.regexp " ") (input_crlf cin) 3 with
-  | [] ->
-      (* HTTP spec requires that we ignore leading CRLFs. We choose to do so, up to a point. *)
-      if spurious_newline_credit = 0
-      then http_error_html 400 "Bad request: too many leading CRLFs" []
-      else parse_req cin (spurious_newline_credit - 1)
-  | [verb; path; version_str] ->
-      let version = version_of_string version_str in
-      let body = parse_body cin in
-      let (path, query) = split_query path in
-      let path = url_unescape path in
-      let query = parse_urlencoded query in
-      { verb = verb; path = path; query = query; req_version = version; req_body = body }
-  | _ -> http_error_html 400 "Bad request line" []
-
-let discard_unread_body req =
-  match req.req_body.content with
-  | Fixed _ -> ()
-  | Variable s -> Stringstream.iter (fun v -> ()) s (* force chunks to be read *)
-
-let connection_keepalive req =
-  find_header "Connection" req.req_body.headers = Some "keep-alive"
-
-let main handle_req (s, peername) =
-  let cin = in_channel_of_descr s in
-  let cout = out_channel_of_descr s in
-  (try
-    (try
-      let rec request_loop () =
-	let req = parse_req cin 512 in
-	let resp = handle_req req in
-
-	let completion_mutex = Mutex.create () in
-	let completion = ref None in
-	let set_completion v =
-	  Util.with_mutex0 completion_mutex (fun () ->
-	    match !completion with
-	    | None ->
-		completion := Some v;
-		List.iter (fun cb -> cb v) resp.completion_callbacks
-	    | Some _ -> ())
-	in
-
-	(* Here we spawn a thread that just watches the socket to see
-	if it either becomes active or closes during rendering of the
-	response, so that we can make decisions based on this in any
-	eventual streaming response generators. In particular, if
-	we're implementing some kind of XHR streaming andthe client
-	goes away, we want to abandon the streaming as soon as
-	possible. *)
-	let input_waiter () =
-	  try
-	    (let (r, w, e) = Unix.select [s] [] [s] (-1.0) in
-	    set_completion (if r <> [] then Completion_normal else Completion_error))
-	  with _ -> set_completion Completion_error
-	in
-	ignore (Thread.create input_waiter ());
-
-	(try
-	  render_resp cout req.req_version req.verb resp;
-	  discard_unread_body req;
-	  flush cout;
-	  set_completion Completion_normal
-	with e ->
-	  set_completion Completion_error;
-	  raise e);
-
-	if connection_keepalive req then request_loop () else ()
-      in
-      request_loop ()
-    with
-    | End_of_file ->
-	()
-    | HTTPError (code, reason, body) ->
-	render_resp cout `HTTP_1_0
-	  "GET" (* ugh this should probably be done better *)
-	  { resp_version = `HTTP_1_0;
-	    status = code;
-	    reason = reason;
-	    resp_body = body;
-	    completion_callbacks = [] })
-  with
-  | Sys_error message ->
-      Log.info "Sys_error in httpd handler" [Sexp.Str message]
-  | exn ->
-      Log.error "Uncaught exception in httpd handler" [Sexp.Str (Printexc.to_string exn)]);
-  (try flush cout with _ -> ());
-  close s

java/.gitignore

@@ -0,0 +1,6 @@
+out
+build
+*.iml
+*.ipr
+*.iws
+.idea

java/build.xml

@@ -0,0 +1,24 @@
+<?xml version="1.0"?>
+<project name="Hop" default="jar">
+  <path id="javac.classpath">
+    <fileset dir="lib">
+      <include name="**/*.jar"/>
+    </fileset>
+  </path>
+
+  <target name="build">
+    <mkdir dir="build/classes"/>
+    <javac destdir="build/classes" classpathref="javac.classpath" debug="true">
+      <src path="src"/>
+    </javac>
+  </target>
+
+  <target name="jar" depends="build">
+    <mkdir dir="build/lib"/>
+    <jar destfile="build/lib/hop.jar" basedir="build/classes" />
+  </target>
+
+  <target name="clean">
+    <delete dir="build"/>
+  </target>
+</project>

java/src/hop/HalfQueue.java

@@ -0,0 +1,39 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+import java.util.concurrent.BlockingQueue;
+import java.util.concurrent.LinkedBlockingQueue;
+
+/**
+ */
+public class HalfQueue implements Node {
+    public BlockingQueue<Object> _q;
+
+    public HalfQueue() {
+        _q = new LinkedBlockingQueue<Object>();
+    }
+
+    public void handle(Object message) {
+        _q.add(message);
+    }
+
+    public BlockingQueue<Object> getQueue() {
+        return _q;
+    }
+}

java/src/hop/InvalidGreetingException.java

@@ -0,0 +1,30 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+import java.io.IOException;
+
+/**
+ */
+public class InvalidGreetingException extends IOException {
+    Object _greeting;
+
+    public InvalidGreetingException(Object greeting) {
+        _greeting = greeting;
+    }
+}

java/src/hop/Node.java

@@ -0,0 +1,24 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+/**
+ */
+public interface Node {
+    void handle(Object message);
+}

java/src/hop/NodeContainer.java

@@ -0,0 +1,115 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+import java.io.Flushable;
+import java.io.IOException;
+import java.lang.ref.WeakReference;
+import java.util.*;
+
+/**
+ */
+public class NodeContainer implements Flushable {
+    public String _name;
+    public Map<String, WeakReference<Node>> _directory;
+
+    public NodeContainer() {
+        this(UUID.randomUUID().toString());
+    }
+
+    public NodeContainer(String name) {
+        _name = name;
+        _directory = new Hashtable<String, WeakReference<Node>>();
+    }
+
+    public String getName() {
+        return _name;
+    }
+
+    public synchronized boolean bind(String name, Node n) {
+        WeakReference<Node> ref = _directory.get(name);
+        if (ref != null && ref.get() != null) {
+            return false;
+        }
+        ref = new WeakReference<Node>(n);
+        _directory.put(name, ref);
+        return true;
+    }
+
+    public synchronized boolean unbind(String name) {
+        if (!_directory.containsKey(name))
+            return false;
+        _directory.remove(name);
+        return true;
+    }
+
+    public void flush() throws IOException {
+        ArrayList<Flushable> fs = new ArrayList<Flushable>();
+        synchronized (this) {
+            for (Map.Entry<String, WeakReference<Node>> e : _directory.entrySet()) {
+                Node n = e.getValue().get();
+                if (n instanceof Flushable) {
+                    fs.add((Flushable) n);
+                }
+            }
+        }
+        for (Flushable f : fs) {
+            f.flush();
+        }
+    }
+
+    public void flush(String name) throws IOException {
+        Flushable f;
+        synchronized (this) {
+            WeakReference<Node> ref = _directory.get(name);
+            if (ref == null) return;
+            Node n = ref.get();
+            if (n == null) return;
+            if (!(n instanceof Flushable)) return;
+            f = ((Flushable) n);
+        }
+        f.flush();
+    }
+
+    public synchronized void unbindReferencesTo(Node n) {
+        for (Map.Entry<String, WeakReference<Node>> e : _directory.entrySet()) {
+            if (e.getValue().get() == n) {
+                _directory.remove(e.getKey());
+            }
+        }
+    }
+
+    public synchronized Node lookup(String name) {
+        WeakReference<Node> r = _directory.get(name);
+        return (r == null) ? null : r.get();
+    }
+
+    public boolean post(String sink, Object name, Object message, Object token) {
+        return send(sink, SexpMessage.post(name, message, token));
+    }
+
+    public boolean send(String name, Object message) {
+        Node n = lookup(name);
+        if (n == null) {
+            System.err.println("Warning: sending to nonexistent node " + name + "; message " + message);
+            return false;
+        }
+        n.handle(message);
+        return true;
+    }
+}

java/src/hop/Relay.java

@@ -0,0 +1,148 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+import java.io.*;
+import java.net.Socket;
+
+/**
+ */
+public class Relay implements Runnable, Node, Flushable {
+    NodeContainer _container;
+    String _remoteName;
+    Socket _sock;
+    String _hostname;
+    int _port;
+    SexpReader _r;
+    OutputStream _output;
+    SexpWriter _w;
+
+    public Relay(NodeContainer container, String hostname) throws IOException, InterruptedException {
+        this(container, hostname, 5671);
+    }
+
+    public Relay(NodeContainer container, String hostname, int port) throws IOException, InterruptedException {
+        _container = container;
+        _remoteName = null;
+        _hostname = hostname;
+        _port = port;
+        _connect();
+    }
+
+    public String getRemoteName() {
+        return _remoteName;
+    }
+
+    public void _connect() throws IOException, InterruptedException {
+        _sock = new Socket(_hostname, _port);
+        _sock.setTcpNoDelay(true);
+        _r = new SexpReader(new BufferedInputStream(_sock.getInputStream()));
+        _output = new BufferedOutputStream(_sock.getOutputStream());
+        _w = new SexpWriter(_output);
+        _login();
+        new Thread(this).start();
+        synchronized (this) {
+            while (_remoteName == null) {
+                this.wait();
+            }
+        }
+    }
+
+    public void _login() throws IOException {
+        SexpList greeting = _r.readList();
+        if (!greeting.getBytes(0).getDataString().equals("hop")) {
+            throw new InvalidGreetingException(greeting);
+        }
+
+        _w.write(SexpMessage.subscribe(_container.getName(), null, null, null, null));
+    }
+
+    public void handle(Object message) {
+        try {
+            _w.write(message);
+        } catch (IOException ioe) {
+            ioe.printStackTrace();
+            System.err.print("Message to be written was: ");
+            try {
+                SexpWriter.write(System.err, message);
+            } catch (IOException ioe2) {
+                ioe2.printStackTrace();
+            }
+            System.err.println();
+        }
+    }
+
+    public void flush() throws IOException {
+        _output.flush();
+    }
+
+    public void run() {
+        SexpList m = null;
+        try {
+            while (true) {
+                m = _r.readList();
+                if (m == null) {
+                    break;
+                }
+                //System.err.println("Received: " + m);
+                String selector = m.getBytes(0).getDataString();
+                if (selector.equals("post") && m.size() == 4) {
+                    _container.send(m.getBytes(1).getDataString(), m.get(2));
+                } else if (selector.equals("subscribe") && m.size() == 6) {
+                    if (_remoteName != null) {
+                        System.err.println("Double bind attempted");
+                    } else {
+                        _remoteName = m.getBytes(1).getDataString();
+                        if (_container.bind(_remoteName, this)) {
+                            String replySink = m.getBytes(4).getDataString();
+                            if (replySink.length() > 0) {
+                                _container.post(replySink, m.get(5), SexpMessage.subscribe_ok(_remoteName), null);
+                            }
+                        } else {
+                            System.err.println("Bind failed: " + _remoteName);
+                        }
+                        synchronized (this) {
+                            this.notifyAll();
+                        }
+                    }
+                } else if (selector.equals("unsubscribe") && m.size() == 2) {
+                    if (!m.getBytes(1).getDataString().equals(_remoteName)) {
+                        System.err.println("Unknown unbind attempted");
+                    } else {
+                        if (!_container.unbind(m.getBytes(1).getDataString())) {
+                            System.err.println("Unbind failed: " + m.get(1));
+                        }
+                    }
+                } else {
+                    System.err.print("Unknown message: ");
+                    SexpWriter.write(System.err, m);
+                    System.err.println();
+                }
+            }
+        } catch (IOException ioe) {
+            ioe.printStackTrace();
+            System.err.print("Most recent received message: ");
+            try {
+                SexpWriter.write(System.err, m);
+            } catch (IOException ioe2) {
+                ioe2.printStackTrace();
+            }
+            System.err.println();
+        }
+    }
+}

java/src/hop/ServerApi.java

@@ -0,0 +1,101 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+import java.io.Flushable;
+import java.io.IOException;
+import java.util.UUID;
+
+/**
+ */
+public class ServerApi implements Flushable {
+    public NodeContainer _container;
+    public String _serverName;
+    public String _kName;
+    public HalfQueue _k;
+
+    public ServerApi(NodeContainer container, String serverName) {
+        _container = container;
+        _serverName = serverName;
+        _kName = UUID.randomUUID().toString();
+        _k = new HalfQueue();
+        _container.bind(_kName, _k);
+    }
+
+    public SexpList _nextReply() throws InterruptedException, SexpSyntaxError {
+        Object x = _k.getQueue().take();
+        if (x instanceof SexpList) return (SexpList) x;
+        throw new SexpSyntaxError("Unexpected non-list");
+    }
+
+    public void post(String sink, Object name, Object message, Object token) {
+        _container.post(_serverName, sink, SexpMessage.post(name, message, token), null);
+    }
+
+    public void send(String sink, Object message) {
+        _container.post(_serverName, sink, message, null);
+    }
+
+    public void flush() throws IOException {
+        _container.flush(_serverName);
+    }
+
+    public synchronized Object subscribe(String source, Object filter, String sink, String name) throws InterruptedException, IOException {
+        send(source, SexpMessage.subscribe(filter, sink, name, _container.getName(), _kName));
+        flush();
+        SexpList reply = _nextReply();
+        assert reply.getBytes(0).getDataString().equals(SexpMessage._subscribe_ok);
+        return reply.get(1);
+    }
+
+    public synchronized Object subscribe(String source, Object filter, String name) throws InterruptedException, IOException {
+        return subscribe(source, filter, _container.getName(), name);
+    }
+
+    public Subscription subscribe(String source, Object filter) throws InterruptedException, IOException {
+        return new Subscription(this, source, filter);
+    }
+
+    public void unsubscribe(String source, Object token) throws IOException {
+        send(source, SexpMessage.unsubscribe(token));
+        flush();
+        /* TODO: optional synchronous reply? */
+    }
+
+    public synchronized Object create(String nodeClassName, Object arg) throws InterruptedException, IOException {
+        send("factory", SexpMessage.create(nodeClassName, arg, _container.getName(), _kName));
+        flush();
+        SexpList reply = _nextReply();
+        SexpBytes selector = reply.getBytes(0);
+        if (selector.equals(SexpMessage._create_ok)) return null;
+        assert selector.equals(SexpMessage._create_failed);
+        return reply.get(1);
+    }
+
+    public Object createQueue(String name) throws InterruptedException, IOException {
+        return create("queue", SexpList.with(name));
+    }
+
+    public Object createFanout(String name) throws InterruptedException, IOException {
+        return create("fanout", SexpList.with(name));
+    }
+
+    public Object createDirect(String name) throws InterruptedException, IOException {
+        return create("direct", SexpList.with(name));
+    }
+}

java/src/hop/SexpBytes.java

@@ -0,0 +1,57 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+import java.io.IOException;
+import java.io.OutputStream;
+import java.util.Arrays;
+
+/**
+ */
+public class SexpBytes {
+    public byte[] _bytes;
+
+    public SexpBytes(byte[] bytes) {
+        _bytes = bytes;
+    }
+
+    public byte[] getData() {
+        return _bytes;
+    }
+
+    public String getDataString() {
+        return new String(getData());
+    }
+
+    public void writeTo(OutputStream stream) throws IOException {
+        SexpWriter.writeSimpleString(stream, _bytes);
+    }
+
+    public String toString() {
+        return SexpWriter.writeString(this);
+    }
+
+    public boolean equals(Object other) {
+        return (other instanceof SexpBytes) &&
+            Arrays.equals(_bytes, ((SexpBytes) other).getData());
+    }
+
+    public int hashCode() {
+        return Arrays.hashCode(_bytes);
+    }
+}

java/src/hop/SexpDisplayHint.java

@@ -0,0 +1,43 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+import java.io.IOException;
+import java.io.OutputStream;
+
+/**
+ */
+public class SexpDisplayHint extends SexpBytes {
+    public byte[] _hint;
+
+    public SexpDisplayHint(byte[] hint, byte[] body) {
+        super(body);
+        _hint = hint;
+    }
+
+    public byte[] getHint() {
+        return _hint;
+    }
+
+    public void writeTo(OutputStream stream) throws IOException {
+        stream.write('[');
+        SexpWriter.writeSimpleString(stream, _hint);
+        stream.write(']');
+        super.writeTo(stream);
+    }
+}

java/src/hop/SexpList.java

@@ -0,0 +1,53 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+import java.util.ArrayList;
+
+/**
+ */
+public class SexpList extends ArrayList<Object> {
+    public SexpBytes getBytes(int index) throws SexpSyntaxError {
+        Object x = get(index);
+        if (x != null && !(x instanceof SexpBytes)) {
+            throw new SexpSyntaxError("Unexpected non-bytes");
+        }
+        return (SexpBytes) get(index);
+    }
+
+    public SexpList getList(int index) throws SexpSyntaxError {
+        Object x = get(index);
+        if (x != null && !(x instanceof SexpList)) {
+            throw new SexpSyntaxError("Unexpected non-list");
+        }
+        return (SexpList) get(index);
+    }
+
+    public static SexpList empty() {
+        return new SexpList();
+    }
+
+    public static SexpList with(Object x) {
+        return empty().and(x);
+    }
+
+    public SexpList and(Object x) {
+        this.add(x);
+        return this;
+    }
+}

java/src/hop/SexpMessage.java

@@ -0,0 +1,74 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+/**
+ */
+public class SexpMessage {
+    public static SexpBytes _post = new SexpBytes("post".getBytes());
+    public static SexpBytes _subscribe = new SexpBytes("subscribe".getBytes());
+    public static SexpBytes _unsubscribe = new SexpBytes("unsubscribe".getBytes());
+    public static SexpBytes _subscribe_ok = new SexpBytes("subscribe-ok".getBytes());
+    public static SexpBytes _create = new SexpBytes("create".getBytes());
+    public static SexpBytes _create_ok = new SexpBytes("create-ok".getBytes());
+    public static SexpBytes _create_failed = new SexpBytes("create-failed".getBytes());
+
+    public static SexpList post(Object name, Object message, Object token) {
+        SexpList m = new SexpList();
+        m.add(_post);
+        m.add(name);
+        m.add(message);
+        m.add(token);
+        return m;
+    }
+
+    public static SexpList subscribe(Object filter, String sink, Object name, String replySink, Object replyName) {
+        SexpList m = new SexpList();
+        m.add(_subscribe);
+        m.add(filter);
+        m.add(sink);
+        m.add(name);
+        m.add(replySink);
+        m.add(replyName);
+        return m;
+    }
+
+    public static SexpList subscribe_ok(Object token) {
+        SexpList m = new SexpList();
+        m.add(_subscribe_ok);
+        m.add(token);
+        return m;
+    }
+
+    public static SexpList unsubscribe(Object token) {
+        SexpList m = new SexpList();
+        m.add(_unsubscribe);
+        m.add(token);
+        return m;
+    }
+
+    public static SexpList create(String nodeClassName, Object arg, String replySink, Object replyName) {
+        SexpList m = new SexpList();
+        m.add(_create);
+        m.add(nodeClassName);
+        m.add(arg);
+        m.add(replySink);
+        m.add(replyName);
+        return m;
+    }
+}

java/src/hop/SexpReader.java

@@ -0,0 +1,150 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+import java.io.IOException;
+import java.io.InputStream;
+
+public class SexpReader {
+    public InputStream _input;
+
+    public SexpReader(InputStream input) {
+        _input = input;
+    }
+
+    /**
+     * Reads a sexp length-prefix from _input.
+     * @return The read length, or -1 if the end of stream is reached
+     * @throws IOException
+     * @throws SexpSyntaxError
+     */
+    public int _readLength(int lengthSoFar) throws IOException {
+        int length = lengthSoFar;
+
+        while (true) {
+            int c = _input.read();
+            if (c == -1) return -1;
+            if (c == ':') {
+                return length;
+            }
+            if (!Character.isDigit(c)) {
+                throw new SexpSyntaxError("Invalid length prefix");
+            }
+            length = length * 10 + (c - '0');
+        }
+    }
+
+    /**
+     * Reads a simple length-prefixed string from _input, given either zero or the value
+     * of the first digit of the length-prefix being read.
+     * @param lengthSoFar either zero or the first digit of the length prefix to use
+     * @return the read string
+     * @throws IOException
+     * @throws SexpSyntaxError
+     */
+    public byte[] _readSimpleString(int lengthSoFar) throws IOException {
+        int length = _readLength(lengthSoFar);
+        if (length == -1) return null;
+        byte[] buf = new byte[length];
+        int offset = 0;
+        while (length > 0) {
+            int count = _input.read(buf, offset, length);
+            if (count == -1) {
+                throw new SexpSyntaxError("End-of-stream in the middle of a simple string");
+            }
+            offset += count;
+            length -= count;
+        }
+        return buf;
+    }
+
+    public byte[] readSimpleString() throws IOException {
+        return _readSimpleString(0);
+    }
+
+    public SexpList _readList() throws IOException {
+        SexpList list = new SexpList();
+        while (true) {
+            int c = _input.read();
+            switch (c) {
+                case -1:
+                    throw new SexpSyntaxError("Unclosed list");
+                case ')':
+                    return list;
+                default:
+                    list.add(_read(c));
+                    break;
+            }
+        }
+    }
+
+    public Object _read(int c) throws IOException {
+        while (true) {
+            switch (c) {
+                case -1:
+                    return null;
+                case '(':
+                    return _readList();
+                case ')':
+                    throw new SexpSyntaxError("Unexpected close-paren");
+                case '[':
+                    byte[] hint = readSimpleString();
+                    switch (_input.read()) {
+                        case -1:
+                            throw new SexpSyntaxError("End-of-stream between display hint and body");
+                        case ']':
+                            break;
+                        default:
+                            throw new SexpSyntaxError("Unexpected character after display hint");
+                    }
+                    byte[] body = readSimpleString();
+                    return new SexpDisplayHint(hint, body);
+                default:
+                    if (Character.isDigit(c)) {
+                        return new SexpBytes(_readSimpleString(c - '0'));
+                    } else if (Character.isWhitespace(c)) {
+                        // Skip harmless (?) whitespace
+                        c = _input.read();
+                        continue;
+                    } else {
+                        throw new SexpSyntaxError("Unexpected character: " + c);
+                    }
+            }
+        }
+    }
+
+    public Object read() throws IOException {
+        return _read(_input.read());
+    }
+
+    public SexpList readList() throws IOException {
+        Object x = read();
+        if (x != null && !(x instanceof SexpList)) {
+            throw new SexpSyntaxError("Unexpected non-list");
+        }
+        return (SexpList) x;
+    }
+
+    public SexpBytes readBytes() throws IOException {
+        Object x = read();
+        if (x != null && !(x instanceof SexpBytes)) {
+            throw new SexpSyntaxError("Unexpected non-bytes");
+        }
+        return (SexpBytes) x;
+    }
+}

java/src/hop/SexpSyntaxError.java

@@ -0,0 +1,29 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+import java.io.IOException;
+
+/**
+ * Reports on a syntax problem reading an S-expression.
+ */
+public class SexpSyntaxError extends IOException {
+    public SexpSyntaxError(String s) {
+        super(s);
+    }
+}

java/src/hop/SexpWriter.java

@@ -0,0 +1,81 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+import java.io.ByteArrayOutputStream;
+import java.io.IOException;
+import java.io.OutputStream;
+import java.util.List;
+
+/**
+ */
+public class SexpWriter {
+    public OutputStream _output;
+
+    public SexpWriter(OutputStream output) {
+        _output = output;
+    }
+
+    public static void writeSimpleString(OutputStream stream, byte[] buf) throws IOException {
+        stream.write(Integer.toString(buf.length).getBytes());
+        stream.write(':');
+        stream.write(buf);
+    }
+
+    public void write(Object x) throws IOException {
+        if (x instanceof String) {
+            writeSimpleString(_output, ((String) x).getBytes());
+            return;
+        }
+        if (x instanceof byte[]) {
+            writeSimpleString(_output, ((byte[]) x));
+            return;
+        }
+        if (x instanceof SexpBytes) {
+            ((SexpBytes) x).writeTo(_output);
+            return;
+        }
+        if (x instanceof List) {
+            _output.write('(');
+            for (Object v : ((List<Object>) x)) {
+                write(v);
+            }
+            _output.write(')');
+            return;
+        }
+        if (x == null) {
+            _output.write("0:".getBytes());
+            return;
+        }
+        throw new SexpSyntaxError("Unsupported sexp object type");
+    }
+
+    public static void write(OutputStream output, Object x) throws IOException {
+        new SexpWriter(output).write(x);
+    }
+
+    public static String writeString(Object x) {
+        try {
+            ByteArrayOutputStream o = new ByteArrayOutputStream();
+            write(o, x);
+            return new String(o.toByteArray());
+        } catch (IOException ioe) {
+            return x.toString();
+        }
+    }
+}

java/src/hop/Subscription.java

@@ -0,0 +1,51 @@
+// Copyright 2011, 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>.
+//
+// This file is part of Hop.
+//
+// Hop is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 3 of the License, or
+// (at your option) any later version.
+//
+// Hop is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+// or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+// License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Hop.  If not, see <http://www.gnu.org/licenses/>.
+//
+package hop;
+
+import java.io.IOException;
+import java.util.UUID;
+import java.util.concurrent.BlockingQueue;
+
+/**
+ */
+public class Subscription {
+    public ServerApi _api;
+    public String _source;
+    public Object _filter;
+    public String _consumerName;
+    public HalfQueue _consumer;
+    public Object _subscriptionToken;
+
+    public Subscription(ServerApi api, String source, Object filter) throws InterruptedException, IOException {
+        _api = api;
+        _source = source;
+        _filter = filter;
+        _consumerName = UUID.randomUUID().toString();
+        _consumer = new HalfQueue();
+        _api._container.bind(_consumerName, _consumer);
+        _subscriptionToken = _api.subscribe(source, filter, _consumerName);
+    }
+
+    public BlockingQueue<Object> getQueue() {
+        return _consumer.getQueue();
+    }
+
+    public void unsubscribe() throws IOException {
+        _api.unsubscribe(_source, _subscriptionToken);
+    }
+}