1 /*
2 * Copyright (C) 2014 Zheng Li <dev@zheng.li>
3 *
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU Lesser General Public License as published
6 * by the Free Software Foundation; version 2.1 only. with the special
7 * exception on linking described in file LICENSE.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU Lesser General Public License for more details.
13 */
14
15 #include <poll.h>
16 #include <errno.h>
17 #include <sys/resource.h>
18 #include <unistd.h>
19 #include <caml/mlvalues.h>
20 #include <caml/memory.h>
21 #include <caml/fail.h>
22 #include <caml/alloc.h>
23 #include <caml/signals.h>
24 #include <caml/unixsupport.h>
25
stub_select_on_poll(value fd_events,value timeo)26 CAMLprim value stub_select_on_poll(value fd_events, value timeo) {
27
28 CAMLparam2(fd_events, timeo);
29 CAMLlocal1(events);
30 int i, rc, c_len = Wosize_val(fd_events), c_timeo = Int_val(timeo);
31 struct pollfd c_fds[c_len];
32
33
34 for (i = 0; i < c_len; i++) {
35
36 events = Field(Field(fd_events, i), 1);
37
38 c_fds[i].fd = Int_val(Field(Field(fd_events, i), 0));
39 c_fds[i].events = c_fds[i].revents = 0;
40 c_fds[i].events |= Bool_val(Field(events, 0)) ? POLLIN : 0;
41 c_fds[i].events |= Bool_val(Field(events, 1)) ? POLLOUT: 0;
42 c_fds[i].events |= Bool_val(Field(events, 2)) ? POLLPRI: 0;
43
44 };
45
46 caml_enter_blocking_section();
47 rc = poll(c_fds, c_len, c_timeo);
48 caml_leave_blocking_section();
49
50 if (rc < 0) uerror("poll", Nothing);
51
52 if (rc > 0) {
53
54 for (i = 0; i < c_len; i++) {
55
56 events = Field(Field(fd_events, i), 1);
57
58 if (c_fds[i].revents & POLLNVAL) unix_error(EBADF, "select", Nothing);
59 Field(events, 0) = Val_bool(c_fds[i].events & POLLIN && c_fds[i].revents & (POLLIN |POLLHUP|POLLERR));
60 Field(events, 1) = Val_bool(c_fds[i].events & POLLOUT && c_fds[i].revents & (POLLOUT|POLLHUP|POLLERR));
61 Field(events, 2) = Val_bool(c_fds[i].revents & POLLPRI);
62
63 }
64
65 }
66
67 CAMLreturn(Val_int(rc));
68 }
69
70
stub_set_fd_limit(value limit)71 CAMLprim value stub_set_fd_limit(value limit) {
72
73 CAMLparam1(limit);
74 struct rlimit rl;
75
76 rl.rlim_cur = rl.rlim_max = Int_val(limit);
77 if (setrlimit(RLIMIT_NOFILE, &rl) != 0) uerror("setrlimit", Nothing);
78 CAMLreturn(Val_unit);
79
80 }
81