Beispiel #1
0
CAMLprim value win_check_connection (value socket, value kind, value idx) {
  CAMLparam3 (socket, kind, idx);
  WSANETWORKEVENTS evs;
  int res, err, i = Long_val(idx);

  D(printf("Check connection... %d\n", i));
  if (WSAEnumNetworkEvents(Socket_val(socket), NULL, &evs)) {
    win32_maperr(WSAGetLastError ());
    uerror("WSAEnumNetworkEvents", Nothing);
  }
  if (WSAEventSelect(Socket_val(socket), NULL, 0) == SOCKET_ERROR) {
    win32_maperr(WSAGetLastError ());
    uerror("WSAEventSelect", Nothing);
  }
  if (!CloseHandle(events[i])) {
    win32_maperr(GetLastError ());
    uerror("CloseHandle", Nothing);
  }
  err =
    evs.iErrorCode[(Long_val(kind) == 0) ? FD_CONNECT_BIT : FD_ACCEPT_BIT];
  D(printf("Check connection: %ld, err %d\n", evs.lNetworkEvents, err));
  if (err != 0) {
    win32_maperr(err);
    uerror("check_connection", Nothing);
  }
  CAMLreturn (Val_unit);
}
Beispiel #2
0
CAMLprim value unix_read(value fd, value buf, value ofs, value vlen)
{
  intnat len;
  DWORD numbytes, numread;
  char iobuf[UNIX_BUFFER_SIZE];
  DWORD err = 0;

  Begin_root (buf);
    len = Long_val(vlen);
    numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len;
    if (Descr_kind_val(fd) == KIND_SOCKET) {
      int ret;
      SOCKET s = Socket_val(fd);
      enter_blocking_section();
      ret = recv(s, iobuf, numbytes, 0);
      if (ret == SOCKET_ERROR) err = WSAGetLastError();
      leave_blocking_section();
      numread = ret;
    } else {
      HANDLE h = Handle_val(fd);
      enter_blocking_section();
      if (! ReadFile(h, iobuf, numbytes, &numread, NULL))
        err = GetLastError();
      leave_blocking_section();
    }
    if (err) {
      win32_maperr(err);
      uerror("read", Nothing);
    }
    memmove (&Byte(buf, Long_val(ofs)), iobuf, numread);
  End_roots();
  return Val_int(numread);
}
Beispiel #3
0
CAMLprim value unix_recv(value sock, value buff, value ofs, value len,
                         value flags)
{
  SOCKET s = Socket_val(sock);
  int flg = convert_flag_list(flags, msg_flag_table);
  int ret;
  intnat numbytes;
  char iobuf[UNIX_BUFFER_SIZE];
  DWORD err = 0;

  Begin_root (buff);
    numbytes = Long_val(len);
    if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
    enter_blocking_section();
    ret = recv(s, iobuf, (int) numbytes, flg);
    if (ret == -1) err = WSAGetLastError();
    leave_blocking_section();
    if (ret == -1) {
      win32_maperr(err);
      uerror("recv", Nothing);
    }
    memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
  End_roots();
  return Val_int(ret);
}
Beispiel #4
0
CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len, value flags)
{
    SOCKET s = Socket_val(sock);
    int flg = convert_flag_list(flags, msg_flag_table);
    int ret;
    intnat numbytes;
    char iobuf[UNIX_BUFFER_SIZE];
    value res;
    value adr = Val_unit;
    union sock_addr_union addr;
    socklen_param_type addr_len;
    DWORD err = 0;

    Begin_roots2 (buff, adr);
    numbytes = Long_val(len);
    if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
    addr_len = sizeof(sock_addr);
    enter_blocking_section();
    ret = recvfrom(s, iobuf, (int) numbytes, flg, &addr.s_gen, &addr_len);
    if (ret == -1) err = WSAGetLastError();
    leave_blocking_section();
    if (ret == -1) {
        win32_maperr(err);
        uerror("recvfrom", Nothing);
    }
    memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
    adr = alloc_sockaddr(&addr, addr_len, -1);
    res = alloc_small(2, 0);
    Field(res, 0) = Val_int(ret);
    Field(res, 1) = adr;
    End_roots();
    return res;
}
Beispiel #5
0
CAMLprim value ocaml_ssl_embed_socket(value socket_, value context)
{
  CAMLparam1(context);
  CAMLlocal1(block);
#ifdef Socket_val
  SOCKET socket = Socket_val(socket_);
#else
  int socket = Int_val(socket_);
#endif
  SSL_CTX *ctx = Ctx_val(context);
  SSL *ssl;

  block = caml_alloc_custom(&socket_ops, sizeof(SSL*), 0, 1);

  if (socket < 0)
    caml_raise_constant(*caml_named_value("ssl_exn_invalid_socket"));
  caml_enter_blocking_section();
  ssl = SSL_new(ctx);
  if (!ssl)
  {
    caml_leave_blocking_section();
    caml_raise_constant(*caml_named_value("ssl_exn_handler_error"));
  }
  SSL_set_fd(ssl, socket);
  caml_leave_blocking_section();
  SSL_val(block) = ssl;

  CAMLreturn(block);
}
Beispiel #6
0
CAMLprim value recv_stub(value socket, value rcv_option) {
    CAMLparam2 (socket, rcv_option);
    CAMLlocal1 (message);

    void *sock = Socket_val(socket)->wrapped;

    zmq_msg_t request;
    int result = zmq_msg_init (&request);
    stub_raise_if (result == -1);

    caml_release_runtime_system();
    result = zmq_recvmsg(sock, &request, Int_val(rcv_option));
    caml_acquire_runtime_system();

    stub_raise_if (result == -1);

    size_t size = zmq_msg_size (&request);
    if (size == 0) {
        message = EMPTY_STRING;
    } else {
        message = caml_alloc_string(size);
        memcpy (String_val(message), zmq_msg_data (&request), size);
    }
    result = zmq_msg_close(&request);
    stub_raise_if (result == -1);
    CAMLreturn (message);
}
Beispiel #7
0
value unix_sendto_native(value sock, value buff, value ofs, value len, value flags, value dest)
{
    SOCKET s = Socket_val(sock);
    int flg = convert_flag_list(flags, msg_flag_table);
    int ret;
    intnat numbytes;
    char iobuf[UNIX_BUFFER_SIZE];
    union sock_addr_union addr;
    socklen_param_type addr_len;
    DWORD err = 0;

    get_sockaddr(dest, &addr, &addr_len);
    numbytes = Long_val(len);
    if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
    memmove (iobuf, &Byte(buff, Long_val(ofs)), numbytes);
    enter_blocking_section();
    ret = sendto(s, iobuf, (int) numbytes, flg, &addr.s_gen, addr_len);
    if (ret == -1) err = WSAGetLastError();
    leave_blocking_section();
    if (ret == -1) {
        win32_maperr(err);
        uerror("sendto", Nothing);
    }
    return Val_int(ret);
}
Beispiel #8
0
CAMLprim value lwt_unix_read(value fd, value buf, value vofs, value vlen)
{
  intnat ofs, len, written;
  DWORD numbytes, numwritten;
  DWORD err = 0;

  Begin_root (buf);
    ofs = Long_val(vofs);
    len = Long_val(vlen);
    written = 0;
    if (len > 0) {
      numbytes = len;
      if (Descr_kind_val(fd) == KIND_SOCKET) {
        int ret;
        SOCKET s = Socket_val(fd);
        ret = recv(s, &Byte(buf, ofs), numbytes, 0);
        if (ret == SOCKET_ERROR) err = WSAGetLastError();
        numwritten = ret;
      } else {
        HANDLE h = Handle_val(fd);
        if (! ReadFile(h, &Byte(buf, ofs), numbytes, &numwritten, NULL))
          err = GetLastError();
      }
      if (err) {
        win32_maperr(err);
        uerror("write", Nothing);
      }
      written = numwritten;
    }
  End_roots();
  return Val_long(written);
}
Beispiel #9
0
CAMLprim value
stub_ba_send(value fd, value val_buf, value val_ofs, value val_len)
{
  CAMLparam4(fd, val_buf, val_ofs, val_len);
  int ret = 0;
#ifdef WIN32
  char *data = (char*)Caml_ba_data_val(val_buf) + Long_val(val_ofs);
  size_t c_len = Int_val(val_len);
  SOCKET s = Socket_val(fd);
  DWORD err = 0;

  caml_release_runtime_system();
  ret = send(s, data, c_len, 0);
  if (ret == SOCKET_ERROR) err = WSAGetLastError();
  caml_acquire_runtime_system();

  if (err) {
    win32_maperr(err);
    uerror("read", Nothing);
  }
#else
  caml_failwith("AF_HYPERV only available on Windows");
#endif
  CAMLreturn(Val_int(ret));
}
Beispiel #10
0
value ml_setsock_iptos_throughput(value sock_v)
{
  int sock = Socket_val(sock_v);
  int tos = IPTOS_THROUGHPUT /* IPTOS_MINCOST obsoleted by ECN */;
  return Val_int(setsockopt(sock,
      IPPROTO_IP, IP_TOS,
      &tos, sizeof(tos)));
}
Beispiel #11
0
value skt_close(value sock_v, value addr_v){
    int ret;
    
    ret = closesocket(Socket_val(sock_v));
    if (ret == -1) serror("socketclose");
    SKTTRACE(("skt_close\n"));
    return Val_unit;
}
value win_alloc_socket(SOCKET s)
{
  value res = alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1);
  Socket_val(res) = s;
  Descr_kind_val(res) = KIND_SOCKET;
  CRT_fd_val(res) = NO_CRT_FD;
  return res;
}
Beispiel #13
0
value iocp_ml_accept(value ListenSocket)
{
  CAMLparam1(ListenSocket);
  CAMLlocal1(res);
  SOCKET so = Socket_val(ListenSocket);
  res = Val_int(async_accept(so));
  CAMLreturn(res);
}
Beispiel #14
0
value ml_get_fd_num(value fd)
{
#if defined(__MINGW32__)
  return Int_val(Socket_val(fd));
#else
  return fd;
#endif
}
Beispiel #15
0
CAMLexport value
unix_getsockopt_aux(char * name,
                    enum option_type ty, int level, int option,
                    value socket)
{
  union option_value optval;
  socklen_param_type optsize;


  switch (ty) {
  case TYPE_BOOL:
  case TYPE_INT:
  case TYPE_UNIX_ERROR:
    optsize = sizeof(optval.i); break;
  case TYPE_LINGER:
    optsize = sizeof(optval.lg); break;
  case TYPE_TIMEVAL:
    optsize = sizeof(optval.tv); break;
  default:
    unix_error(EINVAL, name, Nothing);
  }

  if (getsockopt(Socket_val(socket), level, option,
                 (void *) &optval, &optsize) == -1)
    uerror(name, Nothing);

  switch (ty) {
  case TYPE_BOOL:
  case TYPE_INT:
    return Val_int(optval.i);
  case TYPE_LINGER:
    if (optval.lg.l_onoff == 0) {
      return Val_int(0);        /* None */
    } else {
      value res = alloc_small(1, 0); /* Some */
      Field(res, 0) = Val_int(optval.lg.l_linger);
      return res;
    }
  case TYPE_TIMEVAL:
    return copy_double((double) optval.tv.tv_sec
                       + (double) optval.tv.tv_usec / 1e6);
  case TYPE_UNIX_ERROR:
    if (optval.i == 0) {
      return Val_int(0);        /* None */
    } else {
      value err, res;
      err = unix_error_of_code(optval.i);
      Begin_root(err);
        res = alloc_small(1, 0); /* Some */
        Field(res, 0) = err;
      End_roots();
      return res;
    }
  default:
    unix_error(EINVAL, name, Nothing);
    return Val_unit; /* Avoid warning */
  }
}
Beispiel #16
0
value skt_listen(value sock_v, value backlog_v){
    int ret;
    
    SKTTRACE(("skt_listen(\n"));
    ret = listen(Socket_val(sock_v), Int_val(backlog_v));
    SKTTRACE2(("skt_listen)\n"));
    if (ret == -1) serror("listen");
    return Val_unit;
}
Beispiel #17
0
value ml_add_fd_to_event_set(value task_v)
{
  int fd = Socket_val(Field(task_v,FD_TASK_FD));
  int must_read = ((Field(task_v, FD_TASK_RLEN) != Val_int(0)) &&
    (Field(Field(task_v, FD_TASK_READ_ALLOWED),0) == Val_true));
  int must_write = ( (Field(task_v, FD_TASK_WLEN) != Val_int(0)) &&
    (Field(Field(task_v, FD_TASK_WRITE_ALLOWED),0) == Val_true));

  return Val_unit;
}
Beispiel #18
0
CAMLprim value iocp_ml_read(value fd, value vlen)
{
  CAMLparam2(fd, vlen);
  CAMLlocal1(res);
  intnat len = Long_val(vlen);
  SOCKET s = Socket_val(fd);
  assert(Descr_kind_val(fd) == KIND_SOCKET);
  res = Val_int(async_read(s, len));

  CAMLreturn(res);
}
Beispiel #19
0
value skt_bind(value sock_v, value addr_v)
{
    int ret;
    union sock_addr_union addr;
    socklen_param_type addr_len;
    
    get_sockaddr(addr_v, &addr, &addr_len);
    ret = bind(Socket_val(sock_v), (struct sockaddr*) &addr.s_inet, addr_len);
    if (ret == -1) serror("bind");
    SKTTRACE(("bind\n"));
    return Val_unit;
}
Beispiel #20
0
CAMLprim value setsockopt_stub(value sock, value sockopt, value val) {
    CAMLparam3 (sock, sockopt, val);

    int native_sockopt = Int_val(sockopt);
    struct wrap *socket = Socket_val(sock);
    int result = -1;
    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_MAX:
        case ZMQ_BACKLOG:
        case ZMQ_MULTICAST_HOPS:
        case ZMQ_RCVTIMEO:
        case ZMQ_SNDTIMEO:
        {
            int optval = Int_val(val);
            result = zmq_setsockopt(socket->wrapped, native_sockopt, &optval, sizeof(optval));
        }
        break;
        
        case ZMQ_IDENTITY:
        case ZMQ_SUBSCRIBE:
        case ZMQ_UNSUBSCRIBE:
        {
            result = zmq_setsockopt(socket->wrapped,
                                    native_sockopt,
                                    String_val(val),
                                    caml_string_length(val));
        }
        break;

        case ZMQ_AFFINITY:
        case ZMQ_MAXMSGSIZE:
        {
            int64 optval = Int64_val(val);
            result = zmq_setsockopt(socket->wrapped, native_sockopt, &optval, sizeof(optval));
        }
        break;

        default:
            caml_failwith("Bidings error");
    }

    stub_raise_if (result == -1);

    CAMLreturn (Val_unit);
}
Beispiel #21
0
value skt_connect(value sock_v, value address){
    union sock_addr_union addr;
    socklen_param_type addr_len;
    int ret;
    
    get_sockaddr(address, &addr, &addr_len);
    ret = WSAConnect(Socket_val(sock_v), (struct sockaddr*) &addr.s_inet, addr_len,
		     NULL, NULL, NULL, NULL);
    
    if (ret < 0) serror("skt_connect") ;
    SKTTRACE(("skt_connect\n"));
    return Val_unit;
}
Beispiel #22
0
CAMLprim value netsys_int64_of_file_descr(value fd) {
#ifdef _WIN32
    switch (Descr_kind_val(fd)) {
    case KIND_HANDLE:
	return copy_int64((intnat) (Handle_val(fd)));
    case KIND_SOCKET:
	return copy_int64((intnat) (Socket_val(fd)));
    }
    return copy_int64(0);
#else
    return copy_int64(Long_val(fd));
#endif
}
Beispiel #23
0
CAMLprim value iocp_ml_write(value fd, value vbuf, value vlen)
{
  CAMLparam3(fd, vbuf, vlen);
  CAMLlocal1(res);
  intnat len = Long_val(vlen);
  SOCKET s = Socket_val(fd);
  char *buf = String_val(vbuf);
  assert(Descr_kind_val(fd) == KIND_SOCKET);
  res =  Val_int(async_write(s, buf, len));
  CAMLreturn(res);
  /* async_write(s, buf, len); */
  /* return Val_unit; */
}
Beispiel #24
0
/* Set size of receive buffers.
 */
value skt_setsockopt_recvbuf(	/* ML */
    value sock_v,
    value size_v
    )
{
    int size = Int_val(size_v) ;
    int sock = Socket_val(sock_v) ;
    int ret ;
    
    ret = setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (void*)&size, sizeof(size)) ;
    if (ret < 0) serror("setsockopt:recvbuf");
    return Val_int(ret) ;
}
Beispiel #25
0
CAMLprim value stub_setSocketTTL(value s, value ttl){
  CAMLparam2(s, ttl);
  int c_ttl = Int_val(ttl);
#ifdef WIN32
  SOCKET c_s = Socket_val(s);
  if (setsockopt(c_s, IPPROTO_IP, IP_TTL, (const char *)&c_ttl, sizeof(c_ttl)) != 0) {
    win32_maperr(GetLastError());
#else
  int c_fd = Int_val(s);
  if (setsockopt(c_fd, IPPROTO_IP, IP_TTL, &c_ttl, sizeof(c_ttl)) != 0) {
#endif
    unix_error(errno, "setsockopt", Nothing);
  }
  CAMLreturn(Val_unit);
}
Beispiel #26
0
CAMLprim value unix_close(value fd)
{
  if (Descr_kind_val(fd) == KIND_SOCKET) {
    if (closesocket(Socket_val(fd)) != 0) {
      win32_maperr(WSAGetLastError());
      uerror("close", Nothing);
    }
  } else {
    if (! CloseHandle(Handle_val(fd))) {
      win32_maperr(GetLastError());
      uerror("close", Nothing);
    }
  }
  return Val_unit;
}
Beispiel #27
0
CAMLprim value close_stub(value sock) {
    CAMLparam1 (sock);
    struct wrap *socket = Socket_val(sock);
    if (!socket->terminated) {
    
        caml_release_runtime_system();    
        int result = zmq_close(socket->wrapped);
        caml_acquire_runtime_system();
    
        stub_raise_if (result == -1);
        
        socket->terminated = 1;
    }
    CAMLreturn (Val_unit);
}
Beispiel #28
0
/* Set size of receive buffers.
 */
value skt_setsockopt_reuse(	/* ML */
    value sock_v,
    value onoff_v
    )
{
    BOOL size = Int_val(onoff_v) ;
    int sock = Socket_val(sock_v) ;
    int ret ;
    
    ret = setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,(char*)&size, sizeof(size)) ;
    
    SKTTRACE(("skt_sock_resuse\n"));
    if (ret == -1) serror("setsockopt:reuse");
    return Val_unit;
}
Beispiel #29
0
/* Convert fdlist to an fd_set if all the handles in fdlist are sockets and return 0.
 * Returns 1 if a non-socket value is encountered.
 */
static int fdlist_to_fdset(value fdlist, fd_set *fdset)
{
  value l, c;
  FD_ZERO(fdset);
  for (l = fdlist; l != Val_int(0); l = Field(l, 1)) {
    c = Field(l, 0);
    if (Descr_kind_val(c) == KIND_SOCKET) {
      FD_SET(Socket_val(c), fdset);
    } else {
      DEBUG_PRINT("Non socket value encountered");
      return 0;
    }
  }
  return 1;
}
Beispiel #30
0
CAMLprim value win_register_wait (value socket, value kind, value idx) {
  CAMLparam3(socket, kind, idx);
  long i = Long_val(idx);
  long mask;

  D(printf("Register: i %ld, kind %ld\n", Long_val(i), Long_val(kind)));
  events[i] = CreateEvent(NULL, TRUE, FALSE, NULL);
  mask = (Long_val(kind) == 0) ? FD_CONNECT : FD_ACCEPT;
  if (WSAEventSelect(Socket_val(socket), events[i], mask) == SOCKET_ERROR) {
    win32_maperr(WSAGetLastError ());
    uerror("WSAEventSelect", Nothing);
  }

  CAMLreturn (Val_unit);
}