CAMLprim value lwt_unix_socketpair_stub(value domain, value type,
value protocol) {
CAMLparam3(domain, type, protocol);
CAMLlocal1(result);
SOCKET sockets[2];
lwt_unix_socketpair(socket_domain_table[Int_val(domain)],
socket_type_table[Int_val(type)], Int_val(protocol),
sockets);
result = caml_alloc_tuple(2);
Store_field(result, 0, win_alloc_socket(sockets[0]));
Store_field(result, 1, win_alloc_socket(sockets[1]));
CAMLreturn(result);
}
CAMLprim value iocp_ml_socket(value unit)
{
CAMLparam1(unit);
CAMLlocal1(res);
res = win_alloc_socket(async_socket());
CAMLreturn(res);
}
value lwt_unix_init_notification()
{
SOCKET sockets[2];
switch (notification_mode) {
case NOTIFICATION_MODE_NOT_INITIALIZED:
notification_mode = NOTIFICATION_MODE_NONE;
init_notifications();
break;
case NOTIFICATION_MODE_WINDOWS:
notification_mode = NOTIFICATION_MODE_NONE;
closesocket(socket_r);
closesocket(socket_w);
break;
case NOTIFICATION_MODE_NONE:
break;
default:
caml_failwith("notification system in unknown state");
}
/* Since pipes do not works with select, we need to use a pair of
sockets. */
lwt_unix_socketpair(AF_INET, SOCK_STREAM, IPPROTO_TCP, sockets);
socket_r = set_close_on_exec(sockets[0]);
socket_w = set_close_on_exec(sockets[1]);
notification_mode = NOTIFICATION_MODE_WINDOWS;
notification_send = windows_notification_send;
notification_recv = windows_notification_recv;
return win_alloc_socket(socket_r);
}
CAMLprim value iocp_ml_get_socket(value _)
{
CAMLparam1(_);
CAMLlocal1(ret);
if (g_last_context == NULL) printf("context is null\n");
if (g_last_context->kind != Listen)
printf("Bad context, expect Listen, got %d\n", g_last_context->kind);
ret = win_alloc_socket(g_last_context->sock);
free(g_last_context);
g_last_context = NULL;
CAMLreturn(ret);
/* return ret; */
}
CAMLprim value win_socket (value domain, value type, value proto) {
CAMLparam3(domain, type, proto);
SOCKET s;
s = WSASocket(socket_domain_table[Int_val(domain)],
socket_type_table[Int_val(type)],
Int_val(proto),
NULL, 0, WSA_FLAG_OVERLAPPED);
D(printf("Created socket %lx\n", (long)s));
if (s == INVALID_SOCKET) {
win32_maperr(WSAGetLastError ());
uerror("WSASocket", Nothing);
}
CAMLreturn(win_alloc_socket(s));
}
CAMLprim value win_filedescr_of_channel(value vchan)
{
CAMLparam1(vchan);
CAMLlocal1(fd);
struct channel * chan;
HANDLE h;
chan = Channel(vchan);
if (chan->fd == -1) uerror("descr_of_channel", Nothing);
h = (HANDLE) _get_osfhandle(chan->fd);
if (chan->flags & CHANNEL_FLAG_FROM_SOCKET)
fd = win_alloc_socket((SOCKET) h);
else
fd = win_alloc_handle(h);
CRT_fd_val(fd) = chan->fd;
CAMLreturn(fd);
}
CAMLprim value getsockopt_stub(value sock, value sockopt) {
CAMLparam2 (sock, sockopt);
CAMLlocal1 (result);
int error = -1;
int native_sockopt = Int_val(sockopt);
struct wrap *socket = Socket_val(sock);
switch (native_sockopt) {
case ZMQ_SNDHWM:
case ZMQ_RCVHWM:
case ZMQ_RATE:
case ZMQ_RECOVERY_IVL:
case ZMQ_SNDBUF:
case ZMQ_RCVBUF:
case ZMQ_LINGER:
case ZMQ_RECONNECT_IVL:
case ZMQ_RECONNECT_IVL_MAX:
case ZMQ_BACKLOG:
case ZMQ_MULTICAST_HOPS:
case ZMQ_RCVTIMEO:
case ZMQ_SNDTIMEO:
case ZMQ_RCVMORE:
case ZMQ_RCVLABEL:
case ZMQ_TYPE:
{
int res;
size_t size = sizeof(res);
error = zmq_getsockopt(socket->wrapped, native_sockopt, &res, &size);
stub_raise_if (error == -1);
result = Val_int(res);
}
break;
case ZMQ_AFFINITY:
case ZMQ_MAXMSGSIZE:
{
int64 res;
size_t size = sizeof(res);
error = zmq_getsockopt(socket->wrapped, native_sockopt, &res, &size);
stub_raise_if (error == -1);
result = caml_copy_int64(res);
}
break;
case ZMQ_EVENTS:
{
int res;
size_t size = sizeof(res);
error = zmq_getsockopt(socket->wrapped, native_sockopt, &res, &size);
stub_raise_if (error == -1);
result = POOL_LIST_CACHE[res];
}
break;
case ZMQ_IDENTITY:
{
char buffer[256];
buffer[255] = '\0';
size_t size = sizeof(buffer);
error = zmq_getsockopt(socket->wrapped, native_sockopt, buffer, &size);
stub_raise_if (error == -1);
if (size == 0) {
result = EMPTY_STRING;
} else {
result = caml_copy_string(buffer);
}
}
break;
case ZMQ_FD:
{
#if defined(_WIN32) || defined(_WIN64)
SOCKET fd;
#else
int fd;
#endif
size_t size = sizeof (fd);
error = zmq_getsockopt (socket->wrapped, native_sockopt, (void *) (&fd), &size);
stub_raise_if (error == -1);
#if defined(_WIN32) || defined(_WIN64)
result = win_alloc_socket(fd);
#else
result = Val_int(fd);
#endif
}
break;
default:
caml_failwith("Bidings error");
}
CAMLreturn (result);
}