(**
 * Copyright (c) Facebook, Inc. and its affiliates.
 *
 * This source code is licensed under the MIT license found in the
 * LICENSE file in the root directory of this source tree.
 *)

let spf = Printf.sprintf

(* So there's a bug in Unix.select on Windows. Basically, select is supposed to be
 * "level triggered". That is, as long as you select a ready fd, select should always return it.
 * This is opposed to an "edge triggered" API  which would only return the fd when it becomes
 * available.
 *
 * However, Unix.select doesn't seem to behave this way on Windows. If you call Unix.select with
 * only sockets, then it uses the select system call  and everything is fine. But if you call
 * Unix.select with a mix of fd types (like stdin and a socket, or a pipe and a socket), it
 * falls back to some other code.
 *
 * The long and the short of it is that sometimes a ready fd isn't returned by Unix.select on
 * Windows when you pass in a mix of sockets and non-sockets. The work around is to split the
 * single Unix.select call into multiple Unix.select calls.
 *
 * OCaml bug report: https://caml.inria.fr/mantis/view.php?id=7665
 * lwt issue: https://github.com/ocsigen/lwt/issues/496
 *)
class windows_select = object
  inherit Lwt_engine.select_based

  method private select fds_r fds_w timeout =
    (* Figure out which fds are already ready to be read *)
    let ready_r = List.fold_left (fun ready_r fd_r ->
      match Unix.select [fd_r] [] [] 0.0 with
      | [], _, _ -> ready_r
      | _ -> fd_r::ready_r
    ) [] fds_r in

    (* Figure out which fds are already ready to be written *)
    let ready_w = List.fold_left (fun ready_w fd_w ->
      match Unix.select [] [fd_w] [] 0.0 with
      | _, [], _ -> ready_w
      | _ -> fd_w::ready_w
    ) [] fds_w in

    (* If nothing is ready, then do a multi-fd select with the timeout *)
    if ready_r = [] && ready_w = []
    then
      let fds_r, fds_w, _ = Unix.select fds_r fds_w [] timeout in
      (fds_r, fds_w)
    else (ready_r, ready_w)
end

(*
 * So there's a bug in Unix.select on unix (Linux and OSX). Basically, select is supposed to raise
 * EBADF on bad fds, but it raises EINVAL on fds that are < 0 or >= FD_SETSIZE. Lwt can handle EBADF
 * and will filter out bad fds. However, it doesn't handle EINVAL.
 *
 * So until this is fixed, let's just translate EINVAL to EBADF. This is only dangerous if EINVAL
 * is ever thrown for something other than a bad fd. From the man page, EINVAL is only thrown for
 *
 * 1) invalid timeouts (impossible from the OCaml API)
 * 2) nfds is < 0 or > RLIMIT_NOFILE, which also should be impossible due the c code in select.c
 *
 * So the only case we really need to worry about is fds that are larger than FD_SETSIZE but still
 * valid. From select's manpage:
 *
 * "select() can monitor only file descriptors numbers that are less than FD_SETSIZE;
 *  poll(2) does not have this limitation"
 *
 * So we're kind of screwed if we have large fds we need to monitor anyway.
 *
 * OCaml bug report: https://caml.inria.fr/mantis/view.php?id=7700
 * lwt issue: https://github.com/ocsigen/lwt/issues/529
 *)
class unix_select = object
  inherit Lwt_engine.select_based

  method private select fds_r fds_w timeout =
    let fds_r, fds_w, _ =
      try Unix.select fds_r fds_w [] timeout
      with
      | Unix.Unix_error (Unix.EINVAL, fn, params) -> begin
        (* Ok, so either one of the fds is an invalid fd, or maybe it's a valid fd but too large
        * for select *)
        begin try
          let explode_if_bad fd = Unix.fstat fd |> ignore in
          List.iter explode_if_bad fds_r;
          List.iter explode_if_bad fds_w
        with Unix.Unix_error (_, _, _) ->
          raise (Unix.Unix_error (Unix.EBADF, fn, params))
        end;
        (* Oh boy. So it looks like all the fds are valid. This likely means that one fd is larger
         * than FD_SETSIZE (which is probably 1024). select() stops working for large fds like this
         *)
        let string_of_fd fd = string_of_int ((Obj.magic fd): int) in
        let string_of_fds fds = String.concat ";" (Core_list.map ~f:string_of_fd fds) in
        let params = spf "[%s] [%s] []" (string_of_fds fds_r) (string_of_fds fds_w) in
        raise (Unix.Unix_error (Unix.EINVAL, "select", params))
      end
    in
    (fds_r, fds_w)
end

let set_engine () =
  (* In theory, we could allow Flow built on machines with libev to use libev instead of select.
   * However, it seems like lwt_config.h on my OSX opam and my CentOS opam both comment out
   * HAVE_LIBEV. And I suppose if we can't rely on libev everywhere then we should rely on it
   * nowhere *)
  if Sys.win32
  then Lwt_engine.set (new windows_select) (* See comment on windows_select *)
  else Lwt_engine.set (new unix_select) (* See comment on unix_select *)

let run_lwt f =
  set_engine ();
  Lwt_main.run (f ())
