diff --git a/.gitignore b/.gitignore
index d4fe983..2d8bc85 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,9 @@ _build/
*.native
message.ml
amqp_spec.ml
+
+thirdparty/_dist
+thirdparty/lwt-2.3.2/setup.data
+thirdparty/lwt-2.3.2/setup.log
+thirdparty/lwt-2.3.2/src/unix/lwt_config.h
+thirdparty/lwt-2.3.2/src/unix/lwt_config.ml
diff --git a/Makefile b/Makefile
index fa16799..3dcc5b3 100644
--- a/Makefile
+++ b/Makefile
@@ -2,7 +2,28 @@ APP=hop_server
TEMPLATES=$(wildcard web/bootstrap/templates/*.xml)
HTML=$(subst web/bootstrap/templates/,web/,$(subst .xml,.html,$(TEMPLATES)))
-all: message.ml amqp_spec.ml $(APP).native web/bootstrap/css/bootstrap.css webpages
+# Augment the path ocamlfind uses to discover installed packages.
+OCAMLPATH=$(CURDIR)/thirdparty/_dist
+export OCAMLPATH
+
+LWT_SRC_DIR=thirdparty/lwt-2.3.2
+
+all: \
+ thirdparty/_dist \
+ message.ml amqp_spec.ml \
+ $(APP).native \
+ web/bootstrap/css/bootstrap.css \
+ webpages
+
+thirdparty/_dist:
+ mkdir -p $@
+ (mkdir $@/lwt && \
+ (cd $(LWT_SRC_DIR) && \
+ ./configure --disable-libev && \
+ make && \
+ OCAMLFIND_LDCONF=ignore \
+ OCAMLFIND_DESTDIR="$(CURDIR)/$@" \
+ make install))
webpages: $(HTML)
@@ -26,11 +47,19 @@ clean: webclean
rm -f message.ml
rm -f amqp_spec.ml
-veryclean: clean
+thirdpartyclean:
+ rm -rf thirdparty/_dist
+ rm -rf $(LWT_SRC_DIR)/_build
+ rm -f $(LWT_SRC_DIR)/setup.data
+ rm -f $(LWT_SRC_DIR)/setup.log
+ rm -f $(LWT_SRC_DIR)/src/unix/lwt_config.h
+ rm -f $(LWT_SRC_DIR)/src/unix/lwt_config.ml
+
+veryclean: clean thirdpartyclean
rm -f web/bootstrap/css/bootstrap.css
$(APP).native: $(wildcard *.ml)
- ocamlbuild $@
+ ocamlbuild -use-ocamlfind -X thirdparty $@
run: all
./$(APP).native
diff --git a/_tags b/_tags
index f7a5408..129d262 100644
--- a/_tags
+++ b/_tags
@@ -1,3 +1,4 @@
-true: use_unix
+true: package(lwt.unix)
+true: package(lwt.syntax)
+true: syntax(camlp4o)
true: use_str
-true: thread
diff --git a/connections.ml b/connections.ml
index 78773e6..a20d089 100644
--- a/connections.ml
+++ b/connections.ml
@@ -15,12 +15,11 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see . *)
+open Lwt
open Unix
open Printf
-open Thread
open Sexp
-let connection_mtx = Mutex.create ()
let connection_count = ref 0
let endpoint_name n =
@@ -28,49 +27,53 @@ let endpoint_name n =
| 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 flush_output flush_control cout =
+ let keep_running = ref true in
+ Lwt.pick [
+ Lwt_stream.next flush_control;
+ while_lwt !keep_running do
+ try_lwt
+ lwt () = Lwt_io.flush cout in
+ Lwt_unix.sleep 0.1
+ with _ ->
+ keep_running := false;
+ return ()
+ done
+ ]
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") []
+ ignore (Log.info ("Accepted "^class_name) [Str (endpoint_name peername)]);
+ match_lwt issue_banner cin cout with
+ | true ->
+ let (flush_control, flush_stop) = Lwt_stream.create () in
+ ignore (flush_output flush_control cout);
+ lwt shared_state = boot_fn (peername, cin, cout) in
+ let n = Node.make class_name (node_fn shared_state) in
+ lwt () =
+ (try_lwt
+ 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)])
+ in
+ flush_stop None;
+ Node.unbind_all n
+ | false ->
+ 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 cin = Lwt_io.of_fd Lwt_io.input s in
+ let cout = Lwt_io.of_fd Lwt_io.output s in
+ connection_count := !connection_count + 1;
+ lwt () = connection_main class_name peername cin cout issue_banner boot_fn node_fn mainloop in
+ connection_count := !connection_count - 1;
+ lwt () = (try_lwt Lwt_io.flush cout with _ -> return ()) in
+ Lwt_unix.close s
let start_connection class_name issue_banner boot_fn node_fn mainloop (s, peername) =
Util.create_thread
diff --git a/directnode.ml b/directnode.ml
index d34f514..6594f0c 100644
--- a/directnode.ml
+++ b/directnode.ml
@@ -15,6 +15,7 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see . *)
+open Lwt
open Sexp
open Datastructures
open Status
@@ -22,72 +23,69 @@ 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 -> ())
+ match_lwt 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 ->
+ ());
+ return ()
+ | _ -> return ())
+ | None -> return ()
let route_message info n sexp =
match Message.message_of_sexp sexp with
- | Message.Post (Str name, body, token) ->
+ | 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
+ Lwt_list.iter_s
(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) ->
+ | Some sub ->
+ lwt _ = Subscription.send_to_subscription' sub body (unsubscribe info) in
+ return ()
+ | None ->
+ return ())
+ (UuidSet.elements matching)
+ | Message.Subscribe (Str binding_key as filter, Str sink, name, Str reply_sink, reply_name) ->
+ lwt 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;
+ return ()
+ | Message.Unsubscribe (Str token) ->
unsubscribe info token
- | m ->
+ | m ->
Util.message_not_understood classname m
let factory arg =
match arg with
- | (Arr [Str name_str]) ->
+ | (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")
+ | _ ->
+ return (Problem (Str "bad-arg"))
let init () =
Factory.register_class classname factory
diff --git a/factory.ml b/factory.ml
index 5afbd33..133f78c 100644
--- a/factory.ml
+++ b/factory.ml
@@ -15,23 +15,23 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see . *)
+open Lwt
open Printf
open Sexp
open Datastructures
-type factory_t = Sexp.t -> (Sexp.t, Sexp.t) Status.t
+type factory_t = Sexp.t -> (Sexp.t, Sexp.t) Status.t Lwt.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))
+ if StringMap.mem name !classes
+ then (ignore (Log.error "Duplicate node class name" [Str name]);
+ Server_control.shutdown_now [Str "Duplicate node class name"; Str name];
+ Lwt_unix.yield ())
+ else (ignore (Log.info "Registered node class" [Str name]);
+ classes := StringMap.add name factory !classes;
+ return ())
let all_class_names () =
Datastructures.string_map_keys !classes
@@ -43,21 +43,21 @@ let lookup_class name =
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 =
+ lwt 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"])
+ | Some factory ->
+ (match_lwt factory arg with
+ | Status.Ok info ->
+ ignore (Log.info "Node create ok"
+ [Str classname; arg; Str reply_sink; Str reply_name; info]);
+ return (Message.create_ok info)
+ | Status.Problem explanation ->
+ ignore (Log.info "Node create failed"
+ [Str classname; arg; Str reply_sink; Str reply_name; explanation]);
+ return (Message.create_failed (Arr [Str "constructor"; explanation])))
+ | None ->
+ ignore (Log.warn "Node class not found" [Str classname]);
+ return (Message.create_failed (Arr [Str "factory"; Str "class-not-found"]))
in
Node.post_ignore' reply_sink (Str reply_name) reply (Str "")
| m ->
diff --git a/fanoutnode.ml b/fanoutnode.ml
index b25abdd..f788b3e 100644
--- a/fanoutnode.ml
+++ b/fanoutnode.ml
@@ -15,6 +15,7 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see . *)
+open Lwt
open Sexp
open Datastructures
open Status
@@ -22,46 +23,42 @@ open Status
type t = {
name: Node.name;
subscriptions: Subscription.set_t;
- mtx: Mutex.t;
}
let classname = "fanout"
let unsubscribe info uuid =
- Util.with_mutex0 info.mtx
- (fun () -> ignore (Subscription.delete info.name info.subscriptions uuid))
+ lwt _ = Subscription.delete info.name info.subscriptions uuid in return ()
let route_message info n sexp =
match Message.message_of_sexp sexp with
- | Message.Post (Str name, body, token) ->
+ | Message.Post (Str name, body, token) ->
let snapshot = !(info.subscriptions) in
- StringMap.iter
- (fun uuid sub ->
- ignore (Subscription.send_to_subscription' sub body (unsubscribe info)))
- snapshot
- | Message.Subscribe (Str binding_key as filter, Str sink, name, Str reply_sink, reply_name) ->
- Util.with_mutex0 info.mtx
- (fun () ->
- ignore (Subscription.create
- info.name info.subscriptions filter sink name reply_sink reply_name))
- | Message.Unsubscribe (Str token) ->
+ Lwt_list.iter_s
+ (fun (uuid, sub) ->
+ lwt _ = Subscription.send_to_subscription' sub body (unsubscribe info) in return ())
+ (StringMap.bindings snapshot)
+ | Message.Subscribe (Str binding_key as filter, Str sink, name, Str reply_sink, reply_name) ->
+ lwt _ = (Subscription.create
+ info.name info.subscriptions filter sink name reply_sink reply_name) in
+ return ()
+ | Message.Unsubscribe (Str token) ->
unsubscribe info token
- | m ->
+ | m ->
Util.message_not_understood classname m
let factory arg =
match arg with
- | (Arr [Str name_str]) ->
+ | (Arr [Str name_str]) ->
let info = {
name = Node.name_of_string name_str;
- subscriptions = Subscription.new_set ();
- mtx = Mutex.create ();
+ subscriptions = Subscription.new_set ()
} in
replace_ok
(Node.make_idempotent_named classname info.name (route_message info))
(Str name_str)
- | _ ->
- Problem (Str "bad-arg")
+ | _ ->
+ return (Problem (Str "bad-arg"))
let init () =
Factory.register_class classname factory
diff --git a/hop_server.ml b/hop_server.ml
index 7a50779..298cd59 100644
--- a/hop_server.ml
+++ b/hop_server.ml
@@ -15,6 +15,8 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see . *)
+open Lwt
+
let n_system_log = Node.name_of_string "system.log"
let hook_log () =
@@ -27,33 +29,33 @@ let hook_log () =
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 ->
- ()
+ | Some ready_file_path ->
+ ignore (Log.info "Creating ready file" [Sexp.Str ready_file_path]);
+ return (close_out (open_out ready_file_path))
+ | None ->
+ return ()
-let _ =
+lwt _ =
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 ();
+ lwt () = Factory.init () in
+ lwt () = Queuenode.init () in
+ lwt () = Fanoutnode.init () in
+ lwt () = Directnode.init () in
+ lwt () = Meta.init () in
hook_log ();
- Amqp_relay.init ();
- Ui_main.init ();
- Ui_relay.init ();
+ (* 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";
+ (* Server_control.run_until "AMQP ready";
+ Server_control.run_until "HTTP ready"; *)
+ lwt () = Server_control.run_until "Hop ready" in
if Server_control.is_running ()
- then (create_ready_file ();
+ then (lwt () = create_ready_file () in
Server_control.milestone "Server initialized";
Server_control.run_forever ())
- else ()
+ else return ()
diff --git a/log.ml b/log.ml
index ee38313..b9285ab 100644
--- a/log.ml
+++ b/log.ml
@@ -15,18 +15,16 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see . *)
+open Lwt
open Sexp
-let mtx = Mutex.create ()
let write_to_log label body =
- Mutex.lock mtx;
- (try
- print_string label;
- print_string ": ";
- output_sexp_human stdout body;
- print_newline ()
- with _ -> ());
- Mutex.unlock mtx
+ try_lwt
+ lwt () = Lwt_io.print label in
+ lwt () = Lwt_io.print ": " in
+ lwt () = output_sexp_human Lwt_io.stdout body in
+ Lwt_io.printl ""
+ with _ -> return ()
let hook = ref write_to_log
diff --git a/net.ml b/net.ml
index ba42d40..f7b86ae 100644
--- a/net.ml
+++ b/net.ml
@@ -15,19 +15,20 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see . *)
-open Unix
+open Lwt_unix
let rec accept_loop sock connection_start_fn =
- let (s, peername) = accept sock in
- setsockopt s TCP_NODELAY true;
+ lwt (s, peername) = accept sock in
+ setsockopt s Unix.TCP_NODELAY true;
ignore (connection_start_fn (s, peername));
accept_loop sock connection_start_fn
let start_net protocol_name port_number connection_start_fn =
- let sock = socket PF_INET SOCK_STREAM 0 in
- setsockopt sock SO_REUSEADDR true;
- bind sock (ADDR_INET (inet_addr_of_string "0.0.0.0", port_number));
+ let sock = socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+ setsockopt sock Unix.SO_REUSEADDR true;
+ bind sock (Unix.ADDR_INET (Unix.inet_addr_any, port_number));
listen sock 5;
Server_control.milestone (protocol_name ^ " ready");
- Log.info "Accepting connections" [Sexp.Str protocol_name; Sexp.Str (string_of_int port_number)];
+ ignore (Log.info "Accepting connections"
+ [Sexp.Str protocol_name; Sexp.Str (string_of_int port_number)]);
accept_loop sock connection_start_fn
diff --git a/node.ml b/node.ml
index e62f7b5..d1f0de9 100644
--- a/node.ml
+++ b/node.ml
@@ -15,11 +15,12 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see . *)
+open Lwt
open Printf
open Datastructures
open Status
-type handle_message_t = t -> Sexp.t -> unit
+type handle_message_t = t -> Sexp.t -> unit Lwt.t
and t = {
mutable names: StringSet.t;
class_name: string;
@@ -40,14 +41,12 @@ module NameSet = Set.Make(struct
let compare a b = String.compare a.label b.label
end)
-let mutex = Mutex.create ()
let name_table = NameTable.create 100
let directory = ref NameSet.empty
let name_of_string str =
- Util.with_mutex0 mutex (fun () ->
- let template = {label = str; binding = None} in
- NameTable.merge name_table template)
+ let template = {label = str; binding = None} in
+ NameTable.merge name_table template
let local_container_name () = "server"
@@ -70,57 +69,66 @@ let approx_exists name =
let bind (filter, node) =
if filter.label = ""
- then (Log.warn "Binding to empty name forbidden" []; false)
+ then (ignore (Log.warn "Binding to empty name forbidden" []); return false)
else
- Util.with_mutex0 mutex (fun () ->
- filter.binding <- Some node;
- directory := NameSet.add filter !directory;
- node.names <- StringSet.add filter.label node.names;
- Log.info "Node bound" [Sexp.Str filter.label; Sexp.Str node.class_name];
- true)
+ (filter.binding <- Some node;
+ directory := NameSet.add filter !directory;
+ node.names <- StringSet.add filter.label node.names;
+ ignore (Log.info "Node bound" [Sexp.Str filter.label; Sexp.Str node.class_name]);
+ return true)
(* For use in factory constructor functions, hence the odd return type and values *)
let make_named class_name node_name handler =
let node = make class_name handler in
- if bind (node_name, node) then Ok node else Problem (Sexp.Str "bind-failed")
+ match_lwt bind (node_name, node) with
+ | true -> return (Ok node)
+ | false -> return (Problem (Sexp.Str "bind-failed"))
(* For use in factory constructor functions, hence the odd return type and values *)
let make_idempotent_named class_name node_name handler =
match lookup node_name with
| Some n ->
- if n.class_name = class_name
+ return (if n.class_name = class_name
then Ok n
- else Problem (Sexp.Str "class-mismatch")
+ else Problem (Sexp.Str "class-mismatch"))
| None ->
let node = make class_name handler in
- if bind (node_name, node) then Ok node else Problem (Sexp.Str "bind-failed")
+ match_lwt bind (node_name, node) with
+ | true -> return (Ok node)
+ | false -> return (Problem (Sexp.Str "bind-failed"))
let unbind name =
- Util.with_mutex0 mutex (fun () ->
- match lookup name with
+ match lookup name with
| Some n ->
- Log.info "Node unbound" [Sexp.Str name.label; Sexp.Str n.class_name];
- n.names <- StringSet.remove name.label n.names;
- name.binding <- None;
- directory := NameSet.remove name !directory;
- true
+ ignore (Log.info "Node unbound" [Sexp.Str name.label; Sexp.Str n.class_name]);
+ n.names <- StringSet.remove name.label n.names;
+ name.binding <- None;
+ directory := NameSet.remove name !directory;
+ return true
| None ->
- false)
+ return false
let unbind_all n =
- StringSet.iter (fun name -> ignore (unbind (name_of_string name))) n.names;
- n.names <- StringSet.empty
+ lwt () =
+ Lwt_list.iter_s
+ (fun name -> lwt _ = unbind (name_of_string name) in return ())
+ (StringSet.elements n.names)
+ in
+ n.names <- StringSet.empty;
+ return ()
let send name body =
match lookup name with
- | Some n ->
- (try n.handle_message n body
- with e ->
- Log.warn "Node message handler raised exception"
- [Sexp.Str name.label;
- Sexp.Str (Printexc.to_string e)]);
- true
- | None -> false
+ | Some n ->
+ ignore
+ (try_lwt n.handle_message n body
+ with e ->
+ Log.warn "Node message handler raised exception"
+ [Sexp.Str name.label;
+ Sexp.Str (Printexc.to_string e)]);
+ return true
+ | None ->
+ return false
let send' str body = send (name_of_string str) body
@@ -130,14 +138,17 @@ let post name label body token =
let post' str label body token = post (name_of_string str) label body token
let bind_ignore (filter, node) =
- if bind (filter, node)
- then ()
- else Log.warn "Duplicate binding" [Sexp.Str filter.label]
+ match_lwt bind (filter, node) with
+ | true -> return ()
+ | false -> Log.warn "Duplicate binding" [Sexp.Str filter.label]
let send_ignore name body =
- if send name body || name.label = ""
- then ()
- else Log.warn "send to missing node" [Sexp.Str name.label; body]
+ match_lwt send name body with
+ | true -> return ()
+ | false ->
+ if name.label = ""
+ then return ()
+ else Log.warn "send to missing node" [Sexp.Str name.label; body]
let send_ignore' str body = send_ignore (name_of_string str) body
diff --git a/queuenode.ml b/queuenode.ml
index 6206892..4ea7f14 100644
--- a/queuenode.ml
+++ b/queuenode.ml
@@ -15,87 +15,87 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see . *)
+open Lwt
open Sexp
open Status
+(* TODO: on unsubscribe, wake up the shoveller to make it clean out its waiters queue *)
+
type t = {
- name: Node.name;
- subscriptions: Subscription.set_t;
- ch: Message.t Squeue.t;
- mutable backlog: Sexp.t Queue.t;
- mutable waiters: Subscription.t Queue.t;
- }
+ name: Node.name;
+ subscriptions: Subscription.set_t;
+ backlog_in: Sexp.t Lwt_stream.t;
+ backlog_out: Sexp.t option -> unit;
+ waiters_in: Subscription.t Lwt_stream.t;
+ waiters_out: Subscription.t option -> unit;
+ mutable backlog: int;
+ mutable waiters: int;
+}
let classname = "queue"
let report info n =
- Log.info (Printf.sprintf "do_burst %d capacity, %d backlog, %d waiters, %d ticks left\n%!"
- (Squeue.approx_capacity info.ch)
- (Queue.length info.backlog)
- (Queue.length info.waiters)
+ Log.info (Printf.sprintf "do_burst %d backlog, %d waiters, %d ticks left\n%!"
+ info.backlog
+ info.waiters
n) []
-let rec do_burst info n =
- (* report info n; *)
- if Queue.is_empty info.backlog then false
- else
- if Queue.is_empty info.waiters then false
- else
- if n = 0 then true (* maybe more work available, but should poll for outside events *)
- else
- let body = Queue.peek info.backlog in
- let sub = Queue.pop info.waiters in
- if Subscription.send_to_subscription info.name info.subscriptions sub body
- then
- (Queue.push sub info.waiters;
- ignore (Queue.pop info.backlog);
- do_burst info (n - 1))
- else
- do_burst info n
-
-let rec process_and_wait info =
- if not (do_burst info 1000)
- then Squeue.pop info.ch
- else
- match Squeue.peek info.ch with
- | Some m -> m
- | None -> process_and_wait info
-
let shoveller info =
- let rec loop () =
- match process_and_wait info with
+ let rec message_loop () =
+ lwt body = Lwt_stream.next info.backlog_in in
+ let rec waiter_loop () =
+ lwt sub = Lwt_stream.next info.waiters_in in
+ match_lwt Subscription.send_to_subscription info.name info.subscriptions sub body with
+ | true ->
+ info.backlog <- info.backlog - 1;
+ info.waiters_out (Some sub);
+ message_loop ()
+ | false ->
+ waiter_loop ()
+ in waiter_loop ()
+ in message_loop ()
+
+let queue_handler info n sexp =
+ match Message.message_of_sexp sexp with
| Message.Post (name, body, token) ->
- Queue.push body info.backlog;
- loop ()
+ info.backlog <- info.backlog + 1;
+ info.backlog_out (Some body);
+ return ()
| Message.Subscribe (filter, Str sink, name, Str reply_sink, reply_name) ->
- let sub =
- Subscription.create
- info.name info.subscriptions filter sink name reply_sink reply_name in
- Queue.push sub info.waiters;
- loop ()
+ lwt sub =
+ Subscription.create
+ info.name info.subscriptions filter sink name reply_sink reply_name in
+ info.waiters <- info.waiters + 1;
+ info.waiters_out (Some sub);
+ return ()
| Message.Unsubscribe (Str token) ->
- ignore (Subscription.delete info.name info.subscriptions token);
- loop ()
+ ignore (Subscription.delete info.name info.subscriptions token);
+ info.waiters <- info.waiters - 1;
+ return ()
| m ->
- Util.message_not_understood "queue" m;
- loop ()
- in loop ()
+ Util.message_not_understood "queue" m
let queue_factory arg =
match arg with
- | (Arr [Str name_str]) ->
+ | (Arr [Str name_str]) ->
+ let (bin, bout) = Lwt_stream.create () in
+ let (win, wout) = Lwt_stream.create () in
let info = {
name = Node.name_of_string name_str;
subscriptions = Subscription.new_set ();
- ch = Squeue.create 1000;
- backlog = Queue.create ();
- waiters = Queue.create ()
+ backlog_in = bin;
+ backlog_out = bout;
+ waiters_in = win;
+ waiters_out = wout;
+ backlog = 0;
+ waiters = 0
} in
ignore (Util.create_thread name_str None shoveller info);
- let queue_handler n sexp = Squeue.add (Message.message_of_sexp sexp) info.ch in
- replace_ok (Node.make_idempotent_named classname info.name queue_handler) (Str name_str)
- | _ ->
- Problem (Str "bad-arg")
+ replace_ok
+ (Node.make_idempotent_named classname info.name (queue_handler info))
+ (Str name_str)
+ | _ ->
+ return (Problem (Str "bad-arg"))
let init () =
Factory.register_class classname queue_factory
diff --git a/relay.ml b/relay.ml
index 4e87d9c..339d82e 100644
--- a/relay.ml
+++ b/relay.ml
@@ -15,14 +15,14 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see . *)
+open Lwt
open Unix
open Printf
-open Thread
open Sexp
let send_error ch message details =
let m = Message.error (Str message, details) in
- Log.warn "Sending error" [m];
+ ignore (Log.warn "Sending error" [m]);
ch m
let send_sexp_syntax_error ch explanation =
@@ -30,48 +30,51 @@ let send_sexp_syntax_error ch explanation =
let dispatch_message n ch m =
match m with
- | Message.Post (Str name, body, token) ->
+ | Message.Post (Str name, body, token) ->
Node.send_ignore' name body
- | Message.Subscribe (Str filter, sink, name, Str reply_sink, Str reply_name) ->
- if Node.bind (Node.name_of_string filter, n)
- then Node.post_ignore'
- reply_sink
- (Str reply_name)
- (Message.subscribe_ok (Str filter))
- (Str "")
- else Log.warn "Bind failed" [Str filter]
- | Message.Unsubscribe (Str token) ->
- if Node.unbind (Node.name_of_string token)
- then ()
- else Log.warn "Unbind failed" [Str token]
- | _ ->
+ | Message.Subscribe (Str filter, sink, name, Str reply_sink, Str reply_name) ->
+ (match_lwt Node.bind (Node.name_of_string filter, n) with
+ | true ->
+ Node.post_ignore'
+ reply_sink
+ (Str reply_name)
+ (Message.subscribe_ok (Str filter))
+ (Str "")
+ | false ->
+ Log.warn "Bind failed" [Str filter])
+ | Message.Unsubscribe (Str token) ->
+ (match_lwt Node.unbind (Node.name_of_string token) with
+ | true -> return ()
+ | false -> Log.warn "Unbind failed" [Str token])
+ | _ ->
send_error ch "Message not understood" (Message.sexp_of_message m)
let issue_banner cin cout =
- output_sexp_and_flush cout (Arr [Str "hop"; Str ""]);
- output_sexp_and_flush cout
- (Message.subscribe (Str (Node.local_container_name()),
- Str "", Str "",
- Str "", Str ""));
- true
+ lwt () = output_sexp_and_flush cout (Arr [Str "hop"; Str ""]) in
+ lwt () =
+ output_sexp_and_flush cout
+ (Message.subscribe (Str (Node.local_container_name()),
+ Str "", Str "",
+ Str "", Str "")) in
+ return true
-let relay_boot (peername, mtx, cin, cout) = (peername, mtx, cin, cout)
+let relay_boot (peername, cin, cout) = return (peername, Lwt_mutex.create (), cin, cout)
let relay_handler (_, mtx, _, cout) _ m =
- Util.with_mutex mtx (output_sexp_and_flush cout) m
+ Lwt_mutex.with_lock mtx (fun () -> output_sexp_and_flush cout m)
let relay_mainloop (peername, mtx, cin, cout) n =
- let write_sexp = Util.with_mutex mtx (output_sexp cout) in
- (try
- while true do
- dispatch_message n write_sexp (Message.message_of_sexp (Sexp.input_sexp cin))
- done
- with
- | Sexp.Syntax_error explanation ->
- (send_sexp_syntax_error write_sexp explanation;
+ let write_sexp sexp = Lwt_mutex.with_lock mtx (fun () -> output_sexp cout sexp) in
+ (try_lwt
+ while_lwt true do
+ lwt message_sexp = Sexp.input_sexp cin in
+ dispatch_message n write_sexp (Message.message_of_sexp message_sexp)
+ done
+ with
+ | Sexp.Syntax_error explanation ->
+ lwt () = send_sexp_syntax_error write_sexp explanation in
Log.info "Disconnected relay for syntax error"
[Str (Connections.endpoint_name peername); Str explanation])
- )
let start (s, peername) =
Connections.start_connection "relay" issue_banner
diff --git a/server_control.ml b/server_control.ml
index ec2aca7..3ebb3b5 100644
--- a/server_control.ml
+++ b/server_control.ml
@@ -15,18 +15,17 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see . *)
+open Lwt
open Datastructures
let continue_running = ref true
-let control_queue = Squeue.create 1
+let (cq_in, cq_out) = Lwt_stream.create ()
let achieved_milestones = ref StringSet.empty
-let milestone name =
- Squeue.add (`Milestone name) control_queue
+let milestone name = cq_out (Some (`Milestone name))
-let shutdown_now details =
- Squeue.add (`Shutdown details) control_queue
+let shutdown_now details = cq_out (Some (`Shutdown details))
let is_milestone_achieved m =
match m with
@@ -37,16 +36,16 @@ let is_milestone_achieved m =
let rec run' until_milestone =
match is_milestone_achieved until_milestone with
- | true ->
- ()
- | false ->
- (match Squeue.pop control_queue with
- | `Shutdown details ->
- Log.error "Shutting down server" details;
+ | true ->
+ return ()
+ | false ->
+ (match_lwt Lwt_stream.next cq_in with
+ | `Shutdown details ->
+ ignore (Log.error "Shutting down server" details);
continue_running := false;
- ()
- | `Milestone name ->
- Log.info "Achieved milestone" [Sexp.Str name];
+ return ()
+ | `Milestone name ->
+ ignore (Log.info "Achieved milestone" [Sexp.Str name]);
achieved_milestones := StringSet.add name !achieved_milestones;
run' until_milestone)
@@ -54,11 +53,11 @@ let is_running () = !continue_running
let run_until milestone =
if !continue_running
- then (Log.info "Waiting for milestone" [Sexp.Str milestone];
+ then (ignore (Log.info "Waiting for milestone" [Sexp.Str milestone]);
run' (Some milestone))
- else ()
+ else return ()
let run_forever () =
if !continue_running
then run' None
- else ()
+ else return ()
diff --git a/sexp.ml b/sexp.ml
index 9eb2179..039b588 100644
--- a/sexp.ml
+++ b/sexp.ml
@@ -17,6 +17,9 @@
(* SPKI SEXP *)
+open Lwt
+open Lwt_io
+
exception Syntax_error of string
type display_hint_t = {hint : t; body : t}
@@ -26,23 +29,23 @@ and t =
| Arr of t list
let _output_str ch s =
- output_string ch (string_of_int (String.length s));
- output_char ch ':';
- output_string ch s
+ lwt () = write ch (string_of_int (String.length s)) in
+ lwt () = write_char ch ':' in
+ write ch s
let rec output_sexp ch x =
match x with
- | Str s ->
+ | Str s ->
_output_str ch s
- | Hint {hint = h; body = b} ->
- output_char ch '[';
- output_sexp ch h;
- output_char ch ']';
+ | Hint {hint = h; body = b} ->
+ lwt () = write_char ch '[' in
+ lwt () = output_sexp ch h in
+ lwt () = write_char ch ']' in
output_sexp ch b
- | Arr xs ->
- output_char ch '(';
- List.iter (output_sexp ch) xs;
- output_char ch ')'
+ | Arr xs ->
+ lwt () = write_char ch '(' in
+ lwt () = Lwt_list.iter_s (output_sexp ch) xs in
+ write_char ch ')'
let rec stream_of_sexp x =
Stringstream.make (fun () ->
@@ -58,34 +61,39 @@ let rec stream_of_sexp x =
Some ("(", false,
Stringstream.seq (Stringstream.map stream_of_sexp xs) (Stringstream.const ")")))
-let output_char_escaped ch c =
+let write_char_escaped ch c =
if c = '\"'
- then output_string ch "\\\""
- else output_char ch c
+ then write ch "\\\""
+ else write_char ch c
let rec output_sexp_human ch x =
match x with
- | Str s ->
- output_char ch '\"';
- String.iter (output_char_escaped ch) s;
- output_char ch '\"'
- | Hint {hint = h; body = b} ->
- output_char ch '[';
- output_sexp_human ch h;
- output_char ch ']';
+ | Str s ->
+ lwt () = write_char ch '\"' in
+ lwt () = write ch (String.escaped s) in
+ write_char ch '\"'
+ | Hint {hint = h; body = b} ->
+ lwt () = write_char ch '[' in
+ lwt () = output_sexp_human ch h in
+ lwt () = write_char ch ']' in
output_sexp_human ch b
- | Arr xs ->
- output_char ch '(';
- (match xs with
- | [] -> ()
- | [x] -> output_sexp_human ch x
- | (x :: xs') ->
- output_sexp_human ch x;
- List.iter (fun x -> output_char ch ' '; output_sexp_human ch x) xs');
- output_char ch ')'
+ | Arr xs ->
+ lwt () = write_char ch '(' in
+ lwt () =
+ (match xs with
+ | [] -> return ()
+ | [x] -> output_sexp_human ch x
+ | (x :: xs') ->
+ lwt () = output_sexp_human ch x in
+ Lwt_list.iter_s
+ (fun x ->
+ lwt () = write_char ch ' ' in
+ output_sexp_human ch x)
+ xs') in
+ write_char ch ')'
let output_sexp_and_flush ch x =
- output_sexp ch x;
+ lwt () = output_sexp ch x in
flush ch
let char_numeric c = '0' <= c && c <= '9'
@@ -95,47 +103,50 @@ let digit_val c = (int_of_char c) - (int_of_char '0')
let input_bytes ch count =
let buf = String.create count in (* mutable strings?!?! *)
- really_input ch buf 0 count;
- buf
+ lwt () = read_into_exactly ch buf 0 count in
+ return buf
-let syntax_error explanation = raise (Syntax_error explanation)
+let syntax_error explanation = raise_lwt (Syntax_error explanation)
let input_sexp_outer input_char input_bytes =
let rec input_simple_string len =
- match input_char () with
- | ':' -> Str (input_bytes len)
- | b when char_numeric b -> input_simple_string (len * 10 + digit_val b)
- | _ -> syntax_error "Bad simple-string length character"
+ match_lwt input_char () with
+ | ':' -> lwt bs = input_bytes len in return (Str bs)
+ | b when char_numeric b -> input_simple_string (len * 10 + digit_val b)
+ | _ -> syntax_error "Bad simple-string length character"
in
let rec input_sexp_list () =
let rec collect acc =
- match input_sexp_inner () with
- | None -> Arr (List.rev acc)
- | Some v -> collect (v :: acc)
+ match_lwt input_sexp_inner () with
+ | None -> return (Arr (List.rev acc))
+ | Some v -> collect (v :: acc)
in collect []
and input_sexp_inner () =
- match input_char () with
- | '(' -> Some (input_sexp_list ())
- | ')' -> None
- | '[' ->
- let hint = input_simple_string 0 in
- (match input_char () with
- | ']' -> Some (Hint {hint = hint; body = input_simple_string 0})
- | _ -> syntax_error "Missing close-bracket in display hint")
- | b when char_numeric b ->
- Some (input_simple_string (digit_val b))
- | b when char_whitespace b ->
+ match_lwt input_char () with
+ | '(' -> lwt xs = input_sexp_list () in return (Some xs)
+ | ')' -> return None
+ | '[' ->
+ lwt hint = input_simple_string 0 in
+ (match_lwt input_char () with
+ | ']' -> lwt b = input_simple_string 0 in return (Some (Hint {hint = hint; body = b}))
+ | _ -> syntax_error "Missing close-bracket in display hint")
+ | b when char_numeric b ->
+ lwt s = input_simple_string (digit_val b) in return (Some s)
+ | b when char_whitespace b ->
(* Convenience for testing *)
input_sexp_inner ()
- | _ ->
+ | _ ->
syntax_error "Bad SEXP input character"
in
- match input_sexp_inner () with
- | None -> syntax_error "Unexpected end of list"
- | Some v -> v
+ match_lwt input_sexp_inner () with
+ | None -> syntax_error "Unexpected end of list"
+ | Some v -> return v
-let input_sexp ch = input_sexp_outer (fun () -> input_char ch) (input_bytes ch)
-let parse b = input_sexp_outer (fun () -> Ibuffer.next_char b) (Ibuffer.next_chars b)
+let input_sexp ch = input_sexp_outer (fun () -> read_char ch) (input_bytes ch)
+let parse b =
+ input_sexp_outer
+ (fun () -> return (Ibuffer.next_char b))
+ (fun count -> return (Ibuffer.next_chars b count))
let sexp_of_string s = parse (Ibuffer.of_string s)
let string_of_sexp x = Stringstream.to_string (stream_of_sexp x)
diff --git a/squeue.ml b/squeue_linked.ml
similarity index 100%
rename from squeue.ml
rename to squeue_linked.ml
diff --git a/status.ml b/status.ml
index f106269..dffa013 100644
--- a/status.ml
+++ b/status.ml
@@ -15,6 +15,8 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see . *)
+open Lwt
+
type ('success, 'failure) t =
| Ok of 'success
| Problem of 'failure
@@ -38,9 +40,9 @@ let is_transient x =
let is_permanent x = not (is_transient x)
let replace_ok x info =
- match x with
- | Ok _ -> Ok info
- | Problem p -> Problem p
+ match_lwt x with
+ | Ok _ -> return (Ok info)
+ | Problem p -> return (Problem p)
let replace_ok' x info_fn =
match x with
diff --git a/subscription.ml b/subscription.ml
index c590e86..ed88f01 100644
--- a/subscription.ml
+++ b/subscription.ml
@@ -15,6 +15,7 @@
(* You should have received a copy of the GNU General Public License *)
(* along with Hop. If not, see . *)
+open Lwt
open Datastructures
type t = {
@@ -42,19 +43,21 @@ let create source subs filter sink_str name reply_sink reply_name =
name = name
} in
subs := StringMap.add uuid sub !subs;
- Meta.announce_subscription source filter sink_str name true;
- Node.post_ignore' reply_sink reply_name (Message.subscribe_ok (Sexp.Str uuid)) (Sexp.Str "");
- sub
+ lwt () = Lwt.join [
+ Meta.announce_subscription source filter sink_str name true;
+ Node.post_ignore' reply_sink reply_name (Message.subscribe_ok (Sexp.Str uuid)) (Sexp.Str "")
+ ] in
+ return sub
let delete source subs uuid =
- try
+ try_lwt
let sub = StringMap.find uuid !subs in
sub.live <- false;
subs := StringMap.remove uuid !subs;
- Meta.announce_subscription source sub.filter sub.sink.Node.label sub.name false;
- Some sub
+ lwt () = Meta.announce_subscription source sub.filter sub.sink.Node.label sub.name false in
+ return (Some sub)
with Not_found ->
- None
+ return None
let lookup subs uuid =
try Some (StringMap.find uuid !subs)
@@ -62,11 +65,11 @@ let lookup subs uuid =
let send_to_subscription' sub body delete_action =
if not sub.live
- then false
+ then return false
else
- if Node.post sub.sink sub.name body (Sexp.Str sub.uuid)
- then true
- else (delete_action sub.uuid; false)
+ match_lwt Node.post sub.sink sub.name body (Sexp.Str sub.uuid) with
+ | true -> return true
+ | false -> (lwt _ = delete_action sub.uuid in return false)
let send_to_subscription source subs sub body =
send_to_subscription' sub body (fun (uuid) -> delete source subs uuid)
diff --git a/thirdparty/lwt-2.3.2/CHANGES b/thirdparty/lwt-2.3.2/CHANGES
new file mode 100644
index 0000000..72a9c36
--- /dev/null
+++ b/thirdparty/lwt-2.3.2/CHANGES
@@ -0,0 +1,198 @@
+===== 2.3.2 (2011-11-04) =====
+
+ * Add location informations in logs:
+ ** allow loggers to get the current location through local storage
+ ** pass current location to logging functions
+ ** pass the current location with the syntax extension
+ * Add Lwt.on_termination
+ * Add Lwt_unix.reinstall_signal_handler
+ * Add Lwt_io.flush_all
+ * Add assert_lwt keyword to the syntax extension
+ * Add Lwt.wrap
+ * Add Lwt_glib.iter and Lwt_glib.wakeup
+ * ocaml 3.13 ready
+ * Allow to compile without libev support
+ * Fix bugs in Lwt_io
+ * Better handling of forks
+ * Fix many problems on Windows
+
+===== 2.3.1 (2011-07-13) =====
+
+ * Fix building of documentation when using the tarball
+ * Add Lwt_unix.fsync and Lwt_unix.fdatasync
+ * Fix the stubs for Lwt_unix.send_msg when fd-passing is not
+ available
+ * Add -lwt-sequence-strict option to the syntax extension
+ * Use a custom PRNG state for Lwt.choose and Lwt.pick
+ * Fix a display glitch when starting the toplevel
+ * Add Lwt_unix.fork which should now be used when one want to use
+ Lwt in the child process
+ * Better implementation of Lwt_unix.readlink and
+ Lwt_unix.gethostbyname, which fixes compilation on Hurd
+ * Add Lwt.wakeup_later and Lwt.wakeup_later_exn to be used when one
+ need to do lot of nested wakeup, which fixes a buffer overflow in
+ Lwt_mutex
+ * Fix Lwt_unix.abort and Lwt_unix.close (threads was never wakeup)
+ * Fix Lwt_throttle for correct timings
+ * Fix subtle use of cancel
+
+===== 2.3.0 (2011-04-12) =====
+
+ * Add an extensible system of engines to:
+ ** allow the user to replace libev by another event system, such
+ as select
+ ** allow easier integration of external libraries supporting
+ asynchronous operations
+ * Lots of improvements for windows:
+ ** use the ocaml select instead of libev by default on windows
+ ** make asynchronous operations on non-socket file descriptors
+ such as pipes to work
+ ** make glib integration to work
+ * Better use of engines in Lwt_unix: now events are cached to minimize
+ the amount of calls to epoll_ctl
+ * Use an eventfd when possible for notifications for faster delivery
+ * Add modules:
+ ** Lwt_sys: allow to test availability of extra features
+ ** Lwt_react: replace Lwt_event and Lwt_signal
+ * Allow to configure logging rules at runtime in Lwt_log
+ * Add match_lwt and while_lwt to the syntax extension
+ * Fixes:
+ ** syntax extension: handle "lwt ... = ... in ..." at toplevel
+ ** make the notification system fork-proof
+ ** fix an issue with stubs not raising correctly exceptions
+
+===== 2.2.1 (2011-01-26) =====
+
+ * Better interaction with Js_of_ocaml.
+ * Add functions {{{Lwt.register_pause_notifier}}} and {{{Lwt.paused_count}}}.
+
+===== 2.2.0 (2010-12-13) =====
+
+ * Bugfixes:
+ ** Fix a bug with cancellable threads causing {{{Canceled}}}
+ exceptions to be raised randomly
+ ** Fix a fd-leak in Lwt_io.open_connection
+ * {{{Lwt_unix}}} now use libev instead of select
+ * Add thread local storage support to {{{Lwt}}}
+ * Add backtrace support to {{{Lwt}}}. Now {{{Lwt}}} exceptions can
+ be recored by using the syntax extension with the {{{-lwt-debug}}}
+ command line switch.
+ * Allow blocking system calls to be executed in parallels
+ * Change the type of many functions of {{{Lwt_unix}}}, which now
+ return a {{{Lwt}}} thread
+ * Add functions {{{Lwt_unix.readable}}} and {{{Lwt_unix.writable}}}
+ * Add function {{{Lwt_io.is_busy}}}
+ * Add functions {{{Lwt_event.delay}}} and {{{Lwt_signal.delay}}}
+ * Add function {{{Lwt_term.render_update}}}
+ * Add function {{{Lwt_ssl.embed_socket}}}
+ * Add module {{{Lwt_bytes}}} defining operations on bigarrays
+ instead of strings
+ * Use bigarrays in Lwt_io instead of strings for the internal buffer.
+ Lwt_io.make now takes a function that uses a bigarray.
+ * Add module {{{Lwt_switch}}}
+
+===== 2.1.1 (2010-06-13) =====
+
+ * Many bugfixes, including:
+ ** buggy behaviour of cancellable threads
+ ** file descriptor leakage in {{{Lwt_unix.accept_n}}}
+ * Add {{{Lwt.nchoose}}} and {{{Lwt.npick}}}
+ * Use {{{set_close_on_exec}}} for fds created by {{{Lwt_log}}}
+ * Better implementation of lwtized react functions
+
+===== 2.1.0 (2010-04-19) =====
+
+ * Rename {{{Lwt.select}}} to {{{Lwt.pick}}}
+ * Removing module {{{Lwt_monitor}}} in favour of {{{Lwt_mutex}}} and
+ new module {{{Lwt_condition}}}
+ * More react helpers:
+ ** {{{Lwt_event.next}}}
+ ** {{{Lwt_event.limit}}} and {{{Lwt_signal.limit}}}
+ ** {{{Lwt_event.from}}}
+ * Adding function {{{Lwt_main.fast_yield}}}
+ * Adding unit tests
+ * Optimisation of {{{Lwt}}}
+ * Adding module {{{Lwt_log}}} for logging
+ * Adding a camlp4 filter for remmoving logging statement or inlining
+ tests
+ * Adding module {{{Lwt_daemon}}}
+ * Adding function {{{Lwt_unix.recv_msg}}} and {{{Lwt_unix.send_msg}}}
+ * Adding function {{{Lwt_unix.wait4}}}
+ * Adding function {{{Lwt_io.establish_server}}}
+ * Adding module {{{Lwt_list}}}
+ * Enhancement in {{{Lwt_process}}}, it now support redirections and
+ timeouts
+ * Allow to use {{{select}}} on arbitrary high file descriptors
+ * More commands and features in {{{Lwt_read_line}}}:
+ ** Handle "undo" command
+ ** New controlable read-lines instances
+ ** More edition commands
+ ** Completion as you type
+ ** Backward search
+ * Enhancement in {{{Lwt_term}}}: more drawing functions and allow to
+ put the terminal into drawing mode
+ * Optimisation of {{{Lwt_stream}}}
+ * Optimisation of {{{Lwt_io.write_char}}} and {{{Lwt_io.read_char}}}
+ * Bugfix of {{{Lwt_stream}}}: two parallel {{{Lwt_stream.get}}}
+ returned the same value
+ * Bugfix in {{{Lwt_unix.connect}}}: it returned immediatly on EINPROGRESS
+ * Bugfixes in {{{Lwt_glib}}}: file descriptors were not monitored correctly
+
+===== 2.0.0 (2009-10-15) =====
+
+ * Adding modules:
+ ** {{{Lwt_stream}}}: lwt-aware version of the {{{Stream}}} module
+ ** {{{Lwt_gc}}} for using {{{finalise}}} without
+ {{{Lwt_unix.run}}}
+ ** {{{Lwt_io}}}: a new implementation of buffered channels with
+ more features and better handling of concurrent access
+ ** {{{Lwt_text}}}: implementation of text channels
+ ** {{{Lwt_process}}}: helpers to spawn processes and communicate
+ with them
+ ** {{{Lwt_main}}} for abstracting the main loop and allowing
+ replacement by a custom main loop
+ ** {{{Lwt_glib}}} for integration into the glib main event loop
+ ** {{{Lwt_term}}} for interaction with the terminal
+ ** {{{Lwt_read_line}}} for interactive user input
+ ** {{{Lwt_monitor}}}, {{{Lwt_mvar}}}: combined locks for
+ synchronization with conditional variables for notification
+ ** {{{Lwt_throttle}}} for limiting rate of execution
+ (e.g. for authentication procedure)
+ ** {{{Lwt_sequence}}}: mutable sequence of elements
+ ** {{{Lwt_event}}}, {{{Lwt_signal}}}: helpers for reactive
+ programming with lwt
+ * Adding a syntax extension {{{pa_lwt}}}:
+ ** handles anonymous bind {{{a >> b}}}
+ ** adds syntactic sugar for catching errors (ticket #6)
+ ** adds syntactic sugar for parallel let-binding construction
+ ** adds syntactic sugar for for-like loops
+ * Top-level integration:
+ ** threads can runs while reading user input
+ ** line editing support
+ * New enhanced OCaml toplevel with some basic completion features
+ * Adding C stubs to reimplement {{{Unix.read}}} and {{{Unix.write}}}
+ with assumption of non-blocking behaviour
+ * Adding more functions/helpers in {{{Lwt}}}
+ * Fixing memory leaks in {{{Lwt.choose}}}
+ * Bugfix in {{{Lwt_chan.close_*}}} (ticket #66)
+ * Separate the type of threads (covariant) from the type of thread
+ wakeners (contravariant); the type of many functions related to
+ {{{Lwt.wait}}} has been changed
+ * Add cancelable threads
+ * Unix-dependent part is now put in its own archive and findlib
+ package.
+
+===== 1.1.0 (2008-06-25) =====
+
+ * Adding module {{{Lwt_pool}}} for creating pools (for example pools
+ of connections)
+ * Adding a few functions in {{{Lwt_chan}}}
+ * Fixing bugs in {{{Lwt_util.map_serial}}} and
+ {{{Lwt_util.iter_serial}}}
+ * Putting {{{Lwt_preemptive}}}, {{{Lwt_lib}}} and {{{Lwt_ssl}}} in
+ separate libraries and findlib subpackages so that lwt.cma depends
+ only on unix.cma.
+
+===== 1.0.0 (and before) =====
+
+ * See Ocsigen changelog
diff --git a/thirdparty/lwt-2.3.2/CHANGES.darcs b/thirdparty/lwt-2.3.2/CHANGES.darcs
new file mode 100644
index 0000000..6f05076
--- /dev/null
+++ b/thirdparty/lwt-2.3.2/CHANGES.darcs
@@ -0,0 +1,2248 @@
+Fri Nov 4 14:52:56 CET 2011 chambart@crans.org
+ tagged 2.3.2
+
+Fri Nov 4 14:52:20 CET 2011 chambart@crans.org
+ * Update CHANGES and version
+
+Fri Oct 28 23:29:41 CEST 2011 Jeremie Dimino
+ * explain that one need to call Lwt_main.run in a Lwt program in the manual
+
+Mon Oct 10 17:22:32 CEST 2011 gregoire.henry@pps.jussieu.fr
+ * Doc: add menu.wiki
+
+Thu Sep 22 14:33:38 CEST 2011 Jeremie Dimino
+ * use a monospace font in the gtk example
+
+Thu Sep 22 14:28:18 CEST 2011 Jeremie Dimino
+ * add a gtk example
+
+Thu Sep 22 12:57:56 CEST 2011 Jeremie Dimino
+ * make the documentation of Lwt_glib more explicit
+
+Wed Sep 21 14:26:02 CEST 2011 Jeremie Dimino
+ * add Lwt_glib.wakeup
+
+Wed Sep 21 02:05:29 CEST 2011 Jeremie Dimino
+ * acquire the context in Lwt_glib.iter
+
+Wed Sep 21 01:04:31 CEST 2011 Jeremie Dimino
+ * fix compilation of lwt.glib with msvc
+
+Tue Sep 20 23:43:07 CEST 2011 Jeremie Dimino
+ * fix compilation of lwt.glib on windows
+
+Tue Sep 20 23:22:49 CEST 2011 Jeremie Dimino
+ * add Lwt_glib.iter
+
+Mon Sep 19 23:29:12 CEST 2011 Jeremie Dimino
+ * fix Lwt_unix.connect on Windows
+
+Mon Sep 19 23:26:13 CEST 2011 Jeremie Dimino
+ * fix the use of socket on Windows
+
+ Testing whether a file descriptor is a socket with Unix.fstat does not
+ work on Windows:
+
+ # let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0;;
+ val sock : Unix.file_descr =
+ # Unix.fstat sock;;
+ val Unix.stats = { Unix.st_kind = Unix.S_REG; ...
+
+Mon Sep 19 21:49:48 CEST 2011 Jeremie Dimino
+ * cleanup examples
+
+Mon Sep 19 19:27:42 CEST 2011 Jeremie Dimino
+ * do not use pthread on windows
+
+Mon Sep 19 16:12:18 CEST 2011 Jeremie Dimino
+ * fix compilation with msvc tools
+
+ The Microsoft compiler does not allow to mix variable definition and
+ code.
+
+Mon Sep 19 15:48:11 CEST 2011 Jeremie Dimino
+ * handle compilers that prints things on stdout in discover.ml
+
+Thu Sep 15 15:28:05 CEST 2011 Jeremie Dimino
+ * add Lwt.wrap
+
+Thu Sep 15 14:23:35 CEST 2011 Jeremie Dimino
+ * make assert_lwt to work
+
+Thu Sep 15 14:14:48 CEST 2011 Jeremie Dimino
+ * add the assert_lwt keyword in pa_lwt
+
+Wed Sep 7 13:46:26 CEST 2011 Jeremie Dimino
+ * remove ev.h from glib stubs (not used)
+
+Wed Sep 7 13:29:17 CEST 2011 Jeremie Dimino
+ * allow to compile without libev support
+
+Mon Aug 22 21:49:31 CEST 2011 Jeremie Dimino
+ * add a note for compiling the toplevel
+
+Mon Aug 22 21:25:23 CEST 2011 Jeremie Dimino
+ * fix compilation of lwt.text with ocaml >= 3.13
+
+Mon Aug 15 22:44:08 CEST 2011 Jeremie Dimino
+ * add type annotations in Lwt_io for ocaml 3.13
+
+Mon Aug 15 17:16:42 CEST 2011 Jeremie Dimino
+ * reset the job system after a fork
+
+Mon Aug 15 16:10:28 CEST 2011 Jeremie Dimino
+ * cancel jobs after a fork
+
+Mon Aug 15 10:31:16 CEST 2011 Jeremie Dimino
+ * add Lwt_io.flush_all
+
+Mon Aug 15 10:31:00 CEST 2011 Jeremie Dimino
+ * add Lwt.on_termination
+
+Fri Aug 12 16:29:29 CEST 2011 Jeremie Dimino
+ * add Lwt_unix.reinstall_signal_handler
+
+Wed Aug 10 19:06:06 CEST 2011 Jeremie Dimino
+ * fix ticket #169
+
+Thu Aug 4 11:03:48 CEST 2011 Jeremie Dimino
+ * enable location in logs
+
+ - allow loggers to get the current location through local storage
+ - pass current location to logging functions
+ - pass the current location with the syntax extension
+
+Wed Aug 3 20:20:20 CEST 2011 Jeremie Dimino
+ * use a GADT for the type of channels with ocaml 3.13
+
+Thu Jul 28 22:48:06 CEST 2011 Stephane Glondu
+ * Avoid unused-but-set-variable GCC warning
+
+Thu Jul 28 11:52:12 CEST 2011 chambart@crans.org
+ * fix data corruption in Lwt_io.
+
+Mon Jul 18 16:57:31 CEST 2011 Jeremie Dimino
+ * fix a race condition in Lwt_io
+
+Wed Jul 13 19:05:38 CEST 2011 chambart@crans.org
+ tagged 2.3.1
+
+Wed Jul 13 19:03:50 CEST 2011 chambart@crans.org
+ * update licence file (add text of BSD license)
+
+Wed Jul 13 18:40:59 CEST 2011 chambart@crans.org
+ * version 2.3.1
+
+Wed Jul 13 18:38:40 CEST 2011 chambart@crans.org
+ * update CHANGES
+
+Wed Jul 13 18:30:27 CEST 2011 michaell.laporte@gmail.com
+ * Add license in test/core files
+
+Wed Jul 13 11:36:31 CEST 2011 Jeremie Dimino
+ * typo in the doc
+
+Tue Jul 12 18:24:01 CEST 2011 Jeremie Dimino
+ * add a cancel test
+
+Tue Jul 12 18:21:57 CEST 2011 Jeremie Dimino
+ * make Lwt.get_cancel tail-recursive
+
+Tue Jul 12 16:39:02 CEST 2011 Jeremie Dimino
+ * implement union-find for cancel functions
+
+Tue Jul 12 13:41:25 CEST 2011 Jeremie Dimino
+ * fix a recursive call in Lwt.cancel_and_nth_ready
+
+Sat Jul 2 21:05:40 CEST 2011 Jeremie Dimino
+ * simplify setup.ml
+
+Sat Jul 2 12:43:45 CEST 2011 Jeremie Dimino
+ * keep setup.ml for the customization
+
+Thu Jun 30 16:43:24 CEST 2011 Jeremie Dimino
+ * update CHANGES
+
+Thu Jun 9 13:25:57 CEST 2011 chambart@crans.org
+ * rewrite Lwt_throttle
+
+Thu Jun 30 15:58:44 CEST 2011 Jeremie Dimino
+ * do not use Lwt_engine.fake_io anymore in Lwt_unix
+
+Thu Jun 30 15:54:02 CEST 2011 Jeremie Dimino
+ * fix Lwt_unix.abort
+
+Fri Jun 24 21:06:12 CEST 2011 Jeremie Dimino
+ * use more Lwt.wakeup_later
+
+Sat Jun 18 18:36:24 CEST 2011 Jeremie Dimino
+ * remove oasis files from the repository
+
+Sat Jun 18 16:36:31 CEST 2011 Jeremie Dimino
+ * change the implementation of Lwt.wakeup_later{,_exn}
+
+Sat Jun 18 16:17:56 CEST 2011 Jeremie Dimino
+ * add Lwt.wakeup_later{,_exn} and use it in Lwt_mutex
+
+Wed Jun 15 10:31:03 CEST 2011 Stephane Glondu
+ * Fix link order in library detection test
+
+ The wrong link order was causing a build failure on Ubuntu, where the
+ linker is stricter.
+
+Fri Jun 10 19:08:01 CEST 2011 Jeremie Dimino
+ * fix some size_t problems
+
+Fri Jun 10 13:53:22 CEST 2011 Nicolas Dandrimont
+ * Use a dynamically-allocated buffer for readlink and gethostname
+
+ This allows the use of readlink and gethostname on systems without a
+ size limit on their return values (e.g. Hurd).
+
+Tue May 31 20:18:09 CEST 2011 Jeremie Dimino
+ * use Lwt_unix.fork in Lwt_process and Lwt_daemon
+
+Tue May 31 20:13:15 CEST 2011 Jeremie Dimino
+ * do not run exit hooks in the parent process when daemonizing
+
+Mon May 30 16:48:16 CEST 2011 Jeremie Dimino
+ * add Lwt_unix.fork
+
+Mon May 30 14:04:11 CEST 2011 Jeremie Dimino
+ * use oasis 0.2.1
+
+Mon May 30 14:02:49 CEST 2011 Jeremie Dimino
+ * handle EINTR in the notification system
+
+Fri May 27 09:45:37 CEST 2011 Jeremie Dimino
+ * fix compilation on hurd
+
+Tue May 17 18:24:03 CEST 2011 Jeremie Dimino
+ * flush after displaying the message in the toplevel
+
+Fri May 13 20:29:21 CEST 2011 Jeremie Dimino
+ * use a custom PRNG state for Lwt.choose and Lwt.pick
+
+Thu May 5 18:19:10 CEST 2011 raphael proust
+ * Added -lwt-sequence-strict option to syntax extension
+
+Wed May 4 10:38:57 CEST 2011 raphael proust
+ * typo in Lwt_log doc
+
+Thu May 5 16:54:51 CEST 2011 Jeremie Dimino
+ * typo in the stubs for Lwt_unix.send_msg
+
+ n_fds was not initialized correctly.
+
+Mon Apr 25 20:12:42 CEST 2011 Jeremie Dimino
+ * allow to compile without fdatasync
+
+Fri Apr 22 13:54:52 CEST 2011 Jeremie Dimino
+ * add Lwt_unix.{fsync,fdatasync}
+
+Thu Apr 21 10:39:49 CEST 2011 Jeremie Dimino
+ * ensure that all events are cleared before closing a file descriptor
+
+Wed Apr 20 08:46:54 CEST 2011 Jeremie Dimino
+ * 'make clean' in manual/ remove manual-wiki.tex
+
+Mon Apr 18 21:38:26 CEST 2011 Jeremie Dimino
+ * do not remove manual-wiki.tex from the tarball
+
+Tue Apr 12 17:03:02 CEST 2011 chambart@crans.org
+ * Add link to download the pdf manual in the doc
+
+Tue Apr 12 16:34:19 CEST 2011 chambart@crans.org
+ * lift apiref-intro headers levels
+
+Tue Apr 12 15:53:39 CEST 2011 Jeremie Dimino
+ tagged 2.3.0
+
+Tue Apr 12 15:53:23 CEST 2011 Jeremie Dimino
+ * version 2.3.0
+
+Tue Apr 12 15:43:18 CEST 2011 Jeremie Dimino
+ * typo
+
+Tue Apr 12 15:37:43 CEST 2011 Jeremie Dimino
+ * update CHANGES
+
+Sun Apr 10 18:51:47 CEST 2011 Jeremie Dimino
+ * fix ocamldoc comment
+
+Sat Apr 9 14:36:35 CEST 2011 Jeremie Dimino
+ * add match_lwt and while_lwt to the manual
+
+Sat Apr 9 13:42:29 CEST 2011 Jeremie Dimino
+ * allow to add rules for logging levels in Lwt_log
+
+Thu Apr 7 18:12:59 CEST 2011 Jeremie Dimino
+ * handle the case when eventfd is present at compilation time but not supported by the system
+
+Thu Apr 7 17:32:50 CEST 2011 Jeremie Dimino
+ * register a printer for unix errors
+
+Wed Apr 6 18:08:31 CEST 2011 Jeremie Dimino
+ * include Lwt_io.{LE/BE} into Lwt_io according to the system byte order
+
+Sun Apr 3 00:37:37 CEST 2011 Jeremie Dimino
+ * add Lwt.nchoose_split
+
+Sat Apr 2 23:16:23 CEST 2011 Jeremie Dimino
+ * cleanup events when they are no more used in Lwt_unix
+
+Sat Apr 2 18:01:55 CEST 2011 Jeremie Dimino
+ * handle "lwt ... = ... in ..." at toplevel in the syntax extension
+
+Thu Mar 31 15:34:35 CEST 2011 Jeremie Dimino
+ * try to minimize the amount of calls to epoll_ctl by caching engine events
+
+Thu Mar 31 12:10:41 CEST 2011 Jeremie Dimino
+ * make the notification system fork-proof
+
+Tue Mar 29 15:54:53 CEST 2011 Jeremie Dimino
+ * add the >= 3.12 constraint in _oasis
+
+Tue Mar 29 11:37:57 CEST 2011 Jeremie Dimino
+ * fix the syntax extension for while_lwt and match_lwt
+
+Mon Mar 28 21:37:45 CEST 2011 Jeremie Dimino
+ * allow to omit the pattern in logging rules
+
+ So we can write LWT_LOG=debug instead of LWT_LOG='* -> debug'
+
+Fri Mar 25 09:17:24 CET 2011 Jeremie Dimino
+ * build and install cmxs
+
+Tue Mar 22 16:00:57 CET 2011 Jeremie Dimino
+ * copy Unix types into Lwt_unix
+
+ This is for better detection of changes in Unix types since bindings
+ depends on their representations.
+
+Tue Mar 22 08:47:37 CET 2011 Jeremie Dimino
+ * make the "push and GC" test to work in bytecode
+
+Mon Mar 21 13:34:35 CET 2011 Jeremie Dimino
+ * typo in the external for sendto
+
+Wed Mar 16 11:44:20 CET 2011 Jeremie Dimino
+ * add reporting functions
+
+Tue Mar 15 17:14:25 CET 2011 Jeremie Dimino
+ * replace Lwt_react.{E,S}.notify* by Lwt_react.{E,S}.keep
+
+Fri Mar 11 11:18:15 CET 2011 Jeremie Dimino
+ * add match_lwt and while_lwt to the syntax extension
+
+Fri Mar 11 10:55:43 CET 2011 Jeremie Dimino
+ * update the manual about lwt.react
+
+Fri Mar 11 10:49:28 CET 2011 Jeremie Dimino
+ * add lwt.syntax and lwt.syntax.log the the API documentation
+
+Fri Mar 11 10:45:41 CET 2011 Jeremie Dimino
+ * update apiref-intro for lwt.react
+
+Thu Mar 10 17:54:52 CET 2011 Jeremie Dimino
+ * reimplement Lwt_{event,signal} on top of Lwt_react
+
+Thu Mar 10 16:21:53 CET 2011 Jeremie Dimino
+ * add module Lwt_react
+
+ - Reimplements React's Lwtised primitives in a simpler way.
+ - Changes the API of signals, now map_s and co returns a thread instead
+ of taking an initial value. The experience shows that it is more
+ suitable.
+ - Removes notify* functions and replaces them by always_notify* functions.
+ Id are useless, it is sufficient to use directly signals and events instead.
+
+Thu Mar 10 12:02:34 CET 2011 Jeremie Dimino
+ * add Lwt.on_{success,failure}
+
+Thu Mar 10 11:57:00 CET 2011 Jeremie Dimino
+ * fix local storage handling in Lwt.on_cancel
+
+Thu Mar 3 21:59:43 CET 2011 Jeremie Dimino
+ * remove "noalloc" from stubs that may raise exceptions
+
+Tue Feb 22 22:09:11 CET 2011 Jeremie Dimino
+ * fix the unix job for Lwt_bytes.{read,write} on windows
+
+Wed Feb 16 16:22:03 CET 2011 chambart@crans.org
+ * add getsockname getpeername to Lwt_ssl
+
+Fri Feb 11 14:25:30 CET 2011 chambart@crans.org
+ * Lwt_stream: avoid memory leak from create
+ in let push,stream = create ()
+ push no longer keep a reference to data in the stream
+
+
+Mon Feb 14 20:21:54 CET 2011 Jeremie Dimino
+ * remove all exit hooks when an execvp fails
+
+Mon Feb 14 11:52:31 CET 2011 Jeremie Dimino
+ * add manual build files to the boring file
+
+Mon Feb 14 11:44:16 CET 2011 Jeremie Dimino
+ * add a boring file
+
+Sun Feb 13 19:00:25 CET 2011 Jeremie Dimino
+ * put text stubs into src/text
+
+Sun Feb 13 00:35:53 CET 2011 Jeremie Dimino
+ * fix Lwt_unix.get_cpu
+
+Sun Feb 13 00:33:28 CET 2011 Jeremie Dimino
+ * allow to integrate lwt into glib instead of glib of lwt
+
+ Because glib into lwt does not works under windows
+
+Sat Feb 12 23:17:39 CET 2011 Jeremie Dimino
+ * add Lwt_sys to apiref-intro
+
+Sat Feb 12 18:07:23 CET 2011 Jeremie Dimino
+ * use optcomp
+
+Sat Feb 12 16:01:47 CET 2011 Jeremie Dimino
+ * add module Lwt_sys
+
+Fri Feb 11 23:40:09 CET 2011 Jeremie Dimino
+ * typos
+
+Fri Feb 11 22:09:33 CET 2011 Jeremie Dimino
+ * add Lwt_unix.have
+
+Fri Feb 11 14:34:31 CET 2011 Jeremie Dimino
+ * use the code plugin in the manual and add colors
+
+Fri Feb 11 09:10:28 CET 2011 Jeremie Dimino
+ * typo
+
+Fri Feb 11 09:01:59 CET 2011 Jeremie Dimino
+ * remove obsolete doc about C stubs
+
+Fri Feb 11 08:56:32 CET 2011 Jeremie Dimino
+ * use code plugins in the manual
+
+Fri Feb 11 08:19:45 CET 2011 Jeremie Dimino
+ * use rubber for creating the pdf
+
+Fri Feb 11 00:51:02 CET 2011 Jeremie Dimino
+ * convert the doc to wikicreole
+
+Thu Feb 10 21:35:41 CET 2011 Jeremie Dimino
+ * ensure that glib main loop functions are called in the right order
+
+Thu Feb 10 17:55:16 CET 2011 Jeremie Dimino
+ * lwt.glib enhancement
+
+Thu Feb 10 14:49:46 CET 2011 Jeremie Dimino
+ * add -L/-I flags also for lwt.glib
+
+Thu Feb 10 14:33:08 CET 2011 Jeremie Dimino
+ * use a pair of socket for notifications on windows
+
+Thu Feb 10 14:14:54 CET 2011 Jeremie Dimino
+ * fix windows stubs
+
+Thu Feb 10 13:54:03 CET 2011 Jeremie Dimino
+ * better fd blocking detection on windows
+
+Thu Feb 10 12:52:35 CET 2011 Jeremie Dimino
+ * implement more stubs on windows
+
+Thu Feb 10 11:54:06 CET 2011 Jeremie Dimino
+ * use a byte plugin for compilling examples
+
+ For better portability
+
+Thu Feb 10 11:50:36 CET 2011 Jeremie Dimino
+ * search for headers in a list of predefined directories
+
+ It is for better integration with Windows and MacOS
+
+Thu Feb 10 10:10:05 CET 2011 Jeremie Dimino
+ * enhancement in the notification system
+
+ - support unbounded number of simultaneous notifications
+ - send only one byte for simultaneous notifications
+
+Wed Feb 9 22:39:34 CET 2011 Jeremie Dimino
+ * use eventfd when available for notifications
+
+Tue Feb 8 17:24:52 CET 2011 Jeremie Dimino
+ * fix engines transfers
+
+Tue Feb 8 15:31:34 CET 2011 Jeremie Dimino
+ * typo
+
+Tue Feb 8 15:11:17 CET 2011 Jeremie Dimino
+ * stop all events before destroying an engine
+
+Tue Feb 8 15:05:27 CET 2011 Jeremie Dimino
+ * reimplement fd aborting
+
+Tue Feb 8 14:54:40 CET 2011 Jeremie Dimino
+ * implement engine copying
+
+Tue Feb 8 14:04:34 CET 2011 Jeremie Dimino
+ * fix the main loop
+
+ I don't really know why it fixes tests...
+
+Mon Feb 7 23:28:07 CET 2011 Jeremie Dimino
+ * refactoring + use an engine based on select for windows
+
+Mon Feb 7 15:06:30 CET 2011 Jeremie Dimino
+ * fix examples
+
+Mon Feb 7 15:04:01 CET 2011 Jeremie Dimino
+ * reimplement lwt.glib with the new engine system
+
+Sun Feb 6 23:46:24 CET 2011 Jeremie Dimino
+ * allow to replace libev by another engine
+
+Wed Jan 26 14:19:37 CET 2011 chambart@crans.org
+ tagged 2.2.1
+
+Wed Jan 26 14:17:37 CET 2011 chambart@crans.org
+ * update changelog and version number
+
+Mon Jan 24 21:55:14 CET 2011 Jeremie Dimino
+ * better way of copying/emptying the list of threads paused/yielded
+
+Mon Jan 24 16:29:08 CET 2011 Jeremie Dimino
+ * add a counter for paused threads and do not call wakeup_paused recursively
+
+Fri Jan 14 17:44:48 CET 2011 chambart@crans.org
+ * add a hook for Lwt.pause
+
+Fri Jan 14 17:33:36 CET 2011 chambart@crans.org
+ * circumvent an js_of_ocaml bug
+
+Tue Jan 4 14:19:50 CET 2011 Jeremie Dimino
+ * remove tests using finalisers
+
+ Tests may fail because it is not ensured that finalisers will be
+ called.
+
+Fri Dec 17 16:58:14 CET 2010 Jeremie Dimino
+ * check for C libraries at configure time
+
+Thu Dec 16 17:46:19 CET 2010 Jeremie Dimino
+ * add libev to the README
+
+Mon Dec 13 15:37:20 CET 2010 Jeremie Dimino
+ tagged 2.2.0
+
+Mon Dec 13 15:37:05 CET 2010 Jeremie Dimino
+ * version 2.2.0
+
+Mon Dec 13 15:36:03 CET 2010 Jeremie Dimino
+ * add Lwt_bytes to apiref-intro
+
+Mon Dec 13 14:36:56 CET 2010 Jeremie Dimino
+ * update CHANGES
+
+Mon Dec 13 14:15:22 CET 2010 Jeremie Dimino
+ tagged 2.2
+
+Mon Dec 13 14:15:02 CET 2010 Jeremie Dimino
+ * version 2.2
+
+Sun Dec 12 18:49:31 CET 2010 balat at univ-paris-diderot.fr
+ * Adding wiki documentation
+
+Thu Dec 9 15:35:42 CET 2010 Jeremie Dimino
+ * install lwt_unix.h
+
+Wed Dec 8 17:25:21 CET 2010 Jeremie Dimino
+ * add Lwt.waiter_of_wakener
+
+Sat Dec 4 18:06:03 CET 2010 Jeremie Dimino
+ * remove Lwt.block and Lwt.no_cancel
+
+Sat Dec 4 11:58:40 CET 2010 Jeremie Dimino
+ * update CHANGES
+
+Sat Dec 4 11:38:25 CET 2010 Jeremie Dimino
+ * update the manual
+
+Sat Dec 4 10:42:14 CET 2010 Jeremie Dimino
+ * add Lwt.block and Lwt.no_cancel
+
+Thu Dec 2 17:44:26 CET 2010 Jeremie Dimino
+ * add Lwt_ssl.embed_socket
+
+Wed Dec 1 18:19:28 CET 2010 Jeremie Dimino
+ * fix a fd leak in Lwt_io.open_connection
+
+Sun Nov 28 18:24:47 CET 2010 Jeremie Dimino
+ * do not call pkg-config if not building lwt.glib
+
+Sat Nov 27 01:36:36 CET 2010 Jeremie Dimino
+ * update tests for local storage
+
+Fri Nov 26 21:24:31 CET 2010 Jeremie Dimino
+ * change the implementation of local storage
+
+Fri Nov 26 11:15:46 CET 2010 Jeremie Dimino
+ * discover available features at compile time
+
+Fri Nov 26 03:10:09 CET 2010 Jeremie Dimino
+ * fix compilation on opensolaris
+
+Thu Nov 25 17:11:20 CET 2010 Jeremie Dimino
+ * add more functions to Lwt_bytes
+
+Thu Nov 25 16:45:26 CET 2010 Jeremie Dimino
+ * do not wait if not needed in Lwt_bytes.wait_mincore
+
+Thu Nov 25 11:32:44 CET 2010 Jeremie Dimino
+ * put mmap stuff into Lwt_bytes
+
+Wed Nov 24 23:44:10 CET 2010 Jeremie Dimino
+ * add Lwt_bytes.{recvfrom,sendto}
+
+Wed Nov 24 20:52:13 CET 2010 Jeremie Dimino
+ * add Lwt_bytes.{recv,send}_msg
+
+Wed Nov 24 17:14:49 CET 2010 Jeremie Dimino
+ * replace strings by bigarrays in Lwt_io
+
+Tue Nov 23 21:24:24 CET 2010 Jeremie Dimino
+ * add Lwt_bytes to do IOs on bigarrays
+
+Wed Nov 24 07:52:06 CET 2010 Jeremie Dimino
+ * handle errors in lwt_unix_write_result
+
+Tue Nov 23 23:46:07 CET 2010 Jeremie Dimino
+ * fix compilation on FreeBSD
+
+Tue Nov 23 20:06:06 CET 2010 Jeremie Dimino
+ * do not create the notification if not needed in Lwt_unix.execute_job
+
+Tue Nov 23 16:11:06 CET 2010 Jeremie Dimino
+ * use a custom hashtbl for storing notifiers
+
+Tue Nov 23 15:32:44 CET 2010 Jeremie Dimino
+ * fix the stubs for stat
+
+Tue Nov 23 15:29:25 CET 2010 Jeremie Dimino
+ * fix compilation on windows
+
+Tue Nov 23 03:22:05 CET 2010 Jeremie Dimino
+ * use realtime signals instead of SIGUSR1
+
+Tue Nov 23 02:38:45 CET 2010 Jeremie Dimino
+ * add functions to get/set the affinity
+
+Tue Nov 23 02:05:29 CET 2010 Jeremie Dimino
+ * do not include (not used)
+
+Mon Nov 22 23:30:36 CET 2010 Jeremie Dimino
+ * fix a memory leak in Lwt_unix.set_notification
+
+ Use Hashtbl.replace instead of Hashtbl.add
+
+Mon Nov 22 23:22:30 CET 2010 Jeremie Dimino
+ * remove global roots when the watcher is stopped in libev stubs
+
+Mon Nov 22 22:42:18 CET 2010 Jeremie Dimino
+ * fix a typo in lwt_unix_send_notification_stub
+
+Mon Nov 22 21:08:00 CET 2010 Jeremie Dimino
+ * do not wait if not needed in Lwt_unix.execute_job
+
+Mon Nov 22 14:39:04 CET 2010 Jeremie Dimino
+ * delete the mutex associated to a job when it terminates
+
+Sun Nov 21 19:27:11 CET 2010 Jeremie Dimino
+ * fix cancellation of blocking calls
+
+Sun Nov 21 18:18:37 CET 2010 Jeremie Dimino
+ * add functions to control the pool of threads
+
+Sun Nov 21 16:37:23 CET 2010 Jeremie Dimino
+ * add Lwt_unix.readdir_n and Lwt_unix.files_of_directory
+
+Sun Nov 21 13:54:25 CET 2010 Jeremie Dimino
+ * use a hash table for storing notifications
+
+Sun Nov 21 12:26:49 CET 2010 Jeremie Dimino
+ * fix examples
+
+Sun Nov 21 11:58:05 CET 2010 Jeremie Dimino
+ * fix a bug in stubs for the switch async method
+
+Sat Nov 20 17:29:20 CET 2010 Jeremie Dimino
+ * set the [set_flags] field in [Lwt_unix.set_blocking]
+
+Sat Nov 20 13:37:13 CET 2010 Jeremie Dimino
+ * guess the blocking mode when not specified
+
+Fri Nov 19 22:54:36 CET 2010 Jeremie Dimino
+ * implement the switch async method
+
+Thu Nov 18 21:54:06 CET 2010 Jeremie Dimino
+ * add mmap oasis files
+
+Thu Nov 18 16:46:11 CET 2010 Jeremie Dimino
+ * create the sub-library lwt.mmap
+
+Thu Nov 18 10:51:38 CET 2010 Jeremie Dimino
+ * handle exceptions raised during the execution of libev_loop
+
+ In particular handle SIGINT in the toplevel.
+
+Thu Nov 18 10:25:03 CET 2010 Jeremie Dimino
+ * reimplement Lwt_unix.abort with libev
+
+Thu Nov 18 04:09:12 CET 2010 Jeremie Dimino
+ * implement lwtized unix functions
+
+Wed Nov 17 21:04:54 CET 2010 Jeremie Dimino
+ * add prototype of all lwtised unix functions
+
+Wed Nov 17 17:54:11 CET 2010 Jeremie Dimino
+ * expose Lwt_unix.{readable,writable}
+
+Wed Nov 17 17:36:31 CET 2010 Jeremie Dimino
+ * add Lwt_io.is_busy
+
+Wed Nov 17 16:38:31 CET 2010 Jeremie Dimino
+ * add constants for the switch async method
+
+Wed Nov 17 15:45:49 CET 2010 Jeremie Dimino
+ * execute synchronous job in a blocking section
+
+Wed Nov 17 13:19:30 CET 2010 Jeremie Dimino
+ * add Lwt.with_value
+
+Wed Nov 17 08:35:13 CET 2010 Jeremie Dimino
+ * implement async version of Lwt_unix.close
+
+Wed Nov 17 01:15:25 CET 2010 Jeremie Dimino
+ * fix lwt_unix_send_notification
+
+Wed Nov 17 00:11:10 CET 2010 Jeremie Dimino
+ * add a mechanisms for running blocking system calls in parallels
+
+Wed Nov 10 15:37:17 CET 2010 Jeremie Dimino
+ * put Lwt_mmap into public modules
+
+Mon Nov 8 17:25:26 CET 2010 Jeremie Dimino
+ * put code examples into boxes in the manual
+
+Sun Nov 7 21:51:53 CET 2010 Jeremie Dimino
+ * make glib stubs to work on windows
+
+Fri Nov 5 18:11:45 CET 2010 Jeremie Dimino
+ * add a macro to acquire the runtime system lock from libev callbacks
+
+Tue Nov 2 23:12:07 CET 2010 Jeremie Dimino
+ * add doc for threads local storage
+
+Tue Nov 2 22:38:39 CET 2010 chambart@crans.org
+ * tests for Lwt_mmap
+
+Tue Nov 2 22:35:07 CET 2010 chambart@crans.org
+ * Lwt_mmap bugfixes
+
+Tue Nov 2 16:20:33 CET 2010 Jeremie Dimino
+ * add files generated by 'oasis setup'
+
+ So users can compile the development version without installing oasis.
+
+Mon Nov 1 17:58:35 CET 2010 Jeremie Dimino
+ * fix a bug in read_notification
+
+Mon Nov 1 17:30:46 CET 2010 Jeremie Dimino
+ * fix a bug in send_notification
+
+Fri Oct 29 21:51:48 CEST 2010 Jeremie Dimino
+ * fix several wrong recursive calls in Lwt_list
+
+Fri Oct 29 18:36:13 CEST 2010 Jeremie Dimino
+ * use Lwt.task instead of Lwt.wait in Lwt_condition and Lwt_pool
+
+Fri Oct 29 17:50:50 CEST 2010 Jeremie Dimino
+ * better completion on modules contents
+
+ Now completion works with modules defined in the toplevel.
+
+Thu Oct 28 12:37:42 CEST 2010 Jeremie Dimino
+ * handle Lwt_unix.yield without libev
+
+Wed Oct 27 22:55:49 CEST 2010 Jeremie Dimino
+ * fix the name of the stubs for glib in _tags
+
+Tue Oct 26 10:28:00 CEST 2010 Jeremie Dimino
+ * remove child watchers from libev stubs (not used)
+
+Tue Oct 26 01:28:50 CEST 2010 Jeremie Dimino
+ * fix compilation on windows
+
+Tue Oct 26 01:07:29 CEST 2010 Jeremie Dimino
+ * add support for windows threads
+
+Tue Oct 26 00:41:48 CEST 2010 Jeremie Dimino
+ * use libev instead of select
+
+Sat Oct 23 01:57:44 CEST 2010 Jeremie Dimino
+ * add oasis files to the repository
+
+Sat Oct 23 01:19:23 CEST 2010 Jeremie Dimino
+ * fix a typo in predist
+
+Sat Oct 23 01:00:47 CEST 2010 Jeremie Dimino
+ * update oasis stuff to oasis 0.2
+
+Mon Oct 18 17:34:51 CEST 2010 Jeremie Dimino
+ * update the manual
+
+Tue Oct 12 18:35:28 CEST 2010 Jeremie Dimino
+ * add the inputenc package for the manual
+
+Fri Oct 8 17:31:53 CEST 2010 Jeremie Dimino
+ * add a "milliseconds" variable to Lwt_log
+
+Tue Oct 5 00:38:05 CEST 2010 Jeremie Dimino
+ * rename Makefile to make-dist.sh
+
+Tue Oct 5 00:29:12 CEST 2010 Jeremie Dimino
+ * remove colors in the manual
+
+Fri Sep 24 11:57:08 CEST 2010 Jeremie Dimino
+ * add Lwt_term.render_update
+
+Fri Sep 10 15:27:41 CEST 2010 Jeremie Dimino
+ * update the manual
+
+Fri Sep 10 10:37:22 CEST 2010 Stephane Glondu
+ * lwt_read_line: more usual behaviour for ^D
+
+Sun Jun 13 11:30:34 CEST 2010 Stephane Glondu
+ * Fix wiki syntax typo in CHANGES
+
+Wed Sep 8 07:41:49 CEST 2010 Jeremie Dimino
+ * Convert the manual to melt
+
+Sun Sep 5 22:17:19 CEST 2010 Jeremie Dimino
+ * add tests to _oasis
+
+Sun Sep 5 20:15:10 CEST 2010 Jeremie Dimino
+ * switch to OASIS
+
+Sun Sep 5 16:59:36 CEST 2010 Jeremie Dimino
+ * add an _oasis file (not yet usable)
+
+Sun Sep 5 10:29:35 CEST 2010 Jeremie Dimino
+ * add Lwt_switch to apiref-intro
+
+Sat Sep 4 11:46:34 CEST 2010 Jeremie Dimino
+ * add lwt_unix.h
+
+Sat Sep 4 11:46:12 CEST 2010 Jeremie Dimino
+ * use raise_lwt instead of fail
+
+Sat Sep 4 11:16:22 CEST 2010 Jeremie Dimino
+ * add backtrace support
+
+Wed Sep 1 15:24:50 CEST 2010 Jeremie Dimino
+ * factorize pipes internally used by lwt into a single one
+
+Tue Aug 31 15:59:25 CEST 2010 Jeremie Dimino
+ * merge optimisations for Lwt.pick and Lwt.choose
+
+Tue Aug 31 11:56:26 CEST 2010 chambart@crans.org
+ * Lwt_mmap reuse already mmaped file
+
+Tue Aug 31 10:49:04 CEST 2010 chambart@crans.org
+ * make Lwt_mmap sleeps sometimes to launch fewer threads
+
+Mon Aug 30 18:00:04 CEST 2010 chambart@crans.org
+ * allow Lwt_mmap functions to read more than one page per syscall
+
+Mon Aug 30 14:50:30 CEST 2010 chambart@crans.org
+ * optimisation of Lwt.pick
+
+ Usualy there is only one thread ready to pick.
+ In this case we don't call Random.int since it is quite expensive,
+ even with 1 as parameter.
+
+
+Tue Aug 31 13:13:29 CEST 2010 Jeremie Dimino
+ * fix local storage bugs + add tests
+
+Mon Aug 30 11:47:35 CEST 2010 Jeremie Dimino
+ * typo
+
+ Pattern not recognized by ocaml 3.11
+
+Sun Aug 29 11:34:39 CEST 2010 Jeremie Dimino
+ * add LWt_switch.add_hook_or_exec
+
+Sun Aug 29 10:55:58 CEST 2010 Jeremie Dimino
+ * modify Lwt_switch.add_hook and add Lwt_switch.check
+
+Fri Aug 27 14:28:02 CEST 2010 chambart@crans.org
+ * use Lwt_mmap when possible in Lwt_io
+
+Thu Aug 26 18:02:00 CEST 2010 chambart@crans.org
+ * really non blocking disk input using mmap/mincore
+
+Thu Aug 26 10:08:24 CEST 2010 Jeremie Dimino
+ * add module Lwt_switch
+
+Wed Aug 25 13:26:33 CEST 2010 Jeremie Dimino
+ * fixes to really make it works with ocaml 3.11
+
+Wed Aug 25 12:48:45 CEST 2010 Jeremie Dimino
+ * no ocaml 3.12 features for now
+
+Tue Aug 24 22:34:39 CEST 2010 Jeremie Dimino
+ * make Lwt.join to wait for all threads to terminate, even if one fails
+
+Tue Aug 24 22:12:12 CEST 2010 Jeremie Dimino
+ * add thread local storage
+
+Mon Jul 5 09:15:20 CEST 2010 Jeremie Dimino