1 /**************************************************************************/
2 /* */
3 /* OCaml */
4 /* */
5 /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
6 /* */
7 /* Copyright 1996 Institut National de Recherche en Informatique et */
8 /* en Automatique. */
9 /* */
10 /* All rights reserved. This file is distributed under the terms of */
11 /* the GNU Lesser General Public License version 2.1, with the */
12 /* special exception on linking described in the file LICENSE. */
13 /* */
14 /**************************************************************************/
15
16 #include <caml/mlvalues.h>
17 #include <caml/alloc.h>
18 #include <caml/fail.h>
19 #include <caml/memory.h>
20 #include <caml/signals.h>
21 #include "unixsupport.h"
22
23 #ifdef HAS_SELECT
24
25 #include <sys/types.h>
26 #include <sys/time.h>
27 #ifdef HAS_SYS_SELECT_H
28 #include <sys/select.h>
29 #endif
30 #include <string.h>
31 #include <unistd.h>
32 #include <errno.h>
33
fdlist_to_fdset(value fdlist,fd_set * fdset,int * maxfd)34 static int fdlist_to_fdset(value fdlist, fd_set *fdset, int *maxfd)
35 {
36 value l;
37 FD_ZERO(fdset);
38 for (l = fdlist; l != Val_int(0); l = Field(l, 1)) {
39 long fd = Long_val(Field(l, 0));
40 /* PR#5563: harden against bad fds */
41 if (fd < 0 || fd >= FD_SETSIZE) return -1;
42 FD_SET((int) fd, fdset);
43 if (fd > *maxfd) *maxfd = fd;
44 }
45 return 0;
46 }
47
fdset_to_fdlist(value fdlist,fd_set * fdset)48 static value fdset_to_fdlist(value fdlist, fd_set *fdset)
49 {
50 value l;
51 value res = Val_int(0);
52
53 Begin_roots2(l, res);
54 for (l = fdlist; l != Val_int(0); l = Field(l, 1)) {
55 int fd = Int_val(Field(l, 0));
56 if (FD_ISSET(fd, fdset)) {
57 value newres = caml_alloc_small(2, 0);
58 Field(newres, 0) = Val_int(fd);
59 Field(newres, 1) = res;
60 res = newres;
61 }
62 }
63 End_roots();
64 return res;
65 }
66
unix_select(value readfds,value writefds,value exceptfds,value timeout)67 CAMLprim value unix_select(value readfds, value writefds, value exceptfds,
68 value timeout)
69 {
70 fd_set read, write, except;
71 int maxfd;
72 double tm;
73 struct timeval tv;
74 struct timeval * tvp;
75 int retcode;
76 value res;
77
78 Begin_roots3 (readfds, writefds, exceptfds);
79 maxfd = -1;
80 retcode = fdlist_to_fdset(readfds, &read, &maxfd);
81 retcode += fdlist_to_fdset(writefds, &write, &maxfd);
82 retcode += fdlist_to_fdset(exceptfds, &except, &maxfd);
83 /* PR#5563: if a bad fd was encountered, report EINVAL error */
84 if (retcode != 0) unix_error(EINVAL, "select", Nothing);
85 tm = Double_val(timeout);
86 if (tm < 0.0)
87 tvp = (struct timeval *) NULL;
88 else {
89 tv.tv_sec = (int) tm;
90 tv.tv_usec = (int) (1e6 * (tm - tv.tv_sec));
91 tvp = &tv;
92 }
93 caml_enter_blocking_section();
94 retcode = select(maxfd + 1, &read, &write, &except, tvp);
95 caml_leave_blocking_section();
96 if (retcode == -1) uerror("select", Nothing);
97 readfds = fdset_to_fdlist(readfds, &read);
98 writefds = fdset_to_fdlist(writefds, &write);
99 exceptfds = fdset_to_fdlist(exceptfds, &except);
100 res = caml_alloc_small(3, 0);
101 Field(res, 0) = readfds;
102 Field(res, 1) = writefds;
103 Field(res, 2) = exceptfds;
104 End_roots();
105 return res;
106 }
107
108 #else
109
unix_select(value readfds,value writefds,value exceptfds,value timeout)110 CAMLprim value unix_select(value readfds, value writefds, value exceptfds,
111 value timeout)
112 { caml_invalid_argument("select not implemented"); }
113
114 #endif
115