http-libs: add test about error logging

While this does not exercise the exact error that can happen in long
migrations, it gets logged in a similar way.

There's no easy way to trigger the issue, the best chance is to send a
malformed response to trigger a Parse_error.

I did modify the code in http_client and verified that current code can produce
the logging, with backtraces successfully, when set up properly (like in the
test client)

Signed-off-by: Pau Ruiz Safont <[email protected]>

ocaml/libs/http-lib/dune

@@ -113,6 +113,8 @@
     safe-resources
     stunnel
     threads.posix
+    xapi-backtrace
+    xapi-log
     xapi-stdext-pervasives
     xapi-stdext-unix
   )

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"

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

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