Skip to content

Instantly share code, notes, and snippets.

@gdsfh gdsfh/gist:c0aa2733a6d09b49f894 Secret
Created Jul 27, 2014

Embed
What would you like to do?
(*
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);
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.