gistfile1.ml

(*
module IO = IO_Lwt;
*)

module IO
 =
  struct

    include IO_Lwt;

    value iodbg fmt = ksprintf (fun s -> amdbg "IO: %s" s) fmt;

    value fail_prob = 0.1;

    value fail_seed = 3;

    value rng = Random.State.make [| fail_seed |];

    value failed_fds = ref [];

    value close_timeout fd =
      Lwt_unix.sleep 5.0 >>= fun () ->
      close_fd fd
    ;

    value write_fd fd str =
      if List.memq fd failed_fds.val
      then
        let () = iodbg "write_fd: failing writes to this fd" in
        return_unit
      else
        let fail_now = Random.State.float rng 1.0 < fail_prob in
        let () = iodbg "write_fd: %S, failing=%B" str fail_now in
        if not fail_now
        then write_fd fd str
        else
          let fail_len = Random.State.int rng (String.length str) + 1 in
          let () = iodbg "fail_len=%i" fail_len in
          let () = failed_fds.val := [fd :: failed_fds.val] in
          let () = run_and_ignore_result (close_timeout fd) in
          write_fd fd (String.sub str 0 fail_len)
    ;

  end
;

module I = Iteratees.Make(IO);
module S = Amall_http_service.Service(IO)(I);
module Ws = Websocket.Server(IO)(I);
module Wc = Websocket.Client(IO)(I);