Example #1
0
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);
}
Example #2
0
CAMLprim value iocp_ml_socket(value unit)
{
  CAMLparam1(unit);
  CAMLlocal1(res);
  res = win_alloc_socket(async_socket());
  CAMLreturn(res);
}
Example #3
0
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);
}
Example #4
0
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; */
}
Example #5
0
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));
}
Example #6
0
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);
}
Example #7
0
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);
}