-
Notifications
You must be signed in to change notification settings - Fork 125
/
epoll.ml
213 lines (184 loc) · 6.82 KB
/
epoll.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
(*
Copyright © 2011 MLstate
This file is part of OPA.
OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
(* THIS FILE HAS A DOCUMENTED MLI *)
(* error reporting *)
type error = int * string
let error_code = fst
let error_message = snd
exception Error of error
(* epoll descriptor *)
type epoll_descriptor = int
#<Ifstatic:MLSTATE_WINDOWS .*>
let last_error_message _ = assert false
let last_error_code _ = assert false
let ep_create _ = assert false
let ep_close _ = assert false
let ep_in _ = assert false
let ep_out _ = assert false
let ep_err _ = assert false
let ep_hup _ = assert false
let _on_mac _ = assert false
let on_mac = false
#<Else>
external last_error_message : unit -> string = "error_msg"
external last_error_code : unit -> int = "error_value"
external ep_create : int -> epoll_descriptor = "ep_create"
external ep_close : epoll_descriptor -> int = "ep_close"
external ep_in : unit -> int = "ep_EPOLLIN"
external ep_out : unit -> int = "ep_EPOLLOUT"
external ep_err : unit -> int = "ep_EPOLLERR"
external ep_hup : unit -> int = "ep_EPOLLHUP"
external _on_mac : unit -> bool = "on_mac"
let on_mac = _on_mac ()
#<End>
(* check_ret factory *)
let check_ret str ret =
if ret = -1 then
let message = Printf.sprintf "%s: %s" str (last_error_message ()) in
let code = last_error_code () in
Logger.error "Epoll error %d: %s" code message(* ; *)
(* raise (Error (code, message)) *)
(* events *)
type supported_event = In | Out | Hup | Err | Unsupported of int
type event = int
type event_mask = int
let event_in, event_out, event_in_out, event_hup, event_err =
let u() =(ep_in(), ep_out(), (ep_in() lor ep_out()), ep_hup(), ep_err()) in
let z()= (0, 0, 0, 0, 0) in
Mlstate_platform.platform_dependent
~unix:u
~cygwin:z
~windows:z
() ()
let event_mask_to_list event_mask =
(* Frequent cases have to be memoized *)
if event_mask = event_in then [In] else
if event_mask = event_out then [Out] else
if event_mask = (event_in lor event_out) then [In; Out]
else begin
let f (r, l) (ie, ee) = if ((ie land r) = ie) then ((ie lxor r), ee::l) else (r, l) in
let rec aux (event_mask, event_list) events =
if event_mask = 0 then event_list
else (
match events with
| [] -> (Unsupported event_mask)::event_list
| h::t -> aux (f (event_mask, event_list) h) t
)
in
aux (event_mask, []) [(event_in, In); (event_out, Out); (event_hup, Hup); (event_err, Err)]
end
let event_list_to_mask event_list =
List.fold_left
(fun e_mask ee ->
let ie =
match ee with
| In -> event_in
| Out -> event_out
| Err -> event_err
| Hup -> event_hup
| Unsupported e -> e
in
ie lor e_mask
) 0 event_list
(* requests *)
(* low level : private *)
#<Ifstatic:MLSTATE_WINDOWS .*>
let ep_add _ _ _ = assert false
let ep_del _ _ _ = assert false
let ep_mod _ _ _ = assert false
let ep_wait _ ~maxevents ~timeout =
let _ = ignore (maxevents, timeout) in
assert false
#<Else>
external ep_add : epoll_descriptor -> Unix.file_descr -> event_mask-> int = "ep_add"
external ep_del : epoll_descriptor -> Unix.file_descr -> event_mask -> int = "ep_del"
external ep_mod : epoll_descriptor -> Unix.file_descr -> event_mask -> int = "ep_mod"
external ep_wait : epoll_descriptor -> maxevents : int -> timeout : int -> (Unix.file_descr * event_mask) array = "ep_wait"
#<End>
(* high level : exported *)
(* The test [if int_of_filedesc fd >= 0 then] is there because weblib is also used with
dummy_connection (cf doc in mli). Dummy connections build negative file descriptor
In this case, Epoll ignore these file descriptors.
*)
external int_of_filedesc : Unix.file_descr -> int = "%identity"
external filedesc_of_int : int -> Unix.file_descr = "%identity"
external int_of_epoll_descriptor : epoll_descriptor -> int = "%identity"
external epoll_descriptor_of : int -> epoll_descriptor = "%identity"
let combine =
List.fold_left (lor) 0
let create size =
Mlstate_platform.on_windows (fun()->failwith "ep_create on windows");
let ret = ep_create size in
check_ret "epoll_create" ret;
epoll_descriptor_of ret (* normally useless ?? *)
let close ed = check_ret "epoll_close" (ep_close ed)
let del epfd fd =
Mlstate_platform.on_windows (fun()->failwith "ep_del on windows");
if int_of_filedesc fd >= 0 then
let ret =
if on_mac then (
let _ = ep_del epfd fd event_in in
ep_del epfd fd event_out )
else
ep_del epfd fd 0
in
check_ret "epoll_del" ret
let listen_in_out epfd ?(is_new_fd=false) fd =
if int_of_filedesc fd >= 0 then
let ret =
if on_mac then (
let _ = ep_add epfd fd event_in in
ep_add epfd fd event_out )
else (
if is_new_fd then
ep_add epfd fd event_in_out
else
ep_mod epfd fd event_in_out )
in
check_ret "listen_in_out" ret
let listen_x_only x y epfd is_new_fd fd =
if int_of_filedesc fd >= 0 then
let ret =
if on_mac then (
let _ = ep_del epfd fd y in
ep_add epfd fd x )
else (
if is_new_fd then
ep_add epfd fd x
else
ep_mod epfd fd x )
in
check_ret "listen_x_only" ret
let listen_in_only epfd is_new_fd fd = listen_x_only event_in event_out epfd is_new_fd fd
let listen_out_only epfd is_new_fd fd = listen_x_only event_out event_in epfd is_new_fd fd
let wait ?tout:(timeout = -1) epfd maxevents =
Mlstate_platform.on_windows (fun()->failwith "ep_wait on windows");
let a = ep_wait epfd ~maxevents ~timeout in
Array.map (fun (fd, events) -> (fd, event_mask_to_list events)) a
module Debug =
struct
(* This functions are used only for printing file descriptors and events (useful for debugging) *)
(* http://caml.inria.fr/pub/ml-archives/caml-list/2002/06/b0e3d11df12ca90608634197c0792939.en.html *)
external int_of_filedescr : Unix.file_descr -> int = "%identity"
external filedescr_of_int : int -> Unix.file_descr = "%identity"
external int_of_events : event_mask -> int = "%identity"
external int_of_epoll_descriptor : epoll_descriptor -> int = "%identity"
(* tests *)
(* let test() = *)
(* let fd = create (10) in *)
(* add fd Unix.stdout event_in; *)
(* add fd Unix.stdin event_in; *)
(* let arr = wait fd 10 in *)
(* Printf.printf "Got: %d\n" (Array.length arr) *)
end