コード例 #1
0
ファイル: dup.c プロジェクト: Chris00/ocaml
CAMLprim value unix_dup(value fd)
{
  HANDLE newh;
  value newfd;
  int kind = Descr_kind_val(fd);
  if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd),
                        GetCurrentProcess(), &newh,
                        0L, TRUE, DUPLICATE_SAME_ACCESS)) {
    win32_maperr(GetLastError());
    return -1;
  }
  newfd = win_alloc_handle(newh);
  Descr_kind_val(newfd) = kind;
  return newfd;
}
コード例 #2
0
ファイル: lwt_unix_windows.c プロジェクト: avsm/lwt-OLD
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);
}
コード例 #3
0
static HANDLE handle_of_descr(value x)
{
	if(Descr_kind_val(x) != KIND_HANDLE){
		failwith("mlterminal(the channel is not a file handle)");
	}
	return Handle_val(x);
}
コード例 #4
0
ファイル: read.c プロジェクト: MassD/ocaml
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);
}
コード例 #5
0
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;
}
コード例 #6
0
value win_alloc_handle(HANDLE h)
{
  value res = alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1);
  Handle_val(res) = h;
  Descr_kind_val(res) = KIND_HANDLE;
  CRT_fd_val(res) = NO_CRT_FD;
  return res;
}
コード例 #7
0
ファイル: lwt_glib_stubs.c プロジェクト: Drup/lwt
static value alloc_fd(HANDLE handle)
{
  value res = win_alloc_handle(handle);
  int opt;
  int optlen = sizeof(opt);
  if (getsockopt((SOCKET)handle, SOL_SOCKET, SO_TYPE, (char *)&opt, &optlen) == 0)
    Descr_kind_val(res) = KIND_SOCKET;
  return res;
}
コード例 #8
0
ファイル: unixsupport.c プロジェクト: MassD/ocaml
/* PR#4750: this function is no longer used */
value win_alloc_handle_or_socket(HANDLE h)
{
  value res = win_alloc_handle(h);
  int opt;
  int optlen = sizeof(opt);
  if (getsockopt((SOCKET) h, SOL_SOCKET, SO_TYPE, (char *)&opt, &optlen) == 0)
    Descr_kind_val(res) = KIND_SOCKET;
  return res;
}
コード例 #9
0
ファイル: binding_iocp.c プロジェクト: AltGr/opalang
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);
}
コード例 #10
0
ファイル: channels.c プロジェクト: d5nguyenvan/mirage
CAMLprim value win_inchannel_of_filedescr(value handle)
{
  CAMLparam1(handle);
  CAMLlocal1(vchan);
  struct channel * chan;

  chan = caml_open_descriptor_in(win_CRT_fd_of_filedescr(handle));
  if (Descr_kind_val(handle) == KIND_SOCKET)
    chan->flags |= CHANNEL_FLAG_FROM_SOCKET;
  vchan = caml_alloc_channel(chan);
  CAMLreturn(vchan);
}
コード例 #11
0
ファイル: dup2.c プロジェクト: ArnaudParant/install_script
CAMLprim value unix_dup2(value fd1, value fd2)
{
  HANDLE oldh, newh;

  oldh = Handle_val(fd2);
  if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd1),
                        GetCurrentProcess(), &newh,
                        0L, TRUE, DUPLICATE_SAME_ACCESS)) {
    win32_maperr(GetLastError());
    return -1;
  }
  Handle_val(fd2) = newh;
  if (Descr_kind_val(fd2) == KIND_SOCKET)
    closesocket((SOCKET) oldh);
  else
    CloseHandle(oldh);
  Descr_kind_val(fd2) = Descr_kind_val(fd1);
  /* Reflect the dup2 on the CRT fds, if any */
  if (CRT_fd_val(fd1) != NO_CRT_FD || CRT_fd_val(fd2) != NO_CRT_FD)
    _dup2(win_CRT_fd_of_filedescr(fd1), win_CRT_fd_of_filedescr(fd2));
  return Val_unit;
}
コード例 #12
0
ファイル: netsys_c.c プロジェクト: flashfoxter/libres3
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
}
コード例 #13
0
ファイル: binding_iocp.c プロジェクト: AltGr/opalang
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; */
}
コード例 #14
0
ファイル: select.c プロジェクト: bmeurer/ocaml-arm
/* 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;
}
コード例 #15
0
ファイル: close.c プロジェクト: puppeh/ocaml-sh4
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;
}
コード例 #16
0
ファイル: stat.c プロジェクト: dhil/ocaml-multicore
static value do_fstat(value handle, int use_64)
{
  int ret;
  struct _stat64 buf;
  __int64 st_ino;
  HANDLE h;
  DWORD ft;

  st_ino = 0;
  memset(&buf, 0, sizeof buf);
  buf.st_nlink = 1;

  h = Handle_val(handle);
  ft = GetFileType(h) & ~FILE_TYPE_REMOTE;
  switch(ft) {
  case FILE_TYPE_DISK:
    if (!safe_do_stat(0, use_64, NULL, Handle_val(handle), &st_ino, &buf)) {
      uerror("fstat", Nothing);
    }
    break;
  case FILE_TYPE_CHAR:
    buf.st_mode = S_IFCHR;
    break;
  case FILE_TYPE_PIPE:
    {
      DWORD n_avail;
      if (Descr_kind_val(handle) == KIND_SOCKET) {
        buf.st_mode = S_IFSOCK;
      }
      else {
        buf.st_mode = S_IFIFO;
      }
      if (PeekNamedPipe(h, NULL, 0, NULL, &n_avail, NULL)) {
        buf.st_size = n_avail;
      }
    }
    break;
  case FILE_TYPE_UNKNOWN:
    unix_error(EBADF, "fstat", Nothing);
  default:
    win32_maperr(GetLastError());
    uerror("fstat", Nothing);
  }
  return stat_aux(use_64, st_ino, &buf);
}
コード例 #17
0
ファイル: select.c プロジェクト: bmeurer/ocaml-arm
/* Guess handle type */
static SELECTHANDLETYPE get_handle_type(value fd)
{
  DWORD            mode;
  SELECTHANDLETYPE res;

  CAMLparam1(fd);

  mode = 0;
  res = SELECT_HANDLE_NONE;

  if (Descr_kind_val(fd) == KIND_SOCKET)
  {
    res = SELECT_HANDLE_SOCKET;
  }
  else
  {
    switch(GetFileType(Handle_val(fd)))
    {
      case FILE_TYPE_DISK:
        res = SELECT_HANDLE_DISK;
        break;

      case FILE_TYPE_CHAR: /* character file or a console */
        if (GetConsoleMode(Handle_val(fd), &mode) != 0)
        {
          res = SELECT_HANDLE_CONSOLE;
        }
        else
        {
          res = SELECT_HANDLE_NONE;
        };
        break;

      case FILE_TYPE_PIPE: /* a named or an anonymous pipe (socket already handled) */
        res = SELECT_HANDLE_PIPE;
        break;
    };
  };

  CAMLreturnT(SELECTHANDLETYPE, res);
}
コード例 #18
0
ファイル: write.c プロジェクト: ocsigen/ocaml-eliom
CAMLprim value unix_write(value fd, value buf, value vofs, value vlen)
{
  intnat ofs, len, written;
  DWORD numbytes, numwritten;
  char iobuf[UNIX_BUFFER_SIZE];
  DWORD err = 0;

  Begin_root (buf);
    ofs = Long_val(vofs);
    len = Long_val(vlen);
    written = 0;
    while (len > 0) {
      numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len;
      memmove (iobuf, &Byte(buf, ofs), numbytes);
      if (Descr_kind_val(fd) == KIND_SOCKET) {
        int ret;
        SOCKET s = Socket_val(fd);
        enter_blocking_section();
        ret = send(s, iobuf, numbytes, 0);
        if (ret == SOCKET_ERROR) err = WSAGetLastError();
        leave_blocking_section();
        numwritten = ret;
      } else {
        HANDLE h = Handle_val(fd);
        enter_blocking_section();
        if (! WriteFile(h, iobuf, numbytes, &numwritten, NULL))
          err = GetLastError();
        leave_blocking_section();
      }
      if (err) {
        win32_maperr(err);
        uerror("write", Nothing);
      }
      written += numwritten;
      ofs += numwritten;
      len -= numwritten;
    }
  End_roots();
  return Val_long(written);
}
コード例 #19
0
CAMLprim value netsys_mem_write(value fdv, value memv, value offv, value lenv)
{
    intnat numbytes;
    intnat ret;
    char *data;
#ifdef _WIN32
    DWORD n;
    DWORD err = 0;
#endif

    numbytes = Long_val(lenv);
    data = ((char *) (Bigarray_val(memv)->data)) + Long_val(offv);
#ifdef _WIN32
    if (Descr_kind_val(fdv) == KIND_SOCKET) {
	SOCKET h = Socket_val(fdv);
	enter_blocking_section();
	ret = send(h, data, numbytes, 0);
	if (ret == SOCKET_ERROR) err = WSAGetLastError();
	leave_blocking_section();
	ret = n;
    } else {
	HANDLE h = Handle_val(fdv);
	enter_blocking_section();
	if (! WriteFile(h, data, numbytes, &n, NULL)) err = GetLastError();
	leave_blocking_section();
	ret = n;
    }
    if (err) {
	win32_maperr(err);
	ret = -1;
    }
#else
    enter_blocking_section();
    ret = write(Int_val(fdv), data, (int) numbytes);
    leave_blocking_section();
#endif
    if (ret == -1) uerror("mem_write", Nothing);
    return Val_long(ret);
}
コード例 #20
0
ファイル: lwt_unix_windows.c プロジェクト: avsm/lwt-OLD
CAMLprim value lwt_unix_is_socket(value fd)
{
  return (Val_bool(Descr_kind_val(fd) == KIND_SOCKET));
}