I have one connected socket and two threads.
1. thread should wait for data, do recv and process the result as soon
as any data is available
2. thread should write to the socket indeoendently
Unfortunateky it turned out that send & recv behave as if they are
protected with one mutex per one socket (I've checked it with
Unix.send/recv and ThreadUnix.send/recv - no difference). It happens
like this:
thread 1: send "blah" (OK)
thread 2: recv (returned "bloh" - sill OK)
thread 2: recv (waiting for more data - OK)
thread 1: send "blah" (waits for release of the socket - this is bad
for me)
Normally I would use two semaphores and a function waiting for multiple
objects:
let betterRecv sync1 sync2 sock buf offs =
(
while
desiredFunctionWaitFor [sync1,sock] = TheFirstObjectWasSignaled
do mySemaphore.wait sync2 done;
recv sock buf offs []
);;
let betterSend sync1 sync2 sock buf offs =
(
mySemaphore.Signal sync1;
let result = send sock buf offs [] in
(mySemaphore.Signal sync2;
result
)
);
The problem is: I need to do it in a portable way.
Windows implementation of Unix.select doesn't allow waiting on any
primitives other than socket descriptors. Unix unit seems not to have
any "multipleWait" function that would be more general.
I tried such a nasty workaround:
(* we have no Unix.socketpair on Windows *)
let socketpair_workaround a b c =
let sock1 = socket PF_INET SOCK_STREAM 0 in
let addr1 = ADDR_INET (inet_addr_of_string "127.0.0.1",56291) in
let sock2 = socket PF_INET SOCK_STREAM 0 in
(* let addr2 = ADDR_INET (inet_addr_of_string "127.0.0.1",56292) in*)
bind sock1 addr1;
(* bind sock2 addr2;*)
listen sock1 1;
connect sock2 addr1;
sock1, sock2
;;
let goodSend sync = send sync "d" 0 1 []; send;;
let goodRecv sync sock =
(
print_endline "->; select";
while
let readyS = (Unix.select [sock; sync] [] [] (-1.)) in
match readyS with
| [sync],_,_ -> print_endline "sync!" ; recv sync "?" 0 1 []; true
| _,_,_ -> false
do () done;
let result = recv sock in
let _ = print_endline "received" in
result
);;
which I tried to use like this:
let (syncOut,syncIn) = socketpair_workaround ...
... goodSend syncOut... and in another thread: ... goodRecv syncIn...
But I haven't managed to make it work really (tested it on Windows).
My last stopgap mock-up was:
let goodRecv sock =
(
while
let readyS = (Unix.select [sock] [] [] (0.1)) in
match readyS with
| [],_,_ -> Thread.delay 0.1; true
| _,_,_ -> false
do () done;
recv sock
);;
It is the only working version I have. But it is like an active waiting.
How should I do this in a proper way?
Thank you in advance for any help.
Dawid Toton
.
