test: add a script that checks that we do not call unix_select from XAPI and xenopsd

This is somewhat of a hack, as it parses the disassembled binary of xapi and xenopsd,
and might break with future compiler versions that invoke functions differently.
There could also be false positives if a dependency calls Unix.select for just sleeping,
i.e. with all 3 arguments as empty lists, but so far we don't have any.

We still have the runtime test if that happens.

If the commits are reordered this does find the 'Thread.wait_timed_read' call in 'Master_database_connection',
and with the correct order of the commits it passes, offering some assurance that we don't actually call 'select' anymore,
not even indirectly via one of our dependencies.

Signed-off-by: Edwin Török <[email protected]>

Author: edwintorok

ocaml/tests/dune

@@ -164,3 +164,41 @@
 )
 
 (env (_ (env-vars (XAPI_TEST 1))))
+
+; disassemble, but without sources
+; (source lookup doesn't work for all dependencies, and is very slow on a large binary)
+; To make debugging easier the disassembly is saved to a file instead of piping
+(rule
+  (deps ../xapi/xapi_main.exe)
+  (target xapi.disasm)
+  (package xapi)
+  (action
+    (with-stdout-to %{target}
+      (run objdump %{deps} --wide -d --no-show-raw-insn)
+    )
+  )
+)
+
+(rule
+  (deps ../xenopsd/xc/xenops_xc_main.exe)
+  (target xenops_xc_main.disasm)
+  (package xapi-xenopsd-xc)
+  (action
+    (with-stdout-to %{target}
+      (run objdump %{deps} --wide -d --no-show-raw-insn)
+    )
+  )
+)
+
+(rule
+  (alias runtest)
+  (package xapi)
+  (deps (:script ./unix_select.gawk) (:disasm xapi.disasm))
+  (action (run gawk -f ./%{script} %{disasm}))
+)
+(rule
+  (alias runtest)
+  (package xapi-xenopsd-xc)
+  (deps (:script ./unix_select.gawk) (:disasm xenops_xc_main.disasm))
+  (action (run gawk -f ./%{script} %{disasm}))
+)

ocaml/tests/unix_select.gawk

@@ -0,0 +1,80 @@
+BEGIN { n = 0; }
+# A function definition and its address
+# Remember its address and update current symbol
+# 0000000000850330 <unix_select>:
+match($0, /^0*([0-9a-fA-F]+) <([^>]+)>/, symdef) {
+ SYMBOL = symdef[2];
+ ADDR = symdef[1];
+
+ SYMADDR[ADDR] = SYMBOL;
+
+ if (ADDR in LOADED) {
+   for (idx in LOADED[ADDR]) {
+     caller = LOADED[ADDR][idx]
+     CALLS[symdef[2]][n++] = caller
+   }
+ }
+}
+
+# Indirect calls (mostly used for C stubs)
+# mov    $0x850330,%rax
+# call   872834 <caml_c_call>
+match($0, /mov.*0x([0-9a-fA-F]*),/, addr) {
+  # this will have gaps, but the indexes will be unique
+  LOADED[addr[1]][n++] = SYMBOL
+}
+
+match($0, /call.*<([^>]+)>/, call) {
+  CALLS[call[1]][n++] = SYMBOL
+}
+
+END {
+  SYM = "unix_select"
+  had_calls = 0
+  if (SYM in CALLS) {
+    for (idx in CALLS[SYM]) {
+      caller = CALLS[SYM][idx];
+      print "--"
+      if (caller ~ /caml(Thread|Unix__fun_).*/) {
+        # direct calls from these functions to unix_select are expected
+        print caller "[expected]"
+      } else {
+        print caller "[bad]"
+        had_calls++
+      }
+      if (caller in CALLS) {
+          for (idx2 in CALLS[caller]) {
+            caller2 = CALLS[caller][idx2];
+            if (caller2 ~ /caml(Thread).*/) {
+              print caller2 "[expected]"
+            } else {
+              print caller2 "[bad]"
+              had_calls++
+            }
+            if (caller2 in CALLS) {
+              for (idx3 in CALLS[caller2]) {
+                  caller3 = CALLS[caller2][idx3];
+                  # but we don't expect anyone calling these functions from OCaml code,
+                  # reject that
+                  had_calls++
+                  print caller3 "[bad]"
+                  if (caller3 in CALLS) {
+                      for (idx4 in CALLS[caller3]) {
+                        caller4 = CALLS[caller3][idx4];
+                        print caller4 "[bad]"
+                        for (idx5 in CALLS[caller4]) {
+                          caller5 = CALLS[caller4][idx5];
+                          print caller5 "[bad]"
+                        }
+                      }
+                  }
+              }
+            }
+          }
+      }
+    }
+  }
+  if (had_calls > 0) {
+    exit 2
+  }
+}