From 8e0245531f7ef2cb50d3d6fc464e402eed0ba472 Mon Sep 17 00:00:00 2001 From: Rob Hoes Date: Thu, 17 Oct 2024 16:46:08 +0000 Subject: [PATCH] Remove now-unused Buf_io and associated tests Signed-off-by: Rob Hoes --- ocaml/database/database_server_main.ml | 4 +- ocaml/libs/http-lib/buf_io.ml | 113 ----------------------- ocaml/libs/http-lib/buf_io.mli | 50 ---------- ocaml/libs/http-lib/bufio_test.ml | 106 ---------------------- ocaml/libs/http-lib/bufio_test.mli | 1 - ocaml/libs/http-lib/bufio_test_run.ml | 1 - ocaml/libs/http-lib/bufio_test_run.mli | 0 ocaml/libs/http-lib/dune | 38 +------- ocaml/libs/http-lib/test_server.ml | 121 +++++++++++-------------- ocaml/quicktest/dune | 1 - ocaml/quicktest/quicktest.ml | 6 +- 11 files changed, 59 insertions(+), 382 deletions(-) delete mode 100644 ocaml/libs/http-lib/buf_io.ml delete mode 100644 ocaml/libs/http-lib/buf_io.mli delete mode 100644 ocaml/libs/http-lib/bufio_test.ml delete mode 100644 ocaml/libs/http-lib/bufio_test.mli delete mode 100644 ocaml/libs/http-lib/bufio_test_run.ml delete mode 100644 ocaml/libs/http-lib/bufio_test_run.mli diff --git a/ocaml/database/database_server_main.ml b/ocaml/database/database_server_main.ml index 1dc59284263..e75539a5592 100644 --- a/ocaml/database/database_server_main.ml +++ b/ocaml/database/database_server_main.ml @@ -80,9 +80,9 @@ let _ = let socket = Http_svr.bind sockaddr "unix_rpc" in let server = Http_svr.Server.empty () in Http_svr.Server.add_handler server Http.Post "/post_remote_db_access" - (Http_svr.BufIO remote_database_access_handler_v1) ; + remote_database_access_handler_v1 ; Http_svr.Server.add_handler server Http.Post "/post_remote_db_access_v2" - (Http_svr.BufIO remote_database_access_handler_v2) ; + remote_database_access_handler_v2 ; Http_svr.start ~conn_limit:1024 server socket ; Printf.printf "server listening\n%!" ; if !self_test then ( diff --git a/ocaml/libs/http-lib/buf_io.ml b/ocaml/libs/http-lib/buf_io.ml deleted file mode 100644 index 12da51cb22f..00000000000 --- a/ocaml/libs/http-lib/buf_io.ml +++ /dev/null @@ -1,113 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) -(* Buffered IO with timeouts *) - -type t = {fd: Unix.file_descr; buf: bytes; mutable cur: int; mutable max: int} - -exception Timeout (* Waited too long for data to appear *) - -exception Eof - -let infinite_timeout = -1. - -let of_fd fd = - (* Unix.set_nonblock fd;*) - { - fd - ; (* FIXME -- this should be larger. Low for testing *) - buf= Bytes.create 1024 - ; cur= 0 - ; max= 0 - } - -let fd_of t = t.fd - -(* Internal functions *) - -let is_buffer_empty ic = ic.max - ic.cur <= 0 - -(* Used as a temporary measure while converting from unbuffered to buffered - I/O in the rest of the software. *) -let assert_buffer_empty ic = - if not (is_buffer_empty ic) then failwith "Buf_io buffer not empty" - -(* Shift the unprocessed data to the beginning of the buffer *) -let shift ic = - if ic.cur = Bytes.length ic.buf (* No unprocessed data!*) then ( - ic.cur <- 0 ; - ic.max <- 0 - ) else ( - Bytes.blit ic.buf ic.cur ic.buf 0 (ic.max - ic.cur) ; - ic.max <- ic.max - ic.cur ; - ic.cur <- 0 - ) - -(* Fill the buffer with everything that's ready to be read (up to the limit of the buffer *) -let fill_buf ~buffered ic timeout = - let buf_size = Bytes.length ic.buf in - let fill_no_exc timeout len = - Xapi_stdext_unix.Unixext.with_socket_timeout ic.fd timeout @@ fun () -> - try - let n = Unix.read ic.fd ic.buf ic.max len in - ic.max <- n + ic.max ; - if n = 0 && len <> 0 then raise Eof ; - n - with Unix.Unix_error (Unix.(EAGAIN | EWOULDBLOCK), _, _) -> -1 - in - (* If there's no space to read, shift *) - if ic.max = buf_size then shift ic ; - let space_left = buf_size - ic.max in - (* Read byte one by one just do make sure we don't buffer too many chars *) - let n = - fill_no_exc (Some timeout) - (if buffered then space_left else min space_left 1) - in - (* Select returned nothing to read *) - if n = -1 then raise Timeout ; - if n = space_left then ( - shift ic ; - let tofillsz = - if buffered then buf_size - ic.max else min (buf_size - ic.max) 1 - in - (* cannot use 0 here, for select that'd mean timeout immediately, for - setsockopt it would mean no timeout. - So use a very short timeout instead - *) - ignore (fill_no_exc (Some 1e-6) tofillsz) - ) - -(** Input 'len' characters from ic and put them into the bytestring 'b' starting from 'from' *) -let rec really_input ?(timeout = 15.0) ic b from len = - if len = 0 then - () - else ( - if ic.max - ic.cur < len then fill_buf ~buffered:true ic timeout ; - let blitlen = if ic.max - ic.cur < len then ic.max - ic.cur else len in - Bytes.blit ic.buf ic.cur b from blitlen ; - ic.cur <- ic.cur + blitlen ; - really_input ~timeout ic b (from + blitlen) (len - blitlen) - ) - -let really_input_buf ?timeout ic len = - let blksize = 2048 in - let buf = Buffer.create blksize in - let s = Bytes.create blksize in - let left = ref len in - while !left > 0 do - let size = min blksize !left in - really_input ?timeout ic s 0 size ; - Buffer.add_subbytes buf s 0 size ; - left := !left - size - done ; - Buffer.contents buf diff --git a/ocaml/libs/http-lib/buf_io.mli b/ocaml/libs/http-lib/buf_io.mli deleted file mode 100644 index fc76f1932e2..00000000000 --- a/ocaml/libs/http-lib/buf_io.mli +++ /dev/null @@ -1,50 +0,0 @@ -(* - * Copyright (C) 2006-2009 Citrix Systems Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published - * by the Free Software Foundation; version 2.1 only. with the special - * exception on linking described in file LICENSE. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - *) -(** Buffered IO with timeouts *) - -(** {2 Abstract type of inputs} *) -type t - -val of_fd : Unix.file_descr -> t - -val fd_of : t -> Unix.file_descr - -val infinite_timeout : float - -(** {2 Input functions} *) - -val really_input : ?timeout:float -> t -> bytes -> int -> int -> unit -(** Input 'len' characters from ic and put them into the string 'str' starting from 'from' *) - -val really_input_buf : ?timeout:float -> t -> int -> string - -(** {2 Exceptions} *) - -(** Waited too long for data to appear *) -exception Timeout - -exception Eof - -(** {2 Internal functions} *) - -val is_buffer_empty : t -> bool - -val assert_buffer_empty : t -> unit - -(* val assert_buffer_empty : t -> unit - val shift : t -> unit - val got_line : t -> int - val is_full : t -> bool - val fill_buf : buffered:bool -> t -> float -> unit -*) diff --git a/ocaml/libs/http-lib/bufio_test.ml b/ocaml/libs/http-lib/bufio_test.ml deleted file mode 100644 index 81aac2ad879..00000000000 --- a/ocaml/libs/http-lib/bufio_test.ml +++ /dev/null @@ -1,106 +0,0 @@ -open QCheck2 -open Xapi_fd_test - -let print_timeout = string_of_float - -let expect_string ~expected ~actual = - if not (String.equal expected actual) then - Test.fail_reportf "Data sent and observed do not match: %S <> %S" expected - actual - -let expect_amount ~expected observation = - let open Observations in - let actual = String.length observation.data in - if expected <> actual then - Test.fail_reportf - "Amount of data available and transferred does not match: %d <> %d;@,%a" - expected actual pp observation - -let test_buf_io = - let timeouts = Generate.timeouts in - let gen = Gen.tup2 Generate.t timeouts - and print = Print.tup2 Generate.print print_timeout in - Test.make ~name:__FUNCTION__ ~print gen @@ fun (behaviour, timeout) -> - let every_bytes = - Int.min - (Option.map Observations.Delay.every_bytes behaviour.delay_read - |> Option.value ~default:Int.max_int - ) - (Option.map Observations.Delay.every_bytes behaviour.delay_write - |> Option.value ~default:Int.max_int - ) - in - let operations = Int.max 1 (behaviour.size / every_bytes) in - (* Buf_io uses per-operation timeouts, not a timeout for the whole function, - so if we want a timeout of 0.1s and we insert some delays every 1 byte, - for 64KiB bytes in total, then we need 0.1/65536 timeout for individual operations. - - timeout_span remains the span for the entire function, - and timeout the per operation timeout that we'll pass to the function under test. - *) - let timeout_span = Mtime.Span.of_float_ns (timeout *. 1e9) |> Option.get in - let timeout = timeout /. float operations in - let timeout_operation_span = - Mtime.Span.of_float_ns (timeout *. 1e9) |> Option.get - in - (* timeout < 1us would get truncated to 0 *) - QCheck2.assume (timeout > 1e-6) ; - (* Format.eprintf "Testing %s@." (print (behaviour, timeout)); *) - if behaviour.kind <> Unix.S_SOCK then - QCheck2.assume_fail () ; - (* we only support sockets for this function *) - let test_elapsed = ref Mtime.Span.zero in - let test wrapped_fd = - let fd = Xapi_fdcaps.Operations.For_test.unsafe_fd_exn wrapped_fd in - let bio = Buf_io.of_fd fd in - let dt = Mtime_clock.counter () in - let finally () = test_elapsed := Mtime_clock.count dt in - Fun.protect ~finally (fun () -> - Buf_io.really_input_buf bio behaviour.size ~timeout - ) - in - (*Printf.eprintf "testing: %s\n%!" (print (behaviour, timeout)) ;*) - let observations, result = - let buf = String.init behaviour.size (fun i -> Char.chr (i mod 255)) in - Generate.run_ro behaviour buf ~f:test - in - let () = - let open Observations in - let elapsed = !test_elapsed in - let timeout_extra = - Mtime.Span.(add (timeout_span :> Mtime.Span.t) @@ (500 * ms)) - in - if Mtime.Span.compare elapsed timeout_extra > 0 then - Test.fail_reportf - "Function duration significantly exceeds timeout: %a > %.6f; %s" - Mtime.Span.pp elapsed timeout - (Fmt.to_to_string Fmt.(option pp) observations.Observations.write) ; - (* Format.eprintf "Result: %a@." (Fmt.option Observations.pp) observations.write;*) - match (observations, result) with - | {write= Some write; _}, Ok actual -> - expect_amount ~expected:(String.length actual) write ; - expect_string ~expected:write.data ~actual - | {write= Some _; _}, Error (`Exn_trap (Buf_io.Timeout, _)) -> - let elapsed = !test_elapsed in - if Mtime.Span.compare elapsed timeout_operation_span < 0 then - Test.fail_reportf "Timed out earlier than requested: %a < %a" - Mtime.Span.pp elapsed Mtime.Span.pp timeout_span - | ( {write= Some write; _} - , Error (`Exn_trap (Unix.Unix_error (Unix.EPIPE, _, _), _)) ) -> - if String.length write.data = behaviour.size then - Test.fail_reportf - "Transferred exact amount, shouldn't have tried to send more: %d" - behaviour.size - | {write= None; _}, _ -> - () - | _, Error (`Exn_trap (e, bt)) -> - Printexc.raise_with_backtrace e bt - in - true - -let tests = [test_buf_io] - -let () = - (* avoid SIGPIPE *) - let (_ : Sys.signal_behavior) = Sys.signal Sys.sigpipe Sys.Signal_ignore in - () diff --git a/ocaml/libs/http-lib/bufio_test.mli b/ocaml/libs/http-lib/bufio_test.mli deleted file mode 100644 index a10acd45016..00000000000 --- a/ocaml/libs/http-lib/bufio_test.mli +++ /dev/null @@ -1 +0,0 @@ -val tests : QCheck2.Test.t list diff --git a/ocaml/libs/http-lib/bufio_test_run.ml b/ocaml/libs/http-lib/bufio_test_run.ml deleted file mode 100644 index a7a1cacab7e..00000000000 --- a/ocaml/libs/http-lib/bufio_test_run.ml +++ /dev/null @@ -1 +0,0 @@ -let () = QCheck_base_runner.run_tests_main Bufio_test.tests diff --git a/ocaml/libs/http-lib/bufio_test_run.mli b/ocaml/libs/http-lib/bufio_test_run.mli deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/ocaml/libs/http-lib/dune b/ocaml/libs/http-lib/dune index cc5bec51648..2990fda2453 100644 --- a/ocaml/libs/http-lib/dune +++ b/ocaml/libs/http-lib/dune @@ -3,7 +3,7 @@ (public_name http-lib) (modes best) (wrapped false) - (modules (:standard \ http_svr http_proxy server_io http_test radix_tree_test test_client test_server bufio_test bufio_test_run)) + (modules (:standard \ http_svr http_proxy server_io http_test radix_tree_test test_client test_server)) (preprocess (per_module ((pps ppx_deriving_rpc) Http))) (libraries astring @@ -67,42 +67,6 @@ ) ) -(test - (name bufio_test_run) - (package http-lib) - (modes (best exe)) - (modules bufio_test_run) - (libraries - qcheck-core.runner - bufio_test - ) - ; use fixed seed to avoid causing random failures in CI and package builds - (action (run %{test} -v -bt --seed 42)) -) - -(library - (name bufio_test) - (modes best) - (modules bufio_test) - (libraries - fmt - mtime - mtime.clock - mtime.clock.os - rresult - http_lib - qcheck-core - xapi_fd_test - ) -) - -(rule - (alias stresstest) - (deps bufio_test_run.exe) - ; use default random seed on stresstests - (action (run %{deps} -v -bt)) -) - (executable (modes exe) (name test_client) diff --git a/ocaml/libs/http-lib/test_server.ml b/ocaml/libs/http-lib/test_server.ml index 2cae4f4ba5f..44c07301fd7 100644 --- a/ocaml/libs/http-lib/test_server.ml +++ b/ocaml/libs/http-lib/test_server.ml @@ -16,74 +16,63 @@ let _ = "A simple test HTTP server" ; let open Http_svr in let server = Server.empty () in - Server.add_handler server Http.Get "/stop" - (FdIO - (fun _ s _ -> - let r = Http.Response.to_wire_string (Http.Response.make "200" "OK") in - Unixext.really_write_string s r ; - with_lock finished_m (fun () -> - finished := true ; - Condition.signal finished_c - ) - ) - ) ; - Server.add_handler server Http.Post "/echo" - (FdIO - (fun request s _ -> - match request.Http.Request.content_length with - | None -> - Unixext.really_write_string s - (Http.Response.to_wire_string - (Http.Response.make "404" "content length missing") - ) - | Some l -> - let txt = Unixext.really_read_string s (Int64.to_int l) in - let r = - Http.Response.to_wire_string - (Http.Response.make ~body:txt "200" "OK") - in - Unixext.really_write_string s r - ) - ) ; - Server.add_handler server Http.Get "/stats" - (FdIO - (fun _ s _ -> - let lines = - List.map - (fun (m, uri, s) -> - Printf.sprintf "%s,%s,%d,%d\n" - (Http.string_of_method_t m) - uri s.Http_svr.Stats.n_requests s.Http_svr.Stats.n_connections - ) - (Server.all_stats server) - in - let txt = String.concat "" lines in - let r = - Http.Response.to_wire_string (Http.Response.make ~body:txt "200" "OK") - in - Unixext.really_write_string s r - ) - ) ; - Server.add_handler server Http.Get "/query" - (FdIO - (fun request s _ -> - match request.Http.Request.query with - | (_, v) :: _ -> - Unixext.really_write_string s - (Http.Response.to_wire_string - (Http.Response.make ~body:v "200" "OK") - ) - | _ -> - Unixext.really_write_string s - (Http.Response.to_wire_string - (Http.Response.make "404" "Query string missing") - ) - ) - ) ; + Server.add_handler server Http.Get "/stop" (fun _ s _ -> + let r = Http.Response.to_wire_string (Http.Response.make "200" "OK") in + Unixext.really_write_string s r ; + with_lock finished_m (fun () -> + finished := true ; + Condition.signal finished_c + ) + ) ; + Server.add_handler server Http.Post "/echo" (fun request s _ -> + match request.Http.Request.content_length with + | None -> + Unixext.really_write_string s + (Http.Response.to_wire_string + (Http.Response.make "404" "content length missing") + ) + | Some l -> + let txt = Unixext.really_read_string s (Int64.to_int l) in + let r = + Http.Response.to_wire_string + (Http.Response.make ~body:txt "200" "OK") + in + Unixext.really_write_string s r + ) ; + Server.add_handler server Http.Get "/stats" (fun _ s _ -> + let lines = + List.map + (fun (m, uri, s) -> + Printf.sprintf "%s,%s,%d,%d\n" + (Http.string_of_method_t m) + uri s.Http_svr.Stats.n_requests s.Http_svr.Stats.n_connections + ) + (Server.all_stats server) + in + let txt = String.concat "" lines in + let r = + Http.Response.to_wire_string (Http.Response.make ~body:txt "200" "OK") + in + Unixext.really_write_string s r + ) ; + Server.add_handler server Http.Get "/query" (fun request s _ -> + match request.Http.Request.query with + | (_, v) :: _ -> + Unixext.really_write_string s + (Http.Response.to_wire_string + (Http.Response.make ~body:v "200" "OK") + ) + | _ -> + Unixext.really_write_string s + (Http.Response.to_wire_string + (Http.Response.make "404" "Query string missing") + ) + ) ; (* 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)) ; + Server.add_handler server Http.Get "/close_conn" (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 diff --git a/ocaml/quicktest/dune b/ocaml/quicktest/dune index ac0bc21c193..1babfb7d1bb 100644 --- a/ocaml/quicktest/dune +++ b/ocaml/quicktest/dune @@ -21,7 +21,6 @@ rrdd_libs stunnel unixext_test - bufio_test test_timer threads.posix unix diff --git a/ocaml/quicktest/quicktest.ml b/ocaml/quicktest/quicktest.ml index 38a139666ae..f4f8309ec34 100644 --- a/ocaml/quicktest/quicktest.ml +++ b/ocaml/quicktest/quicktest.ml @@ -15,11 +15,7 @@ (** The main entry point of the quicktest executable *) let qchecks = - [ - ("unixext", Unixext_test.tests) - ; ("bufio", Bufio_test.tests) - ; ("Timer", Test_timer.tests) - ] + [("unixext", Unixext_test.tests); ("Timer", Test_timer.tests)] |> List.map @@ fun (name, test) -> (name, List.map QCheck_alcotest.(to_alcotest ~long:true) test)