xapi.conf: introduce test_open

We'll check statically that we are not using Unix.select, but it is good to have a runtime check too,
in case some library (C or OCaml) indirectly uses it.

Default is 0 but can be set to 1024 to test for the absence of Unix.select.

Signed-off-by: Edwin Török <edwin.torok@cloud.com>

ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/test/unixext_test.ml

@@ -192,4 +192,5 @@ let tests = [test_proxy; test_time_limited_write; test_time_limited_read]
 let () =
   (* avoid SIGPIPE *)
   let (_ : Sys.signal_behavior) = Sys.signal Sys.sigpipe Sys.Signal_ignore in
+  Xapi_stdext_unix.Unixext.test_open 1024 ;
   QCheck_base_runner.run_tests_main tests

ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml

@@ -858,6 +858,23 @@ let domain_of_addr str =
     Some (Unix.domain_of_sockaddr (Unix.ADDR_INET (addr, 1)))
   with _ -> None
 
+let test_open_called = Atomic.make false
+
+let test_open n =
+  if not (Atomic.compare_and_set test_open_called false true) then
+    invalid_arg "test_open can only be called once" ;
+  (* we could make this conditional on whether ulimit was increased or not,
+     but that could hide bugs if we think the CI has tested this, but due to ulimit it hasn't.
+  *)
+  if n > 0 then (
+    let socket = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
+    at_exit (fun () -> Unix.close socket) ;
+    for _ = 2 to n do
+      let fd = Unix.dup socket in
+      at_exit (fun () -> Unix.close fd)
+    done
+  )
+
 module Direct = struct
   type t = Unix.file_descr
 

ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli

@@ -248,6 +248,17 @@ val statvfs : string -> statvfs_t
 val domain_of_addr : string -> Unix.socket_domain option
 (** Returns Some Unix.PF_INET or Some Unix.PF_INET6 if passed a valid IP address, otherwise returns None. *)
 
+val test_open : int -> unit
+(** [test_open n] opens n file descriptors. This is useful for testing that the application makes no calls
+  to [Unix.select] that use file descriptors, because such calls will then immediately fail.
+
+  This assumes that [ulimit -n] has been suitably increased in the test environment.
+  
+  Can only be called once in a program, and will raise an exception otherwise.
+
+  The file descriptors will stay open until the program exits.
+ *)
+
 module Direct : sig
   (** Perform I/O in O_DIRECT mode using 4KiB page-aligned buffers *)
 

ocaml/xapi/xapi.ml

@@ -930,12 +930,20 @@ let report_tls_verification ~__context =
   let value = Stunnel_client.get_verify_by_default () in
   Db.Host.set_tls_verification_enabled ~__context ~self ~value
 
+let test_open count =
+  if count > 0 then (
+    debug "%s: opening %d file descriptors" __FUNCTION__ count ;
+    Xapi_stdext_unix.Unixext.test_open count ;
+    debug "%s: opened %d files" __FUNCTION__ count
+  )
+
 let server_init () =
   let print_server_starting_message () =
     debug "(Re)starting xapi, pid: %d" (Unix.getpid ()) ;
     debug "on_system_boot=%b pool_role=%s" !Xapi_globs.on_system_boot
       (Pool_role.string_of (Pool_role.get_role ()))
   in
+  test_open !Xapi_globs.test_open ;
   Unixext.unlink_safe "/etc/xensource/boot_time_info_updated" ;
   (* Record the initial value of Master_connection.connection_timeout and set it to 'never'. When we are a slave who
      has just started up we want to wait forever for the master to appear. (See CA-25481) *)

ocaml/xapi/xapi_globs.ml

@@ -1031,6 +1031,8 @@ let observer_experimental_components =
 
 let disable_webserver = ref false
 
+let test_open = ref 0
+
 let xapi_globs_spec =
   [
     ( "master_connection_reset_timeout"
@@ -1114,6 +1116,7 @@ let xapi_globs_spec =
   ; ("max_spans", Int max_spans)
   ; ("max_traces", Int max_traces)
   ; ("max_observer_file_size", Int max_observer_file_size)
+  ; ("test-open", Int test_open) (* for consistency with xenopsd *)
   ]
 
 let options_of_xapi_globs_spec =

ocaml/xenopsd/lib/xenopsd.ml

@@ -128,6 +128,8 @@ let max_bytes_of_xenstore_entries entries =
 
 let vm_guest_agent_xenstore_quota_bytes = ref (25 * 1024 * 1024)
 
+let test_open = ref 0
+
 let options =
   [
     ( "queue"
@@ -276,6 +278,11 @@ let options =
     , "Maximum size in bytes of VM xenstore-data field, and guest metrics \
        copied from guest's vm-data/ and data/ xenstore tree"
     )
+  ; ( "test-open"
+    , Arg.Set_int test_open
+    , (fun () -> string_of_int !test_open)
+    , "TESTING only: open N file descriptors"
+    )
   ]
 
 let path () = Filename.concat !sockets_path "xenopsd"
@@ -424,9 +431,18 @@ let log_uncaught_exception e bt =
   error "xenopsd exitted with an uncaught exception: %s" (Printexc.to_string e) ;
   log_raw_backtrace bt
 
+let test_open () =
+  let count = !test_open in
+  if count > 0 then (
+    debug "TEST: opening %d file descriptors" count ;
+    Xapi_stdext_unix.Unixext.test_open count ;
+    debug "TEST: opened %d file descriptors" count
+  )
+
 let main backend =
   Printexc.record_backtrace true ;
   Printexc.set_uncaught_exception_handler log_uncaught_exception ;
+  test_open () ;
   (* Set service name for Tracing *)
   Tracing_export.set_service_name "xenopsd" ;
   (* Listen for transferred file descriptors *)