Something went wrong. Try again.
An adversarial testing framework for OCaml HTTP/1.1 clients and servers
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103open Server_profile
let read_reader ~sw reader = let promise, resolver = Eio.Promise.create () in Eio.Fiber.fork ~sw (fun () -> let result = try Ok (Eio.Buf_read.take_all reader) with exn -> Error (Printexc.to_string exn) in Eio.Promise.resolve resolver result); promise
let read_pipe ~sw source = let reader = Eio.Buf_read.of_flow ~max_size:(64 * 1024 * 1024) source in read_reader ~sw reader
let captured promise stream = match Eio.Promise.await promise with | Ok bytes -> (bytes, "") | Error message -> ("", stream ^ " capture failed: " ^ message ^ "\n")
let stop_process ~clock process = (try Eio.Process.signal process Sys.sigterm with _ -> ()); match Eio.Time.with_timeout clock 2. (fun () -> Ok (Eio.Process.await process)) with | Error `Timeout -> Eio.Process.signal process Sys.sigkill; ignore (Eio.Process.await process); Timed_out | Ok (`Exited 0) -> Stopped_by_harness | Ok (`Exited code) -> Exited code | Ok (`Signaled signal) when signal = Sys.sigterm -> Stopped_by_harness | Ok (`Signaled signal) -> Signaled signal
let failed_report ~cases ~selected_tags ~server ~command ~duration_ms ~process_status ~stdout ~stderr = Server_profile.make_report ~cases ~selected_tags ~server ~command ~origin:"" ~duration_ms ~process_status ~stdout ~stderr []
let run ~net ~clock ~process_mgr ~server ~command ?(ready_timeout = 5.) ?(case_timeout = 1.) ?(cases = Server_profile.cases) ?(selected_tags = []) () = if command = [] then invalid_arg "server fixture command must not be empty"; if ready_timeout <= 0. || case_timeout <= 0. then invalid_arg "server executor timeouts must be positive"; let started = Eio.Time.now clock in try Eio.Switch.run @@ fun sw -> let stdout_source, stdout_sink = Eio.Process.pipe ~sw process_mgr in let stderr_source, stderr_sink = Eio.Process.pipe ~sw process_mgr in let process = Eio.Process.spawn ~sw process_mgr ~stdout:stdout_sink ~stderr:stderr_sink command in Eio.Flow.close stdout_sink; Eio.Flow.close stderr_sink; let stderr_promise = read_pipe ~sw stderr_source in let stdout_reader = Eio.Buf_read.of_flow ~max_size:(64 * 1024 * 1024) stdout_source in let readiness = match Eio.Time.with_timeout clock ready_timeout (fun () -> Ok (try Ok (Eio.Buf_read.line stdout_reader) with exn -> Error (Printexc.to_string exn))) with | Error `Timeout -> Error "fixture readiness timed out" | Ok (Error message) -> Error ("fixture readiness failed: " ^ message) | Ok (Ok line) -> Server_fixture.parse_ready_line line in match readiness with | Error message -> ignore (stop_process ~clock process); let stdout = try Eio.Buf_read.take_all stdout_reader with _ -> "" in let stderr, capture_error = captured stderr_promise "stderr" in failed_report ~cases ~selected_tags ~server ~command ~duration_ms:((Eio.Time.now clock -. started) *. 1000.) ~process_status:(Readiness_error message) ~stdout ~stderr:(stderr ^ capture_error) | Ok port -> let stdout_promise = read_reader ~sw stdout_reader in let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in let origin = Printf.sprintf "http://127.0.0.1:%d" port in let observations = Server_driver.run ~net ~clock ~addr ~timeout:case_timeout cases in let process_status = stop_process ~clock process in let stdout, stdout_capture_error = captured stdout_promise "stdout" in let stderr, capture_error = captured stderr_promise "stderr" in Server_profile.make_report ~cases ~selected_tags ~server ~command ~origin ~duration_ms:((Eio.Time.now clock -. started) *. 1000.) ~process_status ~stdout ~stderr:(stderr ^ stdout_capture_error ^ capture_error) observations with exn -> failed_report ~cases ~selected_tags ~server ~command ~duration_ms:((Eio.Time.now clock -. started) *. 1000.) ~process_status:(Spawn_error (Printexc.to_string exn)) ~stdout:"" ~stderr:""