syndicate-lang
/
hop-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Flush process not required with Lwt

This commit is contained in:
Tony Garnock-Jones 2012-05-05 21:23:07 -04:00
parent ca8ce5d180
commit 23c5ea314e
1 changed files with 0 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
connections.ml
View File

@ -27,26 +27,10 @@ let endpoint_name n =
| ADDR_INET (host, port) -> sprintf "%s:%d" (string_of_inet_addr host) port
| _ -> "??unknown??"
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 =
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 () =
@ -61,7 +45,6 @@ let connection_main class_name peername cin cout issue_banner boot_fn node_fn ma
| 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") []