/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #define CAML_INTERNALS #include #include #include #include #include #include "caml/unixsupport.h" #ifdef HAS_SELECT #include #include #ifdef HAS_SYS_SELECT_H #include #endif #include #include #include static int fdlist_to_fdset(value fdlist, fd_set *fdset, int *maxfd) { FD_ZERO(fdset); for (value l = fdlist; l != Val_emptylist; l = Field(l, 1)) { long fd = Long_val(Field(l, 0)); /* PR#5563: harden against bad fds */ if (fd < 0 || fd >= FD_SETSIZE) return -1; FD_SET((int) fd, fdset); if (fd > *maxfd) *maxfd = fd; } return 0; } static value fdset_to_fdlist(value fdlist, fd_set *fdset) { CAMLparam0(); CAMLlocal2(l, res); for (l = fdlist; l != Val_emptylist; l = Field(l, 1)) { int fd = Int_val(Field(l, 0)); if (FD_ISSET(fd, fdset)) { value newres = caml_alloc_small(2, Tag_cons); Field(newres, 0) = Val_int(fd); Field(newres, 1) = res; res = newres; } } CAMLreturn(res); } CAMLprim value caml_unix_select(value readfds, value writefds, value exceptfds, value timeout_sec) { CAMLparam3(readfds, writefds, exceptfds); fd_set read, write, except; int maxfd; double tm_sec; struct timeval tv; struct timeval * tvp; int retcode; value res; maxfd = -1; retcode = fdlist_to_fdset(readfds, &read, &maxfd); retcode += fdlist_to_fdset(writefds, &write, &maxfd); retcode += fdlist_to_fdset(exceptfds, &except, &maxfd); /* PR#5563: if a bad fd was encountered, report EINVAL error */ if (retcode != 0) caml_unix_error(EINVAL, "select", Nothing); tm_sec = Double_val(timeout_sec); if (tm_sec < 0.0) { tvp = (struct timeval *) NULL; } else { tv = caml_timeval_of_sec(tm_sec); tvp = &tv; } caml_enter_blocking_section(); retcode = select(maxfd + 1, &read, &write, &except, tvp); caml_leave_blocking_section(); if (retcode == -1) caml_uerror("select", Nothing); readfds = fdset_to_fdlist(readfds, &read); writefds = fdset_to_fdlist(writefds, &write); exceptfds = fdset_to_fdlist(exceptfds, &except); res = caml_alloc_small(3, 0); Field(res, 0) = readfds; Field(res, 1) = writefds; Field(res, 2) = exceptfds; CAMLreturn(res); } #else CAMLprim value caml_unix_select(value readfds, value writefds, value exceptfds, value timeout) { caml_invalid_argument("select not implemented"); } #endif