Merge pull request #5760 from xapi-project/feature/perf

Merge feature/perf to master

Author: edwintorok

.gitignore

@@ -2,6 +2,7 @@ _build/
 *.bak
 *.native
 .merlin
+_coverage/
 *.install
 *.swp
 compile_flags.txt

Makefile

@@ -6,7 +6,7 @@ JOBS = $(shell getconf _NPROCESSORS_ONLN)
 PROFILE=release
 OPTMANDIR ?= $(OPTDIR)/man/man1/
 
-.PHONY: build clean test doc python format install uninstall
+.PHONY: build clean test doc python format install uninstall coverage
 
 # if we have XAPI_VERSION set then set it in dune-project so we use that version number instead of the one obtained from git
 # this is typically used when we're not building from a git repo
@@ -20,6 +20,11 @@ build:
 check:
 	dune build @check -j $(JOBS)
 
+coverage:
+	dune runtest --instrument-with bisect_ppx --force --profile=$(RELEASE) -j $(JOBS)
+	bisect-ppx-report html
+	bisect-ppx-report summary --per-file
+
 clean:
 	dune clean
 
@@ -57,6 +62,7 @@ TEST_TIMEOUT=600
 TEST_TIMEOUT2=1200
 test:
 	ulimit -S -t $(TEST_TIMEOUT); \
+	ulimit -n 2048; \
 	 (sleep $(TEST_TIMEOUT) && ps -ewwlyF --forest)& \
 	 PSTREE_SLEEP_PID=$$!; \
 	 trap "kill $${PSTREE_SLEEP_PID}" INT TERM EXIT; \
@@ -206,6 +212,7 @@ install: build doc sdk doc-json
 	install -D -m 755 _build/install/default/bin/xcp-rrdd-iostat $(DESTDIR)$(LIBEXECDIR)/xcp-rrdd-plugins/xcp-rrdd-iostat
 	install -D -m 755 _build/install/default/bin/xcp-rrdd-squeezed $(DESTDIR)$(LIBEXECDIR)/xcp-rrdd-plugins/xcp-rrdd-squeezed
 	install -D -m 755 _build/install/default/bin/xcp-rrdd-xenpm $(DESTDIR)$(LIBEXECDIR)/xcp-rrdd-plugins/xcp-rrdd-xenpm
+	install -D -m 755 _build/install/default/bin/xcp-rrdd-dcmi $(DESTDIR)$(LIBEXECDIR)/xcp-rrdd-plugins/xcp-rrdd-dcmi
 	install -D -m 644 ocaml/xcp-rrdd/bugtool-plugin/rrdd-plugins.xml $(DESTDIR)$(ETCXENDIR)/bugtool/xcp-rrdd-plugins.xml
 	install -D -m 644 ocaml/xcp-rrdd/bugtool-plugin/rrdd-plugins/stuff.xml $(DESTDIR)$(ETCXENDIR)/bugtool/xcp-rrdd-plugins/stuff.xml
 	install -D -m 755 ocaml/xcp-rrdd/bin/rrdp-scripts/sysconfig-rrdd-plugins $(DESTDIR)/etc/sysconfig/xcp-rrdd-plugins

dune-project

@@ -2,6 +2,8 @@
 (formatting (enabled_for ocaml))
 (using menhir 2.0)
 
+(cram enable)
+(implicit_transitive_deps false)
 (generate_opam_files true)
 
 (name "xapi")
@@ -559,6 +561,8 @@ This package provides an Lwt compatible interface to the library.")
     base-unix
     (odoc :with-doc)
     (xapi-stdext-pervasives (= :version))
+    (mtime :with-test)
+    (xapi-stdext-unix (= :version))
   )
 )
 
@@ -568,12 +572,19 @@ This package provides an Lwt compatible interface to the library.")
   (authors "Jonathan Ludlam")
   (depends
     (ocaml (>= 4.12.0))
+    (alcotest :with-test)
     base-unix
+    (bisect_ppx :with-test)
     (fd-send-recv (>= 2.0.0))
+    fmt
+    (mtime (and (>= 2.0.0) :with-test))
+    (logs :with-test)
+    (qcheck-core (and (>= 0.21.2) :with-test))
     (odoc :with-doc)
     xapi-backtrace
     unix-errno
     (xapi-stdext-pervasives (= :version))
+    polly
   )
 )
 

ocaml/database/dune

@@ -41,6 +41,7 @@
     xapi-datamodel
     xapi-log
     (re_export xapi-schema)
+    xapi-idl.updates
     xapi-stdext-encodings
     xapi-stdext-pervasives
     xapi-stdext-std

ocaml/database/master_connection.ml

@@ -271,7 +271,7 @@ let do_db_xml_rpc_persistent_with_reopen ~host:_ ~path (req : string) :
           !Db_globs.permanent_master_failure_retry_interval ;
         Thread.delay !Db_globs.permanent_master_failure_retry_interval ;
         !Db_globs.restart_fn ()
-    | e -> (
+    | e ->
         error "Caught %s" (Printexc.to_string e) ;
         (* RPC failed - there's no way we can recover from this so try reopening connection every 2s + backoff delay *)
         ( match !my_connection with
@@ -322,9 +322,7 @@ let do_db_xml_rpc_persistent_with_reopen ~host:_ ~path (req : string) :
           debug "%s: Sleep interrupted, retrying master connection now"
             __FUNCTION__ ;
         update_backoff_delay () ;
-        try open_secure_connection () with _ -> ()
-        (* oh well, maybe nextime... *)
-      )
+        D.log_and_ignore_exn open_secure_connection
   done ;
   !result
 

ocaml/database/redo_log.ml

@@ -642,7 +642,8 @@ let startup log =
           ) ;
           match !(log.device) with
           | None ->
-              D.info "Could not find block device"
+              D.info "Could not find block device" ;
+              broken log
           | Some device ->
               D.info "Using block device at %s" device ;
               (* Check that the block device exists *)

ocaml/forkexecd/lib/dune

@@ -7,6 +7,7 @@
    fd-send-recv
    rpclib.core
    rpclib.json
+   rpclib.xml
    uuid
    xapi-backtrace
    xapi-log

ocaml/forkexecd/test/dune

@@ -1,7 +1,7 @@
 (executable
  (modes exe)
  (name fe_test)
- (libraries forkexec uuid xapi-stdext-unix))
+ (libraries forkexec uuid xapi-stdext-unix fd-send-recv))
 
 (rule
  (alias runtest)

ocaml/idl/ocaml_backend/gen_api.ml

@@ -112,6 +112,19 @@ let gen_non_record_type tys =
           t
     | ty :: t ->
         let alias = OU.alias_of_ty ty in
+        let accu =
+          match ty with
+          | DT.Enum (name, cs) ->
+              sprintf "let all_%s = [%s]" name
+                (cs
+                |> List.map fst
+                |> List.map OU.constructor_of
+                |> String.concat "; "
+                )
+              :: accu
+          | _ ->
+              accu
+        in
         if List.mem_assoc alias overrides then
           aux
             (sprintf "type %s = %s\n%s\n" alias (OU.ocaml_of_ty ty)

ocaml/libs/clock/dune

@@ -16,5 +16,5 @@
   (names test_date test_timer)
   (package clock)
   (modules test_date test_timer)
-  (libraries alcotest clock fmt mtime ptime qcheck-core qcheck-core.runner)
+  (libraries alcotest clock fmt mtime mtime.clock.os ptime qcheck-core qcheck-core.runner)
 )