diff --git a/ocaml/libs/http-lib/dune b/ocaml/libs/http-lib/dune index d4e22f7d3c..cc5bec5164 100644 --- a/ocaml/libs/http-lib/dune +++ b/ocaml/libs/http-lib/dune @@ -113,6 +113,8 @@ safe-resources stunnel threads.posix + xapi-backtrace + xapi-log xapi-stdext-pervasives xapi-stdext-unix ) diff --git a/ocaml/libs/http-lib/test_client.ml b/ocaml/libs/http-lib/test_client.ml index 4bc7f2a3e1..bbca0f63e7 100644 --- a/ocaml/libs/http-lib/test_client.ml +++ b/ocaml/libs/http-lib/test_client.ml @@ -167,6 +167,44 @@ let perf () = in Printf.printf "%s RPCs/sec\n%!" (Normal_population.to_string thread_persistent) +let send_close_conn ~use_fastpath ~use_framing keep_alive s = + try + Http_client.rpc ~use_fastpath s + (Http.Request.make ~frame:use_framing ~version:"1.1" ~keep_alive + ~user_agent ~body:"hello" Http.Get "/close_conn" + ) (fun response s -> + match response.Http.Response.content_length with + | Some l -> + let _ = Unixext.really_read_string s (Int64.to_int l) in + Printf.printf "Received a response with %Ld bytes.\n" l ; + exit 1 + | None -> + Printf.printf "Need a content length\n" ; + exit 1 + ) + with Unix.Unix_error (Unix.ECONNRESET, "read", "") as e -> + Backtrace.is_important e ; + let bt = Backtrace.get e in + Debug.log_backtrace e bt + +let ( let@ ) f x = f x + +let logerr () = + (* Send a request to the server to close connection instead of replying with + an http request, force the error to be logged *) + Printexc.record_backtrace true ; + Debug.log_to_stdout () ; + Debug.set_level Syslog.Debug ; + let use_fastpath = !use_fastpath in + let use_framing = !use_framing in + let transport = if !use_ssl then with_stunnel else with_connection in + let call () = + let@ () = Backtrace.with_backtraces in + let@ s = transport !ip !port in + send_close_conn ~use_fastpath ~use_framing false s + in + match call () with `Ok () -> () | `Error (_, _) -> () + let () = Arg.parse [ @@ -176,6 +214,7 @@ let () = ; ("-frame", Arg.Set use_framing, "use HTTP framing") ; ("--ssl", Arg.Set use_ssl, "use SSL rather than plaintext") ; ("--perf", Arg.Unit perf, "Collect performance stats") + ; ("--logerr", Arg.Unit logerr, "Test log on error") ] (fun x -> Printf.fprintf stderr "Ignoring unexpected argument: %s\n" x) "A simple test HTTP client" diff --git a/ocaml/libs/http-lib/test_client_server.t b/ocaml/libs/http-lib/test_client_server.t index 21dc6762de..8b7323a746 100644 --- a/ocaml/libs/http-lib/test_client_server.t +++ b/ocaml/libs/http-lib/test_client_server.t @@ -4,4 +4,13 @@ $ sleep 0.1 == Normal - $ ./test_client.exe --perf > /dev/null + $ ./test_client.exe --perf > /dev/null + +== Expect to log after a closed connection + $ ./test_client.exe --logerr > result + $ grep "ECONNRESET" result -c + 1 + $ grep "backtrace" result -c + 11 + $ grep "Called from" result -c + 8 diff --git a/ocaml/libs/http-lib/test_server.ml b/ocaml/libs/http-lib/test_server.ml index a1f703042e..2cae4f4ba5 100644 --- a/ocaml/libs/http-lib/test_server.ml +++ b/ocaml/libs/http-lib/test_server.ml @@ -80,6 +80,10 @@ let _ = ) ) ) ; + (* Forces a protocol error by closing the connection without sending a + proper http reponse code *) + Server.add_handler server Http.Get "/close_conn" + (FdIO (fun _ _ _ -> raise End_of_file)) ; let ip = "0.0.0.0" in let inet_addr = Unix.inet_addr_of_string ip in let addr = Unix.ADDR_INET (inet_addr, !port) in