Revert "Remove windows support"

This reverts commit de613f4.

.github/workflows/ci.yml

@@ -14,6 +14,7 @@ jobs:
         os:
           - macos-latest
           - ubuntu-latest
+          - windows-latest
     runs-on: ${{ matrix.os }}
     steps:
       - uses: actions/checkout@v2

CHANGES.md

@@ -1,8 +1,6 @@
 # 0.3.0
 
 * Make the poller's eventlist length configurable
-* Breaking
-  - Remove windows support via wepoll
 
 # 0.2.0
 

README.md

@@ -8,3 +8,4 @@ This library currently supports the following platforms:
 
 * macOS via [kqueue](https://en.wikipedia.org/wiki/Kqueue)
 * Linux via [epoll](https://en.wikipedia.org/wiki/Epoll)
+* Windows via [wepoll](https://github.com/piscisaureus/wepoll)

dune-project

@@ -17,11 +17,11 @@
 
 (package
  (name poll)
- (synopsis "Portable OCaml interface to macOS/Linux native IO event notification mechanisms")
+ (synopsis "Portable OCaml interface to macOS/Linux/Windows native IO event notification mechanisms")
  (description
-  "poll provides a portable OCaml interface to IO event notification mechanisms on macOS and Linux. It uses kqueue on macOS and epoll on Linux.")
+  "poll provides a portable OCaml interface to IO event notification mechanisms on macOS, Linux and Windows. It uses kqueue on macOS, epoll on Linux, and uses a vendored copy of wepoll on Windows.")
  (tags
-  (epoll kqueue))
+  (epoll kqueue wepoll))
  (depends
   base-unix
   ppx_optcomp

poll.opam

@@ -1,13 +1,13 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
 synopsis:
-  "Portable OCaml interface to macOS/Linux native IO event notification mechanisms"
+  "Portable OCaml interface to macOS/Linux/Windows native IO event notification mechanisms"
 description:
-  "poll provides a portable OCaml interface to IO event notification mechanisms on macOS and Linux. It uses kqueue on macOS and epoll on Linux."
+  "poll provides a portable OCaml interface to IO event notification mechanisms on macOS, Linux and Windows. It uses kqueue on macOS, epoll on Linux, and uses a vendored copy of wepoll on Windows."
 maintainer: ["Anurag Soni <[email protected]>"]
 authors: ["Anurag Soni"]
 license: "MIT"
-tags: ["epoll" "kqueue"]
+tags: ["epoll" "kqueue" "wepoll"]
 homepage: "https://github.com/anuragsoni/poll"
 doc: "https://anuragsoni.github.io/poll"
 bug-reports: "https://github.com/anuragsoni/poll/issues"

src/backend.ml

@@ -1,2 +1,2 @@
 type t = ..
-type t += Kqueue | Epoll
+type t += Kqueue | Epoll | Wepoll

src/dune

@@ -5,10 +5,12 @@
  (preprocessor_deps config.h)
  (foreign_stubs
   (language c)
-  (names unix_stubs epoll_stubs))
+  (names unix_stubs epoll_stubs wepoll_stubs wepoll))
  (libraries kqueue unix))
 
 (rule
  (targets config.h)
  (action
   (run ./config/config.exe)))
+
+(copy_files# ../vendor/*)

src/poll.ml

@@ -6,6 +6,7 @@ module Poll_intf = Poll_intf
 let backends =
   [ (module Kqueue_poll : Poll_intf.S), Kqueue.available
   ; (module Epoll_poll : Poll_intf.S), Epoll_poll.available
+  ; (module Wepoll_poll : Poll_intf.S), Wepoll_poll.available
   ; (module Empty_poll : Poll_intf.S), true
   ]
 ;;

src/wepoll_poll.ml

@@ -0,0 +1,150 @@
+[%%import "config.h"]
+[%%if defined POLL_CONF_WIN32]
+
+let available = true
+
+module Ffi = struct
+  external epoll_create1 : unit -> Unix.file_descr = "poll_stub_wepoll_create1"
+  external epoll_in : unit -> int = "poll_stub_epollin"
+  external epoll_rdhup : unit -> int = "poll_stub_epollrdhup"
+  external epoll_hup : unit -> int = "poll_stub_epollhup"
+  external epoll_err : unit -> int = "poll_stub_epollerr"
+  external epoll_pri : unit -> int = "poll_stub_epollpri"
+  external epoll_out : unit -> int = "poll_stub_epollout"
+  external epoll_oneshot : unit -> int = "poll_stub_epolloneshot"
+  external epoll_event_sizeof : unit -> int = "poll_stub_epoll_event_sizeout"
+
+  external epoll_ctl_add
+    :  Unix.file_descr
+    -> Unix.file_descr
+    -> int
+    -> unit
+    = "poll_stub_epoll_ctl_add"
+
+  external epoll_ctl_mod
+    :  Unix.file_descr
+    -> Unix.file_descr
+    -> int
+    -> unit
+    = "poll_stub_epoll_ctl_mod"
+
+  external epoll_ctl_del
+    :  Unix.file_descr
+    -> Unix.file_descr
+    -> unit
+    = "poll_stub_epoll_ctl_del"
+
+  external epoll_wait
+    :  Unix.file_descr
+    -> Bigstring.t
+    -> int
+    -> int
+    = "poll_stub_epoll_wait"
+
+  external epoll_iter_ready
+    :  Bigstring.t
+    -> int
+    -> (Unix.file_descr -> int -> unit)
+    -> unit
+    = "poll_stub_epoll_iter_ready"
+
+  let epoll_event_sizeof = epoll_event_sizeof ()
+  let epoll_in = epoll_in ()
+  let epoll_rdhup = epoll_rdhup ()
+  let epoll_hup = epoll_hup ()
+  let epoll_err = epoll_err ()
+  let epoll_pri = epoll_pri ()
+  let epoll_out = epoll_out ()
+  let epoll_oneshot = epoll_oneshot ()
+  let flag_read = epoll_in lor epoll_rdhup lor epoll_hup lor epoll_err lor epoll_pri
+  let flag_write = epoll_out lor epoll_hup lor epoll_err
+end
+
+type t =
+  { epoll_fd : Unix.file_descr
+  ; mutable ready_events : int
+  ; events : Bigstring.t
+  ; mutable closed : bool
+  ; flags : (Unix.file_descr, int) Hashtbl.t
+  }
+
+let ensure_open t = if t.closed then failwith "Attempting to use a closed epoll fd"
+let backend = Backend.Wepoll
+
+let create ?(num_events = 256) () =
+  if num_events < 1 then invalid_arg "Number of events cannot be less than 1";
+  { epoll_fd = Ffi.epoll_create1 ()
+  ; ready_events = 0
+  ; events = Bigstring.create (num_events * Ffi.epoll_event_sizeof)
+  ; closed = false
+  ; flags = Hashtbl.create 65536
+  }
+;;
+
+let clear t =
+  ensure_open t;
+  t.ready_events <- 0
+;;
+
+let close t =
+  if not t.closed
+  then (
+    t.closed <- true;
+    Unix.close t.epoll_fd)
+;;
+
+let set t fd event =
+  ensure_open t;
+  let current_flags = Hashtbl.find_opt t.flags fd in
+  let new_flags =
+    match event.Event.readable, event.Event.writable with
+    | false, false -> None
+    | true, false -> Some (Ffi.epoll_oneshot lor Ffi.flag_read)
+    | false, true -> Some (Ffi.epoll_oneshot lor Ffi.flag_write)
+    | true, true -> Some Ffi.(epoll_oneshot lor flag_read lor flag_write)
+  in
+  match current_flags, new_flags with
+  | None, None -> ()
+  | None, Some f ->
+    Ffi.epoll_ctl_add t.epoll_fd fd f;
+    Hashtbl.replace t.flags fd f
+  | Some _, None ->
+    Ffi.epoll_ctl_del t.epoll_fd fd;
+    Hashtbl.remove t.flags fd
+  | Some _, Some b ->
+    Ffi.epoll_ctl_mod t.epoll_fd fd b;
+    Hashtbl.replace t.flags fd b
+;;
+
+let wait t timeout =
+  let timeout =
+    match timeout with
+    | Timeout.Immediate -> 0
+    | Never -> -1
+    | After x -> Int64.to_int (Int64.div x 1_000_000L)
+  in
+  ensure_open t;
+  t.ready_events <- 0;
+  t.ready_events <- Ffi.epoll_wait t.epoll_fd t.events timeout;
+  if t.ready_events = 0 then `Timeout else `Ok
+;;
+
+let iter_callback f fd flags =
+  let readable = flags land Ffi.flag_read <> 0 in
+  let writable = flags land Ffi.flag_write <> 0 in
+  f fd { Event.readable; writable }
+;;
+
+let iter_ready t ~f =
+  ensure_open t;
+  let callback = iter_callback f in
+  Ffi.epoll_iter_ready t.events t.ready_events callback
+;;
+
+[%%else]
+
+include Empty_poll
+
+let available = false
+
+[%%endif]

src/wepoll_poll.mli

@@ -0,0 +1,3 @@
+include Poll_intf.S
+
+val available : bool

src/wepoll_stubs.c

@@ -0,0 +1,109 @@
+#include "config.h"
+
+#if defined(POLL_CONF_WIN32)
+#include <caml/alloc.h>
+#include <caml/bigarray.h>
+#include <caml/callback.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include <caml/threads.h>
+#include <caml/unixsupport.h>
+#include <errno.h>
+#include "wepoll.h"
+
+
+#define Epoll_constant(name, i)                                                \
+    CAMLprim value name(value unit) { return Val_int(i); }
+
+  Epoll_constant(poll_stub_epollin, EPOLLIN)
+  Epoll_constant(poll_stub_epollrdhup, EPOLLRDHUP)
+  Epoll_constant(poll_stub_epollhup, EPOLLHUP)
+  Epoll_constant(poll_stub_epollerr, EPOLLERR)
+  Epoll_constant(poll_stub_epollpri, EPOLLPRI)
+  Epoll_constant(poll_stub_epollout, EPOLLOUT)
+  Epoll_constant(poll_stub_epolloneshot, EPOLLONESHOT)
+
+
+CAMLprim value poll_stub_wepoll_create1(value unit) {
+    CAMLparam1(unit);
+    HANDLE fd;
+
+    fd = epoll_create1(0);
+    if (fd == INVALID_HANDLE_VALUE) {
+        win32_maperr(GetLastError());
+        uerror("epoll_create1", Nothing);
+    }
+    CAMLreturn(win_alloc_handle(fd));
+}
+
+CAMLprim value poll_stub_epoll_event_sizeout(value unit) {
+    return Val_long(sizeof(struct epoll_event));
+}
+
+CAMLprim value poll_stub_epoll_fd_offset(value unit) {
+    return Val_int(offsetof(struct epoll_event, data.fd));
+}
+
+CAMLprim value poll_stub_epoll_flag_offset(value unit) {
+    return Val_int(offsetof(struct epoll_event, events));
+}
+
+static value poll_stub_epoll_ctl(value epoll_fd, value fd, value flags, int operation) {
+    CAMLparam3(epoll_fd, fd, flags);
+    struct epoll_event evt;
+    evt.data.ptr = NULL;
+    evt.events = Int_val(flags);
+    evt.data.fd = Socket_val(fd);
+    if (epoll_ctl(Handle_val(epoll_fd), operation, Socket_val(fd), &evt) == -1)
+      uerror("epoll_ctl", Nothing);
+    CAMLreturn(Val_unit);
+}
+
+CAMLprim value poll_stub_epoll_ctl_add(value epoll_fd, value fd, value flags) {
+    return poll_stub_epoll_ctl(epoll_fd, fd, flags, EPOLL_CTL_ADD);
+}
+
+CAMLprim value poll_stub_epoll_ctl_mod(value epoll_fd, value fd, value flags) {
+    return poll_stub_epoll_ctl(epoll_fd, fd, flags, EPOLL_CTL_MOD);
+}
+
+CAMLprim value poll_stub_epoll_ctl_del(value epoll_fd, value fd) {
+    if (epoll_ctl(Handle_val(epoll_fd), EPOLL_CTL_DEL, Socket_val(fd), NULL) == -1)
+      uerror("epoll_ctl", Nothing);
+    return Val_unit;
+}
+
+CAMLprim value poll_stub_epoll_wait(value epoll_fd, value buf, value t) {
+    CAMLparam3(epoll_fd, buf, t);
+    struct epoll_event *events;
+    int event_count, res;
+    int timeout = Long_val(t);
+
+    events = (struct epoll_event *)Caml_ba_data_val(buf);
+    event_count = Caml_ba_array_val(buf)->dim[0] / sizeof(struct epoll_event);
+
+    caml_enter_blocking_section();
+    res = epoll_wait(Handle_val(epoll_fd), events, event_count, timeout);
+    caml_leave_blocking_section();
+
+    if (res == -1)
+      uerror("epoll_wait", Nothing);
+
+    CAMLreturn(Val_long(res));
+}
+
+CAMLprim value poll_stub_epoll_iter_ready(value events, value event_len, value callback) {
+    CAMLparam3(events, event_len, callback);
+    struct epoll_event *epoll_events;
+    epoll_events = (struct epoll_event *)Caml_ba_data_val(events);
+
+    for (int i = 0; i < Long_val(event_len); i++) {
+        caml_callback2(callback, win_alloc_socket(epoll_events[i].data.fd), Val_int(epoll_events[i].events));
+    }
+    CAMLreturn(Val_unit);
+}
+#else
+  typedef int dummy_definition_wepoll;
+#endif