inotify_lwt.ml

open Lwt
include Inotify

let section = Lwt_log.Section.make "inotify_lwt"

external struct_size : unit -> int = "stub_inotify_struct_size"
external convert : string -> (wd * type_event list * int32 * int)
                 = "stub_inotify_convert"

type t = { fd : Lwt_unix.file_descr; mutable closed : bool }

let finalizer t =
  if t.closed then return ()
  else begin
    t.closed <- true;
    Lwt_unix.close t.fd
  end

let wrap fd =
  let fd = Lwt_unix.of_unix_file_descr ~blocking:false ~set_flags:true fd in
  let r = { fd; closed = false } in
    Lwt_gc.finalise finalizer r;
    r

let fd t = Lwt_unix.unix_file_descr t.fd

let init () = wrap (init ())

let add_watch t s l = add_watch (Lwt_unix.unix_file_descr t.fd) s l

let rm_watch t wd = rm_watch (Lwt_unix.unix_file_descr t.fd) wd

let struct_size = struct_size ()

external to_read : Unix.file_descr -> int = "stub_inotify_ioctl_fionread"

let unix_fd t = Lwt_unix.unix_file_descr t.fd

let read t =
  (* we don't know the message length, so we wait until we have something to
   * read and then grab all the pending events at once *)
  try_lwt
    let s = String.create 4 in
    lwt _ = Lwt_unix.read t.fd s 0 1 in
      (* EINVAL returned by read in Linux >= 2.6.12,
       * 0 returned in Linux < 2.6.12 *)
      raise_lwt (Failure "dummy")
  with _ ->
    let buf = String.create (to_read (unix_fd t)) in
    lwt read = Lwt_unix.read t.fd buf 0 (String.length buf) in
    let rec loop acc = function
        off when off >= read -> return (List.rev acc)
      | off ->
          let wd, l, cookie, len = convert (String.sub buf off struct_size) in
          let name, off =
            if len = 0 then
              (None, off + struct_size)
            else
              let name_with_zeros = String.sub buf (off + struct_size) len in
              let name = String.sub name_with_zeros 0
                           (String.index name_with_zeros '\000')
              in (Some name, off + struct_size + len)
          in loop ((wd, l, cookie, name) :: acc) off
    in loop [] 0

let close t =
  ignore begin
    try_lwt
      finalizer t
    with exn ->
      Lwt_log.error_f ~section ~exn "Uncaught exception in Inotify_lwt.close"
  end